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
复制代码

rat

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

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

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