返回列表 回复 发帖
magic

注册会员

Rank: 2

UID
2033152 
威望
1 点 
金钱
3090 金币 
点卡
0 点 
1#
打印
tT
发表于 2003-9-16 03:05 | 只看该作者

动网至雷傲论坛数据转换程序

  1. 'DV2LB.vbs
  2. '
  3. '动网至雷傲论坛数据转换程序
  4. '转换程序编制：
  5. '雷傲论坛河北代理
  6. '一窍不通
  7. '
  10. LBDataPath = "."'转换后雷傲论坛数据存放路径
  11. DVDBName = "dvbbs6.mdb"'动网数据库路径名称
  13. Title = "DV2LB数据转换程序(β0.11)"
  14. Welcome
  16. AllTimeBegin = Timer
  17. ThisTime = Now
  18. timeUTC = "1970-1-1 8:00:00"
  20. Set fso = CreateObject("Scripting.FileSystemObject")
  21. LBPathAll = fso.GetAbsolutePathName(LBDataPath) & "/"
  22. DVDBNameAll = fso.GetAbsolutePathName(DVDBName)
  23. dataDir = LBPathAll & "data\"
  24. Set DBConnection = CreateObject("Adodb.Connection")
  25. ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq="&DVDBNameAll
  26. DBConnection.Open ConnectionString
  27. Set rs = CreateObject("Adodb.Recordset")
  30. ChangeMemberData
  31. ChangeClassData
  32. ChangeForumsData
  33. ChangeMemberFriend
  34. ChangeShareForums
  35. ChangeFav
  37. DBConnection.close
  38. Set DBConnection = nothing
  40. AllTimeEnd = Timer
  41. AllTime = AllTimeEnd - AllTimeBegin
  42. MsgBox "动网至雷傲数据转换完成.共用时"& alltime &"秒",vbInformation,Title &"—数据转换完成"
  45. Sub Welcome()
  46.     Dim intDoIt
  47.    
  48.     L_Welcome_MsgBox_Message_Text="动网至雷傲论坛数据转换程序"&vbnewline&vbnewline&"程序编制："&vbnewline&"雷傲论坛河北代理  一窍不通"&vbnewline&vbnewline&"是否进行论坛数据转换?"
  49.     L_Welcome_MsgBox_Title_Text=Title&"——提示"
  50.         
  51.     intDoIt =  MsgBox(L_Welcome_MsgBox_Message_Text,    _   
  52.                       vbOKCancel + vbInformation,       _
  53.                       L_Welcome_MsgBox_Title_Text )
  54.     If intDoIt = vbCancel Then
  55.         WScript.Quit
  56.     End If
  57. End Sub
  59. Sub ChangeMemberData()
  60. 'Doit = MsgBox ("用户数据转换", vbokcancel ,Title&"——用户数据转换")
  61. 'If (Doit = vbcancel) Then Exit Sub
  62. memberDir = LBPathAll & "members\"
  63. If not fso.FolderExists(memberDir) Then fso.CreateFolder(memberDir)
  64. 'On Error Resume Next
  65. rs.open "user",DBConnection
  66. While not rs.eof
  67. UserName = ChangeName(rs("UserName"))
  68. If UserName<>"" Then
  69. userinfos = rs("userinfo")
  70. If userinfos<>"" Then
  71. userinfo = split(userinfos,"|||")
  72. Else
  73. userinfos = "||||||||||||||||||||||||||||||||||||||||||"
  74. userinfo = split(userinfos,"|||")
  75. End If
  76. If rs("sex") Then mSex="m" Else mSex="f"
  77. Select Case rs("usergroupid")
  78. Case "1" MemberCode = "ad"
  79. Case "2" MemberCode = "smo"
  80. Case "3" MemberCode = "mo"
  81. Case "4" MemberCode = "me"
  82. Case "8" MemberCode = "rz"
  83. Case Else MemberCode = "me"
  84. End Select
  85. MData = UserName & vbtab & rs("UserPassword") & vbtab & rs("title") & vbtab _
  86. & MemberCode & vbtab & rs("article") & vbtab & rs("useremail") & vbtab _
  87. & rs("showre") & vbtab & vbtab & rs("homepage") & vbtab & rs("oicq") & vbtab _
  88. & rs("icq") & vbtab & userinfo(4) & userinfo(5) & vbtab & ChangeString(userinfo(2)) & vbtab  _
  89. & changedate(rs("adddate")) & vbtab & vbtab & ChangeString(rs("sign")) & vbtab & vbtab & vbtab & vbtab  _
  90. & userinfo(3) & vbtab & vbtab & userinfo(6) & vbtab & vbtab & vbtab & vbtab & rs("userpower") & vbtab _
  91. & changedate(rs("lastlogin")) & vbtab & rs("logins") & vbtab & vbtab & vbtab _
  92. & vbtab & -rs("userdel") & vbtab & mSex & vbtab & userinfo(11) & vbtab  _
  93. & userinfo(10) & vbtab & userinfo(9) & vbtab _
  94. & rs("birthday") & vbtab & vbtab & vbtab & rs("usergroup") & vbtab _
  95. & vbtab
  96. 'MsgBox mdata
  97. MemberName = LCase(UserName)
  98. MemberName = memberDir & MemberName & ".cgi"
  99. Set MFile = fso.opentextfile (MemberName,2,true)
  100. MFile.Write(MData)
  101. MFile.close
  102. End If
  103. rs.movenext
  104. Wend
  105. rs.close
  107. End Sub
  109. Sub ChangeClassData()
  110. 'Doit = MsgBox ("论坛分类数据转换", _
  111. 'vbokcancel,Title & "——论坛分类转换")
  112. 'If Doit = vbcancel Then Exit Sub
  114. If not fso.FolderExists(dataDir) Then fso.CreateFolder(dataDir)
  115. sql = "select * from board where parentid=0 order by rootid"
  116. Set rsClass = DBConnection.execute(sql)
  117. While not rsclass.eof
  118. AllFourms=""
  119. sql = "select * from board where parentid=" & rsClass("boardid") &" order by orders"
  120. Set rsB = DBConnection.execute(sql)
  121. While not rsB.eof
  122. LastPostInfo = split (rsB("lastpost"),"$")
  123. master = rsB("boardmaster")
  124. If master<>"" Then master = Replace(master,"|",",")
  125. fData = rsb("boardid") & vbtab & rsClass("boardtype") & vbtab & rsClass("rootid") & vbtab _
  126. & rsB("boardtype") & vbtab & ChangeString(rsB("readme")) & vbtab & master & vbtab _
  127. & "off" & vbtab & "on" & vbtab & "no" & vbtab &  "yes" & vbtab & ChangeName(LastPostInfo(0)) & vbtab _
  128. & changedate(LastPostInfo(2)) & "%%%" & LastPostInfo(6) & "%%%" & LastPostInfo(3) & vbtab _
  129. & rsB("lasttopicnum") & vbtab _
  130. & rsB("lastbbsnum") & vbtab & vbtab & vbtab & vbtab & vbtab & "no" & vbtab & "yes" & vbtab _
  131. & rsB("indeximg") & vbtab & vbtab
  133. forumDir = LBPathAll & "forum" & rsB("boardid")
  134. If not fso.FolderExists(forumDir) Then fso.CreateFolder (forumDir)
  135. Set fFile=fso.opentextfile (forumDir & "\foruminfo.cgi",2,true)
  136. fFile.Write(fData)
  137. fFile.close
  139. AllForums = AllForums & fData & vbnewline
  140. rsB.movenext
  141. Wend
  142. rsB.close
  144. rsClass.movenext
  145. Wend
  146. rsClass.close
  148. AllForumsFileName = LBPathAll & "data\allforums.cgi"
  149. Set AllForumsFile = fso.opentextfile(AllForumsFileName,2,true)
  150. AllForumsFile.Write(Allforums)
  151. AllForumsFile.close
  153. End Sub
  155. Sub ChangeForumsData()
  156. 'Doit = MsgBox("帖子数据转换",_
  157. 'vbokcanel,Title & "——帖子数据转换")
  158. 'If Doit = vbcancel Then Exit Sub
  160. BoardDataDir = LBPathAll & "boarddata"
  161. If not fso.FolderExists(BoardDataDir) Then fso.CreateFolder(BoardDataDir)
  162. AbsontopFileName = BoardDataDir & "\absontop.cgi"
  164. sql = "select * from board where not depth=0"
  165. Set rsForum = DBConnection.execute(sql)
  166. While not rsForum.eof
  167. BoardID = rsForum("boardid")
  168. BoardDir = LBPathAll & "forum" & BoardID
  169. If not fso.FolderExists(BoardDir) Then fso.CreateFolder(BoardDir)
  170. ListFileName = BoardDataDir & "\list" & BoardID & ".cgi"
  171. JinghuaFileName = BoardDataDir & "\jinhua" & BoardID & ".cgi"
  172. OntopFileName = BoardDataDir & "\ontop" & BoardID & ".cgi"
  174. sql = "select * from topic where boardid = "& BoardID &" and not locktopic=2 order by lastposttime desc"
  175. Set rsThread = DBConnection.execute(sql)
  176. While not rsThread.eof
  177. TopicID = rsThread("topicid")
  178. voteoption = ""
  179. If rsThread("isbest")=1 Then
  180. Set JinghuaFile = fso.OpenTextFile(JinghuaFileName,8,true)
  181. JinghuaFile.Write(TopicID & vbnewline)
  182. JinghuaFile.Close
  183. End If
  184. istop = rsThread("istop")
  185. If istop=2 Then
  186. Set AbsontopFile = fso.OpenTextFile(AbsontopFileName,8,true)
  187. AbsontopFile.Write(BoardID & "|" & TopicID)
  188. AbsontopFile.Close
  189. ElseIf istop=1 Then
  190. Set OntopFile = fso.OpenTextFile(OntopFileName,8,true)
  191. OntopFile.Write(TopicID & vbnewline)
  192. OntopFile.Close
  193. End If
  195. sql = "select * from "& rsThread("posttable") &" where  boardid = "& boardid &" and rootid = "& TopicID & " and not locktopic=2 order by dateandtime"
  196. Set rsTopic = DBConnection.execute(sql)
  197. If not(rsTopic.bof and rstopic.eof) Then
  198. If rsThread("isvote") = 1 Then
  199. TopicType = "Poll"
  200. sql = "select * from vote where voteid = "& rsThread("pollid")
  201. Set rsVote = DBConnection.execute(sql)
  203. If rsVote("votetype")=1 Then votetype = "yes"Else votetype = "no"
  205. voteoption = rsVote("vote")
  206. voteoptions = split(voteoption,"|")
  207. voteoption = join(voteoptions,"<br>")
  209. sql = "select * from voteuser where voteid="& rsVote("voteid")
  210. Set rsVoteUser = DBConnection.execute(sql)
  211. PollFileName = BoardDir & "\" & TopicID & ".poll.cgi"
  212. Set PollFile = fso.OpenTextFile(PollFileName,2,true)
  213. While not rsVoteUser.eof
  214. sql = "select username from user where userid="& rsVoteUser("Userid")
  215. Set rs = DBConnection.execute(sql)
  216. If not (rs.bof and rs.eof) Then postname = ChangeName(rs(0))
  217. rs.close
  218. If votetype = "yes" Then
  219. postoption = ""
  220. postoptions = split(rsVoteUser("voteoption"),",")
  221. For i = 0 to UBound(postoptions)
  222. If postoptions(i) <> "" Then postoption = postoption & "＊！＃＆＊" & postname & vbtab & postoptions(i)+1 & vbtab & vbnewline
  223. Next
  224. Else
  225. postoption = "＊！＃＆＊" & postname & vbtab & rsVoteUser("voteoption")+1 & vbtab & vbnewline
  226. End If
  227. PollFile.Write(postoption)
  228. rsVoteUser.movenext
  229. Wend
  230. PollFile.Close
  231. rsVoteUser.Close
  232. rsVote.Close
  233. ElseIf rsThread("locktopic") = 1 Then
  234. TopicType = "Close"
  235. Else
  236. Topictype = "Open"
  237. End If
  238. 'On Error Resume Next
  239. If rsTopic("signflag")=1 Then signflag = "yes" Else signflag = "no"
  240. Topic = ChangeName(rsTopic("username")) & vbtab & "＊＃！＆＊" & rsTopic("topic") & vbtab _
  241. & rsTopic("ip") & vbtab & "yes" & vbtab & signflag & vbtab _
  242. & Changedate(rsTopic("dateandtime")) & vbtab & ChangeString(rsTopic("body")) & vbtab _
  243. & voteoption & vbtab & vbnewline
  244. rsTopic.movenext
  245. While not rsTopic.eof
  246. If rsTopic("signflag")=1 Then signflag = "yes" Else signflag = "no"
  247. Topic = Topic & ChangeName(rstopic("username")) & vbtab & "＊＃！＆＊" & rsTopic("topic") & vbtab _
  248. & rsTopic("ip") & vbtab & "yes" & vbtab & signflag & vbtab _
  249. & Changedate(rsTopic("dateandtime")) & vbtab & ChangeString(rstopic("body")) & vbtab _
  250. & "" & vbtab & vbnewline
  251. rsTopic.movenext
  252. Wend
  253. rsTopic.Close
  254. '
  255. TopicFileName = BoardDir & "\" & TopicID & ".thd.cgi"
  256. Set TopicFile = fso.OpenTextFile(TopicFileName,2,true)
  257. TopicFile.write(topic)
  258. TopicFile.close
  259. 'If err Then
  260. 'MsgBox err.number & Err.Description & " " & TopicID & vbnewline & topic & vbnewline & "end"
  261. 'err.clear
  262. 'WScript.Quit
  263. 'End If
  264. lastpost = split(rsThread("lastpost"),"$")
  265. TopicIndex = TopicID & vbtab & rsThread("title") & vbtab & vbtab & topictype & vbtab _
  266. & rsThread("child") & vbtab & rsThread("hits") & vbtab & ChangeName(rsThread("postusername")) & vbtab _
  267. & changedate(rsThread("dateandtime")) & vbtab & ChangeName(lastpost(0)) & vbtab _
  268. & changedate(rsThread("lastposttime")) & vbtab & "" & vbtab & ChangeString(lastpost(3)) & vbtab & vbnewline
  269. TopicIndexName = BoardDir & "\" & TopicID & ".pl"
  271. Set IndexFile = fso.OpenTextFile(TopicIndexName,2,true)
  272. IndexFile.Write(TopicIndex)
  273. IndexFile.Close
  275. Set ListFile = fso.OpenTextFile(ListFileName,8,true)
  276. ListFile.Write(TopicIndex)
  277. ListFile.Close
  278. End If
  279. rsThread.movenext
  280. Wend
  281. rsForum.movenext
  282. rsThread.close
  283. Wend
  284. rsForum.Close
  286. End Sub
  288. Sub ChangeMemberFriend()
  289. '转化用户好友名单
  290. friendDir = LBPathAll & "memfriend\"
  291. If not fso.FolderExists(friendDir) Then fso.createFolder(friendDir)
  292. rs.open "Friend",DBConnection
  293. While not rs.eof
  294. fName = ChangeName(rs("f_username"))
  295. fName = LCase(fName)
  296. friendName = friendDir & fName & ".cgi"
  297. Set memfriendFile = fso.opentextfile(friendName,8,true)
  298. memfriendFile.Write("＊＃！＆＊" & ChangeName(rs("f_friend")) & vbnewline)
  299. memfriendFile.close
  301. rs.movenext
  302. Wend
  303. rs.close
  305. End Sub
  307. Sub ChangeShareforums()
  308. '转化联盟论坛
  309. shareForums = ""
  310. rs.open "bbslink",DBConnection
  311. If not(rs.bof and rs.eof) Then
  312. While not rs.eof
  313. shareForum = rs("boardname") & vbtab & rs("url") & vbtab & ChangeString(rs("readme")) & vbtab & vbtab & rs("logo") & vbtab & vbnewline
  314. shareForums = shareForums & shareForum
  316. rs.movenext
  317. Wend
  318. rs.close
  320. shareFileName = dataDir & "shareforums.cgi"
  321. Set shareFile = fso.opentextfile(shareFileName,2,true)
  322. shareFile.write(shareForums)
  323. shareFile.close
  324. End If
  326. End Sub
  328. Sub ChangeFav()
  329. '转化个人收藏夹
  330. favDir = LBPathAll & "memfav"
  331. If not fso.FolderExists(favDir) Then fso.CreateFolder(favDir)
  332. rs.open "bookmark",DBConnection
  333. While not rs.eof
  334. fav0 = split(rs("url"),"?")
  335. fav1 = split(fav0(1),"&")
  336. fav11 = split(fav1(0),"=")
  337. fav12 = split(fav1(1),"=")
  338. fName = ChangeName(rs("username"))
  339. favName = favDir & "\" & LCase(fName)
  340. Set favFile = fso.OpenTextFile(favName,8,true)
  341. favFile.Write(fav11(1) & vbtab & fav12(1) & vbtab & vbnewline)
  342. favFile.Close
  343. rs.movenext
  344. Wend
  345. rs.close
  346. End Sub
  350. Function ChangeDate(date1)
  351. ChangeDate = DateDiff("s",timeUTC,date1)
  352. End Function
  354. Function ChangeString(string1)
  355. 'On Error Resume Next
  356. strings = string1
  357. If strings<>"" Then
  358. strings = Replace(strings,vbtab,"")
  359. ChangeString = Replace(strings,vbcrlf,"<br>")
  360. End If
  362. End Function
  364. Function ChangeName(iUserName)
  365. 'On Error Resume Next
  366. inUserName = iUserName
  367. Set regex = new regexp
  368. regEx.Global = True
  369. regEx.Pattern = "[\`\~\!\@\#\$\%\^\&\*\(\)\-\_\+\=\|\\\{\[\}\]\:\;""\'\<\,\>\.\?\/]"
  370. ChangeName = regEx.Replace(inUserName,"")
  372. End Function
复制代码
收藏 分享 评分
回复 引用

订阅 TOP

返回列表