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

magic

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

复制代码