Board logo

标题: [讨论]VBS抢占舒畅博客的沙发 [打印本页]

作者: rat    时间: 2008-11-7 19:36     标题: [讨论]VBS抢占舒畅博客的沙发

http://blog.sina.com.cn/shuchang

就是她一发表新文章,就抢掉沙发,用VBS!应当有办法实现的!!!!!

[ 本帖最后由 rat 于 2008-11-16 15:08 编辑 ]
作者: namejm    时间: 2008-11-7 20:04

  呵呵,你是舒畅的fans?
作者: rat    时间: 2008-11-7 20:14

哈哈,那确实~
作者: wxcute    时间: 2008-11-7 20:18

这个问题倒是很新鲜。
作者: Batcher    时间: 2008-11-7 20:41

在CSDN的水区,看到各种语言版本的沙发机、盖楼机等,还真没见过VBS版本的,期待各位牛人之大作。
作者: rat    时间: 2008-11-7 20:56     标题: 回复 5楼 的帖子

这思路很简单,无非就是判断新链接产生了没有
作者: everest79    时间: 2008-11-8 07:23

验证码咋办???????
作者: batman    时间: 2008-11-8 09:11

  我觉得rat不是舒畅的fans,他简直就是宇宙超级无敌之前无古人后无来者之空前

绝后之惊世骇俗之绝对铁杆+不锈钢杆fans!!!,古人云:精诚所至金石为开,兄

弟在此由衷祝愿你的梦想成真。
作者: youxi01    时间: 2008-11-8 10:44

刚刚测试了一下,发表评论竟然不需要验证码,强!不怕死啊

要检测发表了新文章是比较好办的
先用vbs隔段时间就检测 博客 首页是否含有新连接(把老的连接保存下来)
如果有,则自动到新连接发帖就行了
至于发表帖子的时候,可以用模拟按钮单击
作者: youxi01    时间: 2008-11-8 10:46

不过还要说一句:
要抢沙发的可能性不是很大,因为sina的浏览量确实太大,可能人家刚发表还不够500ms就被人抢了沙发了

程序检测总是需要时间的,比如打开网络获取信息都需要一定时间的
作者: rat    时间: 2008-11-8 15:12

原帖由 youxi01 于 2008-11-8 10:46 发表
不过还要说一句:
要抢沙发的可能性不是很大,因为sina的浏览量确实太大,可能人家刚发表还不够500ms就被人抢了沙发了

程序检测总是需要时间的,比如打开网络获取信息都需要一定时间的


写出代码运行试试,嘿嘿
作者: everest79    时间: 2008-11-8 19:50

列表中有发表时间,取最新的一个保存下来大概就可以了
增加一个逻辑功能,每天脚本开始时先检测时间最新的文章有没留言,留了就取这个时间当标准,没留就抢了沙发现拿这时间当标准
这方面我不熟,那么兄台写了贴上来我也学习下
作者: rat    时间: 2008-11-10 01:59

原帖由 everest79 于 2008-11-8 19:50 发表
列表中有发表时间,取最新的一个保存下来大概就可以了
增加一个逻辑功能,每天脚本开始时先检测时间最新的文章有没留言,留了就取这个时间当标准,没留就抢了沙发现拿这时间当标准
这方面我不熟,那么兄台写了贴上 ...

我觉得还是直接保存最新的链接就行了,因为取链接是必需的。
作者: everest79    时间: 2008-11-10 06:20

新链接有直接提取的方法吗,要是对比,还得在本地缓存,还不如拿时间来检查
作者: rat    时间: 2008-11-10 09:03

原帖由 everest79 于 2008-11-10 06:20 发表
新链接有直接提取的方法吗,要是对比,还得在本地缓存,还不如拿时间来检查

我想到的是用正则,第一个匹配的就是最新的链接。保存最新的就行了。

嗨,纸上谈兵,哪位兄台写段代码出来研究一下。
作者: everest79    时间: 2008-11-10 17:39

  1. Set XmlHttp=CreateObject("MSxml2.XMLHTTP")
  2. XmlHttp.Open "GET","http://blog.sina.com.cn/rss/shuchang.xml",false
  3. XmlHttp.Send
  4. msgbox XmlHttp.ResponseXML.xml
复制代码
利用DOM什么的分解出这个xml文档就可以了
作者: rat    时间: 2008-11-10 20:32

要验证码呀,想法夭折了~~~~~
作者: everest79    时间: 2008-11-10 21:49

嘿嘿,那怎么办????
作者: rat    时间: 2008-11-10 22:05     标题: 回复 18楼 的帖子

只能半自动化了。验证码自己输入:(
作者: rat    时间: 2008-11-10 23:44

正在写这个半自动化的程序的代码的时候,畅姐又发表了一篇日志,没抢到沙发,遗憾之至!!!!!
作者: pusofalse    时间: 2008-11-10 23:45     标题: 回复 20楼 的帖子

沙发被我抢到了!~O(∩_∩)O~
作者: youxi01    时间: 2008-11-10 23:50

呵呵,对这个还这么感兴趣啊?追星?
不过我倒是真写过一个半自动注册的(手动输入验证码),当初是为了伪造一些数据,呵呵。
作者: rat    时间: 2008-11-11 09:43

回复 21楼 的帖子:
pusofalse版主,不会是全手动的吧?代码放出来?

回复 22楼 的帖子:
呵呵,主要是想玩一下,看用VBS能实现不:)
作者: everest79    时间: 2008-11-11 15:17

那个验证码,用ie.app来获取的话,好像不会变
作者: pusofalse    时间: 2008-11-11 17:02     标题: 回复 23楼 的帖子

- - 是,我是全手动的。。。
用批处理这事做不来,也不会VBS,所以就想用au3来判断是否更新。
寻找突破口时,碰巧发表了一篇新日志,所以我就抢到沙发了~~O(∩_∩)O~~
作者: rat    时间: 2008-11-11 18:20

回复 24楼 的帖子:
真的可以么?试试先……

回复 25楼 的帖子:
运气相当好啊!
作者: pusofalse    时间: 2008-11-11 20:09

暂时的思路是判断日志链接,并把第一次检测到的链接1写入到文件,然后将之后判断出的链接与链接1作比较,如果不相等则是新日志。。。
  1. #include <IE.Au3>
  2. $Ie = _IECreate ("http://blog.sina.com.cn/shuchang", 0, 0, 1)
  3. $Link = _IELinkGetCollection ($Ie)
  4. $Suffix = "http://blog.sina.com.cn/s/blog_49aaa[^_]*\.htmlfalse"
  5. For $ele In $Link
  6.         $error = StringRegExp ($ele.href & "false", $Suffix, 1)
  7.         If IsArray($error) Then
  8.                 $Links = $error[0]
  9.                 ExitLoop
  10.         EndIf
  11. Next
  12. _IEQuit ($Ie)
  13. $Links = StringTrimRight ($Links, 5)
  14. FileWrite ("link.x", $Links)
  15. MsgBox (0, "", $Links)
复制代码
测试程序在我的网盘里,“舒畅沙发.rar”
http://pusofalse.ys168.com/ 密码bathome
只做到了判断出新链接,添加回复那里总是找不到表格的正确位置,我想总不能用send或sendkey来完成吧,还有验证码的问题。。。

[ 本帖最后由 pusofalse 于 2008-11-11 20:16 编辑 ]
作者: rat    时间: 2008-11-13 19:34

原帖由 everest79 于 2008-11-11 15:17 发表
那个验证码,用ie.app来获取的话,好像不会变

兄的意思是可以自动填入验证码么?


还有,可不可以把新打开的IE的视图用语句直接定位到底部,而不用拉右边的滚动条
作者: everest79    时间: 2008-11-14 02:49

window.scroll x,y这个我不知道怎么转化到vbs文件中来执行,网页中加载脚本可以直接使用window对象,但在脚本中不行
作者: everest79    时间: 2008-11-14 18:31

具体你怎么实现可要贴代码上来
作者: rat    时间: 2008-11-14 18:42     标题: 回复 30楼 的帖子

具体你怎么实现可要贴代码上来

嘿嘿,一定一定
作者: rat    时间: 2008-11-15 01:15

又更新了,又没抢到……比沙发慢了2分钟…………………………

要是随便回复的话,可能要快点的。
作者: pusofalse    时间: 2008-11-16 11:42

粗略地用send发送键实现了回帖,但成功率不高~
不知rat兄注意到没有,在没有发表新回复之前,每篇文章的验证码都是一样的,包括其后发表的新日志,验证码也是同样的。可否先从旧的文章中,手动将验证码写入到文件呢。当检测到新链接时再从文件读取。

[ 本帖最后由 pusofalse 于 2008-11-16 11:49 编辑 ]
作者: rat    时间: 2008-11-16 15:07

原帖由 pusofalse 于 2008-11-16 11:42 发表
在没有发表新回复之前,每篇文章的验证码都是一样的,包括其后发表的新日志,验证码也是同样的。
不会是真的吧?
作者: everest79    时间: 2008-11-16 18:55

我觉得要弄这个,最好是用dhtml,用框架,上边显示操作,下边显示引用网页,这样所有的对象都是在一个window的子window中,处理起来也蛮方便,设想,没去试
作者: rat    时间: 2008-11-21 19:28

还是半自动版:
在后台监视到新链接后报警,并启动IE,验证码必须手动输入,其它的当然也可以自己输入,完后得自己手动提交。
抢不抢得到沙发不一定,但相信在一般情况下绝对能出现在留言首页:)
  1. Option Explicit
  2. Dim sFile, iInterval, sLink
  3. sFile = "link.wri" 'where the last link is saved
  4. iInterval = 30 'how many seconds between twice check
  5. ShowUsage
  6. Do
  7. sLink = GetLink(sFile)
  8. CheckLink sLink, iInterval
  9. OpenLink sLink
  10. PutLink sFile, sLink
  11. PlaySound
  12. InputBox "The blog has updated!", "Information", sLink
  13. Loop
  14. Sub ShowUsage()
  15. MsgBox _
  16. " Run the tool and never kill its process unless " & "you indeed know what you're doing. " & vbCrLf & _
  17. " When the tool finds that the blog has updated, it'll pop up an IE window which display " & vbCrLf & _
  18. "the right new blog, in which you can reply after inputing some messages." & vbCrLf & _
  19. " Almost at the same time, it'll start to alarm for a few seconds. " & vbCrLf & _
  20. " Then an input box will appear, where you can copy the new link and which will also attract " & vbCrLf & _
  21. "your attention to tell you a new blog has been born." & vbCrLf & _
  22. " After you close the input box, it'll continue to monitor." & vbCrLf & _
  23. " So if you'd like to stop it, you'll have to kill its process named wscript.exe." & vbCrLf & vbCrLf & vbCrLf & _
  24. " Have a good time!", _
  25. _
  26. vbInformation, _
  27. _
  28. "by youxi01, everest79, pusofalse, rat & other guys@bbs.bathome.net 2008-11-21 19:22"
  29. End Sub
  30. Function GetLink(sFile)
  31. Const LINK = "http://blog.sina.com.cn/s/blog_49aaa3430100c9od.html", READ = 1
  32. Dim oFso, oFile
  33. Set oFso = CreateObject("Scripting.FileSystemObject")
  34. If Not oFso.FileExists(sFile) Then
  35. PutLink sFile, LINK
  36. GetLink = LINK
  37. Else
  38. Set oFile = oFso.OpenTextFile(sFile, READ, False)
  39. GetLink = oFile.ReadLine()
  40. oFile.Close
  41. Set oFile = Nothing
  42. End If
  43. Set oFso = Nothing
  44. End Function
  45. Sub CheckLink(sLink, iInterval) 'idea from everest79
  46. Const URL = "http://blog.sina.com.cn/rss/shuchang.xml", COMPLETE = 4
  47. Dim oXmlHttp, sNewLink
  48. Set oXmlHttp = CreateObject("Msxml2.XMLHTTP")
  49. Do
  50. oXmlHttp.open "Get", URL, False
  51. oXmlHttp.send
  52. sNewLink = oXmlHttp.responseXML _
  53. .selectSingleNode("rss") _
  54. .selectSingleNode("channel") _
  55. .selectSingleNode("item") _
  56. .selectSingleNode("link") _
  57. .text
  58. Do Until oXmlHttp.readyState = COMPLETE
  59. WScript.Sleep 100
  60. Loop
  61. If sNewLink <> sLink Then
  62. sLink = sNewLink 'ByRef by default
  63. Exit Do
  64. Else
  65. WScript.Sleep iInterval * 1000
  66. End If
  67. Loop
  68. Set oXmlHttp = Nothing
  69. End Sub
  70. Sub OpenLink(sLink)
  71. Const COMPLETE = 4, _
  72. NAME = "bbs.bathome.net", _
  73. COMMENT = "We love you forever!", _
  74. BBS = "http://bbs.bathome.net/thread-2465-1-1.html"
  75. Dim oIE, oDocument, oWindow
  76. Set oIE = CreateObject("InternetExplorer.Application")
  77. oIE.Navigate sLink
  78. Do While (oIE.Busy Or (oIE.ReadyState <> COMPLETE))
  79. WScript.Sleep 100
  80. Loop
  81. Set oDocument = oIE.Document
  82. oDocument.All("anonymity_name").Value = NAME
  83. oDocument.All("commentArea").Value = COMMENT & vbCrLf & vbCrLf & BBS
  84. oDocument.All("anonymity").Checked = True
  85. oDocument.All("login_check").Click
  86. oDocument.All("comment_post_btn").InsertAdjacentHTML "AfterEnd", _
  87. "<div align=""right"">" & _
  88. "<a target=""_blank"" href=""" & BBS & """>The topic about the tool...</a>" & _
  89. "</div>"
  90. Set oWindow = oDocument.ParentWindow
  91. 'oWindow.ReSizeTo oScreen.Width, oScreen.Height
  92. 'oWindow.MoveTo 0, 0
  93. oWindow.Scroll 0, oIE.Document.Body.ScrollHeight 'idea from everest79
  94. 'It doesn't scroll to the bottom, why?
  95. 'And if there is a MsgBox before it, it seems as if it'll work...
  96. oIE.Visible = True
  97. 'oIE.Quit 'wait for inputting validation code
  98. Set oWindow = Nothing
  99. Set oDocument = Nothing
  100. Set oIE = Nothing
  101. End Sub
  102. Sub PutLink(sFile, sLink)
  103. Const WRITE = 2
  104. Dim oFso, oFile
  105. Set oFso = CreateObject("Scripting.FileSystemObject")
  106. Set oFile = oFso.OpenTextFile(sFile, WRITE, True)
  107. oFile.WriteLine sLink
  108. oFile.Close
  109. Set oFile = Nothing
  110. Set oFso = Nothing
  111. End Sub
  112. Sub PlaySound()
  113. Dim oWsh
  114. Set oWsh = CreateObject("WScript.Shell")
  115. oWsh.Run "mplay32 /play /close %SystemRoot%\Clock.avi", 0, True
  116. Set oWsh = Nothing
  117. End Sub
复制代码

作者: everest79    时间: 2008-11-23 23:08

刚刚创建的blog,通过对rat脚本的学习,终于搞懂了如何获取特定标签内容
参考内容:
http://www.w3school.com.cn/x.asp
http://blog.csdn.net/wf520pb/archive/2008/07/12/2644549.aspx
  1. Const RSSPath="http://blog.sina.com.cn/rss/everest79.xml"
  2. Dim Xml
  3. Set Xml=CreateObject("Msxml2.XMLHTTP")
  4. Xml.Open "Get",RSSPath,Fasle
  5. Xml.Send
  6. 'SelectSingleNode只返回符合路径的第一个结果
  7. msgbox Xml.ResponseXML.SelectSingleNode("/rss/channel/item/link").Text
  8. 'getElementsByTagName返会所有包含"title"节点的集合,需要枚举
  9. For Each x In Xml.ResponseXML.getElementsByTagName("title")
  10. Msgbox x.Text
  11. Next
  12. 'SelectNodes类似于getElemnetByTagName,但可以指定路径
  13. For Each x In Xml.ResponseXML.SelectNodes("/rss/channel/item/link")
  14. Msgbox x.Text
  15. Next
复制代码

作者: everest79    时间: 2008-11-24 08:09

学习作品,发现新浪的验证码是根据进程变化的,所以就先填验证码,要是发现有新贴就自动发贴了,没用记录文件,写注册表里了,循环还不完善
  1. Const REGPath="HKCU\Software\ScriptAuto\Temp\"
  2. Const RSSPath="http://blog.sina.com.cn/rss/everest79.xml"
  3. Const Checkwd="http://vlogin.blog.sina.com.cn/myblog/checkwd_image.php"
  4. Const iInterval=30
  5. Dim Wsh,Xml,oIe,CheckID,oLink
  6. Set Wsh=CreateObject("WScript.Shell")
  7. Set Xml=CreateObject("Msxml2.XMLHTTP")
  8. Do While True
  9. Set oIe=CreateObject("InternetExplorer.Application")
  10. CheckIN
  11. oLink=sRunLog
  12. CheckLinks
  13. PostLink GetXmlLink
  14. WScript.Sleep 10000
  15. oIe.Quit
  16. Set oIe=Nothing
  17. WScript.Sleep 10000
  18. Loop
  19. Sub CheckIN
  20. oIe.Navigate Checkwd
  21. oIe.Visible=1
  22. CheckID=Inputbox("请输入验证码!","BatHome 2008") '验证码是针对进程变化的,相同进程验证码相同,几小
  23. oIe.Visible=0
  24. End Sub
  25. Function sRunLog
  26. On Error Resume Next
  27. Do
  28. If Err.Number <> 0 Then
  29. Wsh.RegWrite REGPath,GetXmlLink
  30. Err.Clear
  31. End If
  32. sRunLog=Wsh.RegRead(REGPath)
  33. Loop While Err.Number <> 0
  34. End Function
  35. Sub CheckLinks
  36. Do While StrComp(oLink,GetXmlLink,1) = 0
  37. WScript.Sleep iInterval*1000
  38. Loop
  39. End Sub
  40. Sub PostLink(nLink)
  41. With oIe
  42. .Navigate nLink
  43. Do While .Busy Or .ReadyState <> 4
  44. WScript.Sleep 500
  45. Loop
  46. .Document.All("anonymity_name").Value="性浪"
  47. .Document.All("commentArea").Value="好大的一根毛呀"
  48. .Document.All("anonymity").Checked=True
  49. .Document.All("login_check").Value=CheckID
  50. '.Document.All("modifyTitle").Href="#post"
  51. 'WScript.Sleep 1000
  52. '.Document.All("modifyTitle").Click
  53. .Document.All("comment_post_btn").Click
  54. End With
  55. Wsh.RegWrite REGPath,nLink
  56. End Sub
  57. Function GetXmlLink
  58. Xml.Open "Get",RSSPath,Fasle
  59. Xml.Send
  60. GetXmlLink=Xml.ResponseXML.SelectSingleNode("/rss/channel/item/link").Text
  61. End Function
复制代码

作者: rat    时间: 2008-11-24 21:16

去了临时文件,全自动回复,很好!

不过还有小问题:我这边测试执行完CheckIN后,好像oIe就没了,总是提示什么已与客户断开连接。
对了,执行oIe.Navigate Checkwd 时,我这儿是提示下载图片。(XP Home + IE6)

还有,根据进程变化是什么意思呢?我好像多次运行此vbs脚本得到的验证码都是一样的。
作者: everest79    时间: 2008-11-24 23:44

出现下载图片是IE的问题,有些IE扩展组件没有激活,好像是什么补丁,不过可以通过打开空白页,然后写入<IMG SRC=Checkwd>这样来显示图片

这个验证码在同一进程下不会变化,最长是多长时间还不清楚,例如你PID为228的进程创建了显示图片的网页,那在PID228下的所有IE线程请求这个页面得到的验证码都是一样的,刷新只是字体变化
作者: pusofalse    时间: 2008-11-24 23:53

  1. #Include <IE.Au3>
  2. Opt("ExpandEnvStrings", 1)
  3. If FileExists("%Temp%\Verify.jpg") Then FileDelete("%Temp%\Verify.jpg")
  4. ;http://blog.sina.com.cn/s/blog_49aaa3430100cep9.html
  5. Global $Ie = _IECreate("Http://blog.sina.com.cn/shuchang", 0, 0, 1)
  6. ;===================Get New Link.=================
  7. $Links = _IELinkGetCollection($Ie)
  8. $Suffix = "^http://blog.sina.com.cn/s/blog_49aaa(?i)[a-z0-9]+\.html$"
  9. For $ele In $Links
  10. $CorrectLink = StringRegExp($ele.href, $Suffix, 1)
  11. If IsArray($CorrectLink) Then
  12.   $Flag1 = 1
  13.   ExitLoop
  14. EndIf
  15. Next
  16. If Not IsDeclared("Flag1") Then
  17. _IEQuit($Ie)
  18. MsgBox(16, "Error:", "出错了!~~~")
  19. Exit(-1)
  20. ElseIf Not FileExists("s.x") Then
  21. _IEQuit($Ie)
  22. FileWrite("s.x", $CorrectLink[0])
  23. Exit(0)
  24. ElseIf FileRead("s.x") <> $CorrectLink[0] Then
  25. _GetVerifyImg($CorrectLink[0])
  26. Else
  27. Exit(0)
  28. EndIf
  29. ;===================Get New Link.=================
  30. ;================Get Verifier Image=================
  31. Func _GetVerifyImg($Link)
  32. _IENavigate($Ie, $Link)
  33. _IELoadwait($Ie)
  34. _IEAction($Ie, "visible")
  35. $Images = _IEImgGetCollection($Ie)
  36. $CheckWd = "^(?i)Http://vlogin.blog.sina.com.cn/myblog/checkwd_image.php$"
  37. For $ele In $Images
  38.   $Error = StringRegExp($ele.src, $CheckWd, 0)
  39.   If $Error = 1 Then
  40.    $Flag2 = 1
  41.    InetGet($ele.src, @TempDir & "\Verify.jpg")
  42.    Run("%ComSpec% /c start %Temp%\Verify.jpg", "", @SW_HIDE)
  43.    ExitLoop
  44.   EndIf
  45. Next
  46. If Not IsDeclared("Flag2") Then
  47.   MsgBox(16, "Error:", "没有获取到验证码。")
  48.   Exit(-2)
  49. EndIf
  50. _Post()
  51. FileDelete(@TempDir & "\Verify.jpg")
  52. EndFunc ;==> End GetVerifyImg().
  53. ;================Get Verifier Image=================
  54. ;======================Post=======================
  55. Func _Post() ;Post
  56. $Name = _IEGetObjByID($Ie, "login_name")
  57. _IEPropertySet($Name, "InnerText", "pusofalse@sina.com")
  58. $Pass = _IEGetObjByID($Ie, "login_pass")
  59. _IEPropertySet($Pass, "InnerText", "purification")
  60. $CommentArea = _IEGetObjByID($Ie, "CommentArea")
  61. _IEPropertySet($CommentArea, "InnerText", "Happy!!!")
  62. WinWait("Verify.jpg")
  63. $VerifyCode = InputBox("Verify", "输入验证码:", "", "", "", "", 100, 200)
  64. If Not $VerifyCode Then Exit(-1)
  65. $Verify = _IEGetObjByID($Ie, "login_check")
  66. _IEPropertySet($Verify, "InnerText", $VerifyCode)
  67. $Submit = _IEGetObjByID($Ie, "comment_post_btn")
  68. _IEAction($Submit, "click")
  69. EndFunc ;==> End _Post().
  70. ;======================Post=======================
复制代码
遇到了同样的问题,虽能获取到验证码,但成功率不高,50%左右吧。
测试程序在我的网盘里。

[ 本帖最后由 pusofalse 于 2008-11-25 00:54 编辑 ]
作者: everest79    时间: 2008-11-25 17:27

  1. Do
  2. Audio=.Document.parentWindow.ExecScript("callAudioCheck();","javascript")
  3. CheckID=Inputbox("请输入验证码!","BatHome 2008")
  4. Loop Whlie CheckID = ""
复制代码
这个方法可行,嘿嘿,一定不会错




欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2