[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[讨论]VBS抢占舒畅博客的沙发

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

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

[ 本帖最后由 rat 于 2008-11-16 15:08 编辑 ]

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

评分人数

    • rat: 创意无限,精彩无限PB + 8

TOP

  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 编辑 ]
1

评分人数

    • rat: pusofalse版主的Au3越来越牛了PB + 18
心绪平和,眼藏静谧。

TOP

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

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

TOP

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

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

还有,根据进程变化是什么意思呢?我好像多次运行此vbs脚本得到的验证码都是一样的。

TOP

学习作品,发现新浪的验证码是根据进程变化的,所以就先填验证码,要是发现有新贴就自动发贴了,没用记录文件,写注册表里了,循环还不完善
  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
复制代码
1

评分人数

    • rat: 很好很强大技术 + 1 PB + 20

TOP

刚刚创建的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
复制代码
1

评分人数

    • rat: [quote]/rss/channel/item/link[/quote]很好PB + 10

TOP

还是半自动版:
在后台监视到新链接后报警,并启动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
复制代码
2

评分人数

    • everest79: 针对此脚本学习xmlhttp及xml dom相关技术 + 1 PB + 6
    • pusofalse: 厉害!技术 + 1 PB + 10

TOP

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

TOP

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

TOP

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

[ 本帖最后由 pusofalse 于 2008-11-16 11:49 编辑 ]
心绪平和,眼藏静谧。

TOP

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

要是随便回复的话,可能要快点的。

TOP

回复 30楼 的帖子

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

嘿嘿,一定一定

TOP

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

TOP

window.scroll x,y这个我不知道怎么转化到vbs文件中来执行,网页中加载脚本可以直接使用window对象,但在脚本中不行
1

评分人数

    • rat: Thanks for your reply. Now I see.PB + 8

TOP

返回列表