PersonalCorpus 版 (精华区)

发信人: haze (幻舞幽岚·Mi bello! Chica!), 信区: Test
标  题: Re: 谁知道怎么成批的把一个bbs的文章转到另一个bbs?
发信站: 哈工大紫丁香 (Wed Jun  9 09:34:46 2004), 转信

********************************************************************** 
'* Filename: water.vbs * 
'* Author: Pred * 
'* You may freely modify or redistribute this file * 
'********************************************************************** 
' 
'注意，使用本脚本时，在D:\下创建一个b.txt， 
'脚本把b.txt每行内容依次作为文章标题发表在bbs上 
' 


Option Explicit 
Main 
'MsgBox ("Script End") 


Function TrimAll(strIn) 
'除去字符串中所有可能的空格，tab等 
Dim s,c, i 
s = Trim(strIn) 
TrimAll = "" 
for i = 1 to Len(s) 
c = Mid(s, i, 1) 
if (Asc(c) = 9) Then 
Else 
TrimAll = TrimAll + c 
End if 
Next 
End Function 

Sub Main() 
Const nTimeout = 20 
Const ForReading = 1 
Dim bConnect, nTime, nScreenHeight, strScreenLine, nDelay 

Dim fso, f1, f2, ts, s 
Set fso = CreateObject("Scripting.FileSystemObject") 

Set ts = fso.OpenTextFile("d:\b.txt", ForReading) 
'b为一个文本文件，脚本把b.txt每行内容依次作为文章标题发表在bbs上 

While(Not ts.AtEndOfStream) 
s = ts.ReadLine() 
s = TrimAll(s) 
If s <> "" Then 
if ( Not Expect("离开", 1, 10)) Then 
'判断屏幕第2行是否有"离开"，主要用来判断当前是否在文章列表中 
'Error? 
Exit Sub 
End If 

STermScript.SendConvertedData ("^P") '发表文章 
STermScript.Delay 200 '短暂延时 

If (Not ExpectCursor("标题:", 10)) Then 
'当前光标处是填写标题的地方？ 
'Error? 
MsgBox("error?") 
Exit Sub 
End If 

STermScript.SendData (s) '填入标题 
STermScript.SendConvertedData ("^M^M") '送出回车 
STermScript.Delay 200 

STermScript.SendConvertedData ("^W") '结束文章编辑 
STermScript.Delay 200 
If (Not ExpectCursor("(S)转信", 10)) Then 
'出现选择菜单"(S)转信, (F)换行发出，(L)不转信, (A)取消,……"? 
'Error? 
STermScript.SendConvertedData ("^[^[$$") '出现错误，设法回到版面列表状态 
Else 
STermScript.SendConvertedData ("^M") '正常，送出回车 
End If 
End if 
Wend 
ts.Close 
End Sub 

Function ExpectCursor(ByRef str, ByVal TimeOut) 
'判断在一定时间内，光标所在行是否出现指定字符串 
Dim starttime 
starttime = Timer 
While (Not InStr(STermScript.GetBuffer(STermScript.GetCursorY()), str) > 0) 
STermScript.Delay (200) 
If (Abs(Timer - starttime) > TimeOut) Then 
ExpectCursor = False 
' MsgBox (str + " not found, timeout") 
Exit Function 
End If 
Wend 
ExpectCursor = True 
End Function 

Function Expect(ByRef str, ByVal l, ByVal TimeOut) 
''判断在一定时间内，指定行是否出现指定字符串 
Dim starttime 
starttime = Timer 
While (Not InStr(STermScript.GetBuffer(l), str) > 0) 
STermScript.Delay (200) 
If (Abs(Timer - starttime) > TimeOut) Then 
Expect = False 
' MsgBox (str + " not found, timeout") 
Exit Function 
End If 
Wend 
Expect = True 
End Function

【 在 Amia (小羊) 的大作中提到: 】
: 要


--
 ╭═╯══╮╭══╦═╮╭╮╭╬╬╮╭═╮╮═╮                               
 ║╭╦═╮║      ║    ╰╮╭╦╦╮╭══★═╮                               
 ║  │    ║      ║    ╰╮╭★★╮╭════╮                               
 ║╰╬═╯║╰══╬═╯╰╮║║║║╰════╯                               
 ║★│★  ║      ║☆  ║║║╠╠║╰══★═╯                               
 ╰╰╩═╯╯╰══╩═╯╰╯╰╯╯╯╰══╩═╯                                 


※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.239.*]