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

BBS灌水机脚本(vb scritp, telnet, bbs, sterm)相关推荐

  1. Casularm 自动灌水机脚本

    注:请和 Maxthon 配合使用 [General] Description=guanshui BeginHotkey=119 BeginHotkeyMod=0 Enable=1 [Repeat] ...

  2. VeryCD灌水机演示代码(附另外一个发贴机代码)

    VeryCD那个铜光盘才能进候补区的规定很烦人,必须得灌水才能升级,可是又懒得灌,于是写了一个灌水脚本,有人问我要,就干脆发出来共享一下吧. ` 使用方法: 1.把username和passwd改成相 ...

  3. CSDN全自动灌水机

        2006年4月 CSDN全自动灌水机 老见有人在CSDN上"哦"个不停,怀疑是用的Robot,在WSH中试了下可以用ActiveX,所以写了这么个东西,替我去接分 :D 把 ...

  4. 论坛灌水机与注册机问题

    话题起头比较大,说明一下,写这篇的起因,论坛最近经常被新用户发布一些不相关的帖子,也没有一定的规律, 而基本都是新注册的用户,还都绑定手机的,起初我们用的是短信验证码,查了一下几天注册的手机号全都是批 ...

  5. 论坛灌水机 Delphi代码

    本来以为网页里的edit,memo等都和程式里的相同,能够用句柄来控制,但后来才明白,他是不存在句柄的! 查了好久,前几天看到一个关于QQ自动申请的例子.主要就是控制网页各种操作的!总结了一下,做出一 ...

  6. 一路问情热门论坛自动灌水机 v2007 免费

    Welcome to my blog! <script language="javascript" src="http://avss.b15.cnwg.cn/cou ...

  7. QQ聊天灌水机简要分析

    QQ聊天灌水机简要分析 Writter: SkyJacker Date:2007-02-05 Http://blog.csdn.net/skyjacker 1.获取聊天窗口    FindWindow ...

  8. 隐士打造CSDN相册灌水机 (1)

    CSDN的相册发照片实在是简陋,一个iframe,还在iframe里面露点了,露点照参见http://blog.csdn.net/nethermit/archive/2007/01/12/148152 ...

  9. VBS论坛自动灌水机代码

    请根据你的浏览器,选择相应的程序 IE浏览器: set wind9=createobject("scripting.filesystemobject") if wind9.file ...

最新文章

  1. linux上的定时器上的jiffies,linux定时器和Jiffies汇.doc
  2. python基础入门:while 循环
  3. CentOS6 下Samba服务器的安装与配置
  4. iPhone 13 Pro全新配色曝光:全新“磨砂黑”致敬经典
  5. 树状数组求区间和 和 单点更新
  6. 亚马逊发布新流媒体音乐服务:最低每月4美元
  7. 欧姆龙CP1H的PLC步进功能图编程实例
  8. Win11添加新的Microsoft Teams集成:共享屏幕变得更容易
  9. matlab 计算hog特征,Matlab计算图像HOG特征
  10. Paper和陈丹琦撞车是一种怎样的体验
  11. 计算机技术学硕国家线,关于工科国家线专硕学硕
  12. python键盘控制_python如何直接控制鼠标键盘
  13. Google(谷歌)高级搜索
  14. 志强CPU E5 E7参数,CPU内核参数对比图
  15. C++ accumulate
  16. 一个有趣的实验之OSPF中RID相同建邻
  17. Linux usb 3. Host 详解
  18. 浏览器控制台 console 保存输出文件
  19. 从Redis+Lua到Goroutine,日均10亿次的股票行情计算实践
  20. 又在开会……[原文写作时间:2006年6月26日]

热门文章

  1. 9.03 Every Day English
  2. 在zentyal操作系统内安装PacketiX ×××服务器端的步骤
  3. PacketiX ××× 3.0在Windows Server服务器NT配置步骤
  4. 优先队列 | 北邮OJ | 108. 虚数
  5. MIT-JOS系列3:启动内核
  6. 立创eda导出封装到allegro_立创EDA教程视频2018
  7. 00后大学生:精美绝伦的微积分教科书
  8. Matlab·学习 | (一)太阳系模型
  9. (1) [Nature15] Deep Learning
  10. 五分钟看懂第一波EOS超级节点投票大战