[Visual Basic] 纯文本查看 复制代码
'2013-02-22 17:57:25 更新
'此次更新，因吾爱去掉登录验证码而更新了登录函数
[帐号] = "帐号" '用户名支持中文
[密码] = "密码" '密码
[问题] = "编号" '安全提问编号，下面是安全问题对应编号
[答案] = "答案" '安全提问答案
'0.无安全提问(选此项请将答案设为空)
'1.母亲的名字
'2.爷爷的名字
'3.父亲出生的城市
'4.你其中一位老师的名字
'5.你个人计算机的型号
'6.你最喜欢的餐馆名称
'7.驾驶执照最后四位数字
Set [吾爱] = New [吾爱破解]
[吾爱].[挂机] [帐号], [密码], [问题], [答案]
Class [吾爱破解]
'****************************************************
'乱码领域 吾爱破解挂机类
'****************************************************
'v2.0 集成登陆，签到，挂机，掉线重连功能
'****************************************************
'版本: 2.0
'日期: 2013-02-17 03:14:47
'作者: 乱码
'源码献上,欢迎翻版。
'****************************************************
Private http, fso, shell, host, user, pwd, qst, ans
Sub Class_Initialize '类初始化事件
'Set http = CreateObject("Msxml2.ServerXMLHTTP")
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("Wscript.Shell")
host = "http://www.52pojie.cn/"
End Sub
Public Function [挂机](u, p, q, a) '挂机初始化函数
user = u
pwd = p
qst = q
ans = a
If login Then
shell.Popup "登录成功，即将开始挂机", 5, "开始挂机", 64+4096
refresh 10 '10分钟刷新一次(设置为30分钟以内就好。)
Else
shell.Popup "登录失败。。。", 5, "登录失败", 48+4096
End If
End Function
Private Function refresh(minutes) '刷新页面函数(保持在线)
Do
If Not isOnLine Then
fso.OpenTextFile("52pojielog.txt",8,1).WriteLine "脚本掉线 - " & Now
'生成日志，记录掉线时间。'如果不需要就删除这句。
login
End If
WScript.Sleep minutes * 60000
Loop
End Function
Private Function isOnLine() '检查是否在线函数(集成签到功能)
html = HttpGet("home.php?mod=task&do=apply&id=2")
If html="" Or InStr(html,"您需要先登录才能继续本操作") Then
isOnLine=False
Else
isOnLine =True
End If
End Function
Private Function login() '登录函数
Set reg = New RegExp
reg.IgnoreCase = True
reg.Global = True
reg.MultiLine = True
html = httpGet("member.php?mod=logging&action=login&infloat=yes&frommessage&inajax=1")
reg.Pattern = "loginhash=([^""&]+)"
If reg.Test(html) Then
loginhash = reg.Execute(html).Item(0).Submatches(0)
reg.Pattern = "name=.?formhash.?\s+value=['""]?([^""]+)"
formhash = reg.Execute(html).Item(0).Submatches(0)
'=====================================================
'验证码部分
'reg.Pattern = "updateseccode\('(\w+)'\)"
'sechash = reg.Execute(html).Item(0).Submatches(0)
'html = httpGet("misc.php?mod=seccode&action=update&idhash=" & sechash & "&inajax=1&ajaxtarget=seccode_" & sechash)
'reg.Pattern = "misc\.php\?mod=seccode&update=\d+&idhash=\w+"
'verify = reg.Execute(html).Item(0).Value
'verify = verifyCode(host & verify)
'If verify = "" Then WScript.Quit '不输人验证码者退出
'=====================================================
postUrl = "member.php?mod=logging&action=login&loginsubmit=yes&handlekey=login&inajax=1&loginhash=" & loginhash
'postData = "formhash=" & formhash & "&referer=http%3A%2F%2Fwww.52pojie.cn%2F&username=" & URLEncode(user) & "&password=" & md5(pwd) & "&questionid=" & qst & "&answer=" & URLEncode(ans) & "&sechash=" & sechash & "&seccodeverify=" & verify & "&cookietime=2592000&loginsubmit=true"
'上面是带验证码的post数据
postData = "formhash=" & formhash & "&referer=http%3A%2F%2Fwww.52pojie.cn%2F&username=" & URLEncode(user) & "&password=" & md5(pwd) & "&questionid=" & qst & "&answer=" & URLEncode(ans) & "&cookietime=2592000&loginsubmit=true"
html = httpPost(postUrl,postData)
login = InStr(html,"欢迎您回来")
Else
login = False
End If
End Function
Private Function httpGet(url) 'get函数
On Error Resume Next
http.open "GET", host & url, False
http.SetRequestHeader "Referer", host
http.send
httpGet = http.responseText
End Function
Private Function httpPost(url,data) 'post函数
On Error Resume Next
http.open "POST", host & url, False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
http.SetRequestHeader "Referer", host
http.send data
httpPost = http.responseText
End Function
Private Function URLEncode(strURL) 'url编码函数 (如果需要UTF-8编码请找我)
For I = 1 To Len(strURL)
If Asc(Mid(strURL, I, 1)) < 0 Then
tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & tempStr
URLEncode = URLEncode & tempStr
ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And Asc(Mid(strURL, I, 1)) <= 122) Or (Asc(Mid(strURL, I, 1)) >= 48 And Asc(Mid(strURL, I, 1)) <= 57) Then
URLEncode = URLEncode & Mid(strURL, I, 1)
Else
URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
End If
Next
End Function
Private Function md5(zStr) 'js版MD5加密
With CreateObject("HTMLFile")
.parentWindow.execScript "(function(s){var l=function(a,c){var g,h,j,k,b;j=a&2147483648;k=c&2147483648;g=a&1073741824;h=c&1073741824;b=(a&1073741823)+(c&1073741823);return g&h?b^2147483648^j^k:g|h?b&1073741824?b^3221225472^j^k:b^1073741824^j^k:b^j^k},m=function(a,c,g,h,j,k,b){a=l(a,l(l(c&g|~c&h,j),b));return l(a<<k|a>>>32-k,c)},n=function(a,c,g,h,j,k,b){a=l(a,l(l(c&h|g&~h,j),b));return l(a<<k|a>>>32-k,c)},p=function(a,c,g,h,j,k,b){a=l(a,l(l(c^g^h,j),b));return l(a<<k|a>>>32-k,c)},q=function(a,c,g,h,j,k,b){a=l(a,l(l(g^(c|~h),j),b));return l(a<<k|a>>>32-k,c)},r=function(a){var c='',g='',h;for(h=0;3>=h;h++)g=a>>>8*h&255,g='0'+g.toString(16),c+=g.substr(g.length-2,2);return c};s.md5=function(a){var c=[],g,h,j,k,b,d,e,f,c=a.replace(/\x0d\x0a/g,'\n');a='';for(g=0;g<c.length;g++)h=c.charCodeAt(g),128>h?a+=String.fromCharCode(h):(127<h&&2048>h?a+=String.fromCharCode(h>>6|192):(a+=String.fromCharCode(h>>12|224),a+=String.fromCharCode(h>>6&63|128)),a+=String.fromCharCode(h&63|128));c=a;a=c.length;g=a+8;h=16*((g-g%64)/64+1);j=Array(h-1);for(b=k=0;b<a;)g=(b-b%4)/4,k=8*(b%4),j[g]|=c.charCodeAt(b)<<k,b++;g=(b-b%4)/4;j[g]|=128<<8*(b%4);j[h-2]=a<<3;j[h-1]=a>>>29;c=j;b=1732584193;d=4023233417;e=2562383102;f=271733878;for(a=0;a<c.length;a+=16)g=b,h=d,j=e,k=f,b=m(b,d,e,f,c[a+0],7,3614090360),f=m(f,b,d,e,c[a+1],12,3905402710),e=m(e,f,b,d,c[a+2],17,606105819),d=m(d,e,f,b,c[a+3],22,3250441966),b=m(b,d,e,f,c[a+4],7,4118548399),f=m(f,b,d,e,c[a+5],12,1200080426),e=m(e,f,b,d,c[a+6],17,2821735955),d=m(d,e,f,b,c[a+7],22,4249261313),b=m(b,d,e,f,c[a+8],7,1770035416),f=m(f,b,d,e,c[a+9],12,2336552879),e=m(e,f,b,d,c[a+10],17,4294925233),d=m(d,e,f,b,c[a+11],22,2304563134),b=m(b,d,e,f,c[a+12],7,1804603682),f=m(f,b,d,e,c[a+13],12,4254626195),e=m(e,f,b,d,c[a+14],17,2792965006),d=m(d,e,f,b,c[a+15],22,1236535329),b=n(b,d,e,f,c[a+1],5,4129170786),f=n(f,b,d,e,c[a+6],9,3225465664),e=n(e,f,b,d,c[a+11],14,643717713),d=n(d,e,f,b,c[a+0],20,3921069994),b=n(b,d,e,f,c[a+5],5,3593408605),f=n(f,b,d,e,c[a+10],9,38016083),e=n(e,f,b,d,c[a+15],14,3634488961),d=n(d,e,f,b,c[a+4],20,3889429448),b=n(b,d,e,f,c[a+9],5,568446438),f=n(f,b,d,e,c[a+14],9,3275163606),e=n(e,f,b,d,c[a+3],14,4107603335),d=n(d,e,f,b,c[a+8],20,1163531501),b=n(b,d,e,f,c[a+13],5,2850285829),f=n(f,b,d,e,c[a+2],9,4243563512),e=n(e,f,b,d,c[a+7],14,1735328473),d=n(d,e,f,b,c[a+12],20,2368359562),b=p(b,d,e,f,c[a+5],4,4294588738),f=p(f,b,d,e,c[a+8],11,2272392833),e=p(e,f,b,d,c[a+11],16,1839030562),d=p(d,e,f,b,c[a+14],23,4259657740),b=p(b,d,e,f,c[a+1],4,2763975236),f=p(f,b,d,e,c[a+4],11,1272893353),e=p(e,f,b,d,c[a+7],16,4139469664),d=p(d,e,f,b,c[a+10],23,3200236656),b=p(b,d,e,f,c[a+13],4,681279174),f=p(f,b,d,e,c[a+0],11,3936430074),e=p(e,f,b,d,c[a+3],16,3572445317),d=p(d,e,f,b,c[a+6],23,76029189),b=p(b,d,e,f,c[a+9],4,3654602809),f=p(f,b,d,e,c[a+12],11,3873151461),e=p(e,f,b,d,c[a+15],16,530742520),d=p(d,e,f,b,c[a+2],23,3299628645),b=q(b,d,e,f,c[a+0],6,4096336452),f=q(f,b,d,e,c[a+7],10,1126891415),e=q(e,f,b,d,c[a+14],15,2878612391),d=q(d,e,f,b,c[a+5],21,4237533241),b=q(b,d,e,f,c[a+12],6,1700485571),f=q(f,b,d,e,c[a+3],10,2399980690),e=q(e,f,b,d,c[a+10],15,4293915773),d=q(d,e,f,b,c[a+1],21,2240044497),b=q(b,d,e,f,c[a+8],6,1873313359),f=q(f,b,d,e,c[a+15],10,4264355552),e=q(e,f,b,d,c[a+6],15,2734768916),d=q(d,e,f,b,c[a+13],21,1309151649),b=q(b,d,e,f,c[a+4],6,4149444226),f=q(f,b,d,e,c[a+11],10,3174756917),e=q(e,f,b,d,c[a+2],15,718787259),d=q(d,e,f,b,c[a+9],21,3951481745),b=l(b,g),d=l(d,h),e=l(e,j),f=l(f,k);return(r(b)+r(d)+r(e)+r(f)).toLowerCase()}})(window)", "JScript"
md5 = .parentWindow.md5(zStr)
End With
End Function
Private Function verifyCode(verifyCodeUrl) '验证码输入框 (30秒自动关闭)
On Error Resume Next
Dim shell, tempFolder, tempName, tempFile
Set shell = CreateObject("WScript.Shell")
Set tempFolder = fso.GetSpecialFolder(2)
tempName = fso.GetTempName()
Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
tempFile.Write _
"<html><head>" &_
"<title>请输入验证码</title>" &_
"<HTA:APPLICATION BORDER='dialog' BORDERSTYLE='static' INNERBORDER='no' MAXIMIZEBUTTON='no' MINIMIZEBUTTON='no' SCROLL='no' SHOWINTASKBAR='no' CONTEXTMENU='no' SELECTION='no'/>" &_
"</head><script>" &_
"var width=200,height=150;" &_
"moveTo((screen.availWidth-width)/2,(screen.availHeight-height)/2);" &_
"resizeTo(width,height);" &_
"</script><body>" &_
"<div style='text-align:center'>" &_
"<img id='verifyCode' src='data:image/gif;base64," & loadpic(verifyCodeUrl) & "' alt='正在加载...' /><hr>" &_
"<input type='text' id='vCode' style='width:60px' /> " &_
"<input type='button' id='send' value='确定' /></div><script>" &_
"send.onclick=function(){var shell=new ActiveXObject('WScript.Shell');" &_
"shell.RegWrite('HKEY_CURRENT_USER\\Volatile Environment\\MsgResp',vCode.value);" &_
"window.close();};setTimeout('window.close()',30000);" &_
"</script></body></html>"
tempFile.Close
shell.Run tempFolder & "\" & tempName & ".hta", 1, True
verifyCode = shell.RegRead("HKEY_CURRENT_USER\Volatile Environment\MsgResp")
shell.RegDelete "HKEY_CURRENT_USER\Volatile Environment\MsgResp"
fso.DeleteFile tempFolder & "\" & tempName & ".hta", True
End Function
Private Function loadpic(url) '伪造Referer下载图片
http.Open "GET",url ,False
http.SetRequestHeader "Referer", host
http.Send
loadpic = EncodeBase64(http.ResponseBody)
End Function
Private Function EncodeBase64(bytes) '将文件base64编码
With CreateObject("Microsoft.XMLDOM").createElement("TXT")
.dataType = "bin.base64"
.nodeTypedValue = bytes
EncodeBase64 = .text
End With
End Function
End Class
[复制链接]
发表于 2013-2-20 14:11
发表于 2013-2-20 14:18
