BBS灌水机脚本

'**********************************************************************

'* Filename: water.vbs *

'* Author: Pred  yecha@freecity.cn*

'* You may freely modify or redistribute this file *

'**********************************************************************

'

'注意，使用本脚本时，在脚本相同目录下创建一个文件名为Filename的文件，

'脚本把Filename每行内容依次作为文章标题发表在bbs上

'必须先登录到bbs并经如要post的那个板

'

Filename = "water_title.txt"

'Option Explicit

Main

MsgBox ("Script End")

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(Filename, 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

   STermScript.Delay 20000 '发文时间间隔

  End If

 Wend

 ts.Close

End Sub

'************************************************************

'* Function: TrimAll(strIn)                                 *

'* Return Value:                                            *

'* 除去字符串中所有可能的空格，tab等                        *

'************************************************************

Function TrimAll(strIn)

 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

 

'************************************************************

'* Function: ExpectCursor(ByRef str, ByVal TimeOut)         *

'* Return Value: True 出现   False 未出现                   *

'* 判断在一定时间内，光标所在行是否出现指定字符串           *

'************************************************************

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)      *

'* Return Value: True 出现   False 未出现                   *

'* 判断在一定时间内，指定行是否出现指定字符串               *

'************************************************************

Function Expect(ByRef str, ByVal linenum, ByVal TimeOut)

 Dim starttime

 starttime = Timer

 While (Not InStr(STermScript.GetBuffer(linenum), 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