标题: [讨论]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
- Set XmlHttp=CreateObject("MSxml2.XMLHTTP")
- XmlHttp.Open "GET","http://blog.sina.com.cn/rss/shuchang.xml",false
- XmlHttp.Send
- 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作比较,如果不相等则是新日志。。。- #include <IE.Au3>
- $Ie = _IECreate ("http://blog.sina.com.cn/shuchang", 0, 0, 1)
- $Link = _IELinkGetCollection ($Ie)
- $Suffix = "http://blog.sina.com.cn/s/blog_49aaa[^_]*\.htmlfalse"
- For $ele In $Link
- $error = StringRegExp ($ele.href & "false", $Suffix, 1)
- If IsArray($error) Then
- $Links = $error[0]
- ExitLoop
- EndIf
- Next
- _IEQuit ($Ie)
- $Links = StringTrimRight ($Links, 5)
- FileWrite ("link.x", $Links)
- 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,验证码必须手动输入,其它的当然也可以自己输入,完后得自己手动提交。
抢不抢得到沙发不一定,但相信在一般情况下绝对能出现在留言首页:)- 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 时间: 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- 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
复制代码
作者: everest79 时间: 2008-11-24 08:09
学习作品,发现新浪的验证码是根据进程变化的,所以就先填验证码,要是发现有新贴就自动发贴了,没用记录文件,写注册表里了,循环还不完善- 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
复制代码
作者: 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
- #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 时间: 2008-11-25 17:27
- Do
- Audio=.Document.parentWindow.ExecScript("callAudioCheck();","javascript")
- CheckID=Inputbox("请输入验证码!","BatHome 2008")
- Loop Whlie CheckID = ""
复制代码
这个方法可行,嘿嘿,一定不会错
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |