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

rat

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

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

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

everest79

Do
Audio=.Document.parentWindow.ExecScript("callAudioCheck();","javascript")
CheckID=Inputbox("请输入验证码!","BatHome 2008")
Loop Whlie CheckID = ""
复制代码

这个方法可行，嘿嘿，一定不会错

pusofalse

#Include <IE.Au3>
Opt("ExpandEnvStrings", 1)
If FileExists("%Temp%\Verify.jpg") Then FileDelete("%Temp%\Verify.jpg")
;http://blog.sina.com.cn/s/blog_49aaa3430100cep9.html
Global $Ie = _IECreate("Http://blog.sina.com.cn/shuchang", 0, 0, 1)
;===================Get New Link.=================
$Links = _IELinkGetCollection($Ie)
$Suffix = "^http://blog.sina.com.cn/s/blog_49aaa(?i)[a-z0-9]+\.html$"
For $ele In $Links
 $CorrectLink = StringRegExp($ele.href, $Suffix, 1)
 If IsArray($CorrectLink) Then
  $Flag1 = 1
  ExitLoop
 EndIf
Next
If Not IsDeclared("Flag1") Then
 _IEQuit($Ie)
 MsgBox(16, "Error:", "出错了！~~~")
 Exit(-1)
ElseIf Not FileExists("s.x") Then
 _IEQuit($Ie)
 FileWrite("s.x", $CorrectLink[0])
 Exit(0)
ElseIf FileRead("s.x") <> $CorrectLink[0] Then
 _GetVerifyImg($CorrectLink[0])
Else
 Exit(0)
EndIf
;===================Get New Link.=================
;================Get Verifier Image=================
Func _GetVerifyImg($Link)
 _IENavigate($Ie, $Link)
 _IELoadwait($Ie)
 _IEAction($Ie, "visible")
 $Images = _IEImgGetCollection($Ie)
 $CheckWd = "^(?i)Http://vlogin.blog.sina.com.cn/myblog/checkwd_image.php$"
 For $ele In $Images
  $Error = StringRegExp($ele.src, $CheckWd, 0)
  If $Error = 1 Then
   $Flag2 = 1
   InetGet($ele.src, @TempDir & "\Verify.jpg")
   Run("%ComSpec% /c start %Temp%\Verify.jpg", "", @SW_HIDE)
   ExitLoop
  EndIf
 Next
 If Not IsDeclared("Flag2") Then
  MsgBox(16, "Error:", "没有获取到验证码。")
  Exit(-2)
 EndIf
 _Post()
 FileDelete(@TempDir & "\Verify.jpg")
EndFunc ;==> End GetVerifyImg().
;================Get Verifier Image=================
;======================Post=======================
Func _Post() ;Post
 $Name = _IEGetObjByID($Ie, "login_name")
 _IEPropertySet($Name, "InnerText", "pusofalse@sina.com")
 $Pass = _IEGetObjByID($Ie, "login_pass")
 _IEPropertySet($Pass, "InnerText", "purification")
 $CommentArea = _IEGetObjByID($Ie, "CommentArea")
 _IEPropertySet($CommentArea, "InnerText", "Happy!!!")
 WinWait("Verify.jpg")
 $VerifyCode = InputBox("Verify", "输入验证码：", "", "", "", "", 100, 200)
 If Not $VerifyCode Then Exit(-1)
 $Verify = _IEGetObjByID($Ie, "login_check")
 _IEPropertySet($Verify, "InnerText", $VerifyCode)
 $Submit = _IEGetObjByID($Ie, "comment_post_btn")
 _IEAction($Submit, "click")
EndFunc ;==> End _Post().
;======================Post=======================
复制代码

遇到了同样的问题，虽能获取到验证码，但成功率不高，50%左右吧。
测试程序在我的网盘里。

[ 本帖最后由 pusofalse 于 2008-11-25 00:54 编辑 ]

everest79

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

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

rat

去了临时文件，全自动回复，很好！

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

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

everest79

学习作品，发现新浪的验证码是根据进程变化的，所以就先填验证码，要是发现有新贴就自动发贴了，没用记录文件，写注册表里了，循环还不完善

Const REGPath="HKCU\Software\ScriptAuto\Temp\"
Const RSSPath="http://blog.sina.com.cn/rss/everest79.xml"
Const Checkwd="http://vlogin.blog.sina.com.cn/myblog/checkwd_image.php"
Const iInterval=30


Dim Wsh,Xml,oIe,CheckID,oLink
Set Wsh=CreateObject("WScript.Shell")
Set Xml=CreateObject("Msxml2.XMLHTTP")


Do While True
Set oIe=CreateObject("InternetExplorer.Application")
CheckIN
oLink=sRunLog
CheckLinks
PostLink GetXmlLink
WScript.Sleep 10000
oIe.Quit
Set oIe=Nothing
WScript.Sleep 10000
Loop

Sub CheckIN
oIe.Navigate Checkwd 
oIe.Visible=1
CheckID=Inputbox("请输入验证码!","BatHome 2008") '验证码是针对进程变化的，相同进程验证码相同，几小
oIe.Visible=0
End Sub

Function sRunLog
On Error Resume Next
Do
If Err.Number <> 0 Then
Wsh.RegWrite REGPath,GetXmlLink
Err.Clear
End If
sRunLog=Wsh.RegRead(REGPath)
Loop While Err.Number <> 0
End Function

Sub CheckLinks
Do While StrComp(oLink,GetXmlLink,1) = 0
WScript.Sleep iInterval*1000
Loop
End Sub

Sub PostLink(nLink)
With oIe
.Navigate nLink 
Do While .Busy Or .ReadyState <> 4
WScript.Sleep 500
Loop
.Document.All("anonymity_name").Value="性浪"
.Document.All("commentArea").Value="好大的一根毛呀"
.Document.All("anonymity").Checked=True
.Document.All("login_check").Value=CheckID
'.Document.All("modifyTitle").Href="#post"
'WScript.Sleep 1000
'.Document.All("modifyTitle").Click
.Document.All("comment_post_btn").Click
End With
Wsh.RegWrite REGPath,nLink
End Sub

Function GetXmlLink
Xml.Open "Get",RSSPath,Fasle
Xml.Send
GetXmlLink=Xml.ResponseXML.SelectSingleNode("/rss/channel/item/link").Text
End Function
复制代码

everest79

刚刚创建的blog，通过对rat脚本的学习，终于搞懂了如何获取特定标签内容
参考内容：
http://www.w3school.com.cn/x.asp
http://blog.csdn.net/wf520pb/archive/2008/07/12/2644549.aspx

Const RSSPath="http://blog.sina.com.cn/rss/everest79.xml"
Dim Xml
Set Xml=CreateObject("Msxml2.XMLHTTP")
Xml.Open "Get",RSSPath,Fasle
Xml.Send
'SelectSingleNode只返回符合路径的第一个结果
msgbox Xml.ResponseXML.SelectSingleNode("/rss/channel/item/link").Text

'getElementsByTagName返会所有包含"title"节点的集合，需要枚举
For Each x In Xml.ResponseXML.getElementsByTagName("title")
Msgbox x.Text
Next

'SelectNodes类似于getElemnetByTagName，但可以指定路径
For Each x In Xml.ResponseXML.SelectNodes("/rss/channel/item/link")
Msgbox x.Text
Next
复制代码

rat

还是半自动版：
在后台监视到新链接后报警，并启动IE，验证码必须手动输入，其它的当然也可以自己输入，完后得自己手动提交。
抢不抢得到沙发不一定，但相信在一般情况下绝对能出现在留言首页：）

Option Explicit

Dim sFile, iInterval, sLink
sFile = "link.wri"	'where the last link is saved
iInterval = 30	'how many seconds between twice check

ShowUsage
Do
	sLink = GetLink(sFile)
	CheckLink sLink, iInterval
	OpenLink sLink
	PutLink sFile, sLink
	PlaySound
	InputBox "The blog has updated!", "Information", sLink
Loop



Sub ShowUsage()
	MsgBox _
		"	Run the tool and never kill its process unless " & "you indeed know what you're doing. " & vbCrLf & _
		"	When the tool finds that the blog has updated, it'll pop up an IE window which display " & vbCrLf & _
		"the right new blog, in which you can reply after inputing some messages." & vbCrLf & _
		"	Almost at the same time, it'll start to alarm for a few seconds. " & vbCrLf & _
		"	Then an input box will appear, where you can copy the new link and which will also attract " & vbCrLf & _
		"your attention to tell you a new blog has been born." & vbCrLf & _
		"	After you close the input box, it'll continue to monitor." & vbCrLf & _
		"	So if you'd like to stop it, you'll have to kill its process named wscript.exe." & vbCrLf & vbCrLf & vbCrLf & _
		"	Have a good time!", _
		 _
		vbInformation, _
		 _
		"by youxi01, everest79, pusofalse, rat & other guys@bbs.bathome.net 2008-11-21 19:22"
End Sub

Function GetLink(sFile)
	Const LINK = "http://blog.sina.com.cn/s/blog_49aaa3430100c9od.html", READ = 1
	Dim oFso, oFile
	Set oFso = CreateObject("Scripting.FileSystemObject")
	
	If Not oFso.FileExists(sFile) Then
		PutLink sFile, LINK
		GetLink = LINK
	Else
		Set oFile = oFso.OpenTextFile(sFile, READ, False)
		GetLink = oFile.ReadLine()
		oFile.Close
		Set oFile = Nothing	
	End If
	
	Set oFso = Nothing
End Function

Sub CheckLink(sLink, iInterval)	'idea from everest79
	Const URL = "http://blog.sina.com.cn/rss/shuchang.xml", COMPLETE = 4
	Dim oXmlHttp, sNewLink
	Set oXmlHttp = CreateObject("Msxml2.XMLHTTP")
	
	Do
		oXmlHttp.open "Get", URL, False
		oXmlHttp.send
		sNewLink = oXmlHttp.responseXML _
			.selectSingleNode("rss") _
			.selectSingleNode("channel") _
			.selectSingleNode("item") _
			.selectSingleNode("link") _
			.text
		Do Until oXmlHttp.readyState = COMPLETE
			WScript.Sleep 100
		Loop
		If sNewLink <> sLink Then
			sLink = sNewLink	'ByRef by default
			Exit Do
		Else
			WScript.Sleep iInterval * 1000
		End If
	Loop
	
	Set oXmlHttp = Nothing
End Sub

Sub OpenLink(sLink)
	Const COMPLETE = 4, _
		NAME = "bbs.bathome.net", _
		COMMENT = "We love you forever!", _
		BBS = "http://bbs.bathome.net/thread-2465-1-1.html"
	Dim oIE, oDocument, oWindow
	Set oIE = CreateObject("InternetExplorer.Application")
	
	oIE.Navigate sLink
	Do While (oIE.Busy Or (oIE.ReadyState <> COMPLETE))
		WScript.Sleep 100
	Loop
	
	Set oDocument = oIE.Document
	oDocument.All("anonymity_name").Value = NAME
	oDocument.All("commentArea").Value = COMMENT & vbCrLf & vbCrLf & BBS
	oDocument.All("anonymity").Checked = True
	oDocument.All("login_check").Click
	oDocument.All("comment_post_btn").InsertAdjacentHTML "AfterEnd", _
		"<div align=""right"">" & _
			"<a target=""_blank"" href=""" & BBS & """>The topic about the tool...</a>" & _
		"</div>"
	
	Set oWindow = oDocument.ParentWindow
	'oWindow.ReSizeTo oScreen.Width, oScreen.Height
	'oWindow.MoveTo 0, 0
	oWindow.Scroll 0, oIE.Document.Body.ScrollHeight		'idea from everest79
		'It doesn't scroll to the bottom, why?
		'And if there is a MsgBox before it, it seems as if it'll work...
	
	oIE.Visible = True
	'oIE.Quit	'wait for inputting validation code
	
	Set oWindow = Nothing
	Set oDocument = Nothing
	Set oIE = Nothing
End Sub

Sub PutLink(sFile, sLink)
	Const WRITE = 2
	Dim oFso, oFile
	Set oFso = CreateObject("Scripting.FileSystemObject")
	Set oFile = oFso.OpenTextFile(sFile, WRITE, True)
	
	oFile.WriteLine sLink
	
	oFile.Close
	Set oFile = Nothing
	Set oFso = Nothing	
End Sub

Sub PlaySound()
	Dim oWsh
	Set oWsh = CreateObject("WScript.Shell")
	
	oWsh.Run "mplay32 /play /close %SystemRoot%\Clock.avi", 0, True
	
	Set oWsh = Nothing
End Sub
复制代码

everest79

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

rat

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

不会是真的吧？

pusofalse

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

[ 本帖最后由 pusofalse 于 2008-11-16 11:49 编辑 ]

rat

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

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

rat

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

嘿嘿，一定一定

everest79

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

everest79

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