BBS灌水机脚本(vb scritp, telnet, bbs, sterm)

'**********************************************************************
'* Filename: water.vbs *
'* Author: Pred  [e-mail]*
'* 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