[7月10日 更新]115网盘摇奖脚本 [POST方式]
本帖最后由 乱码 于 2012-7-10 12:08 编辑*************************我是分割线************************************
本次没做任何功能上的更新，只是前几天我迷迷糊糊发现可以摇奖两次，
今天特意测试了一下，确实可以摇奖两次、
早上摇一次，中午12点以后又可以摇一次。
大家都试试吧、我想应该不是我的帐号特别吧、、
*************************我是分割线************************************
2012年6月7日 09:01:32 再次更新
万恶的115整天没事改网站，搞的我都觉得进错网站了。
本次更新了登录函数。
希望他别没事改登录了。。
*************************我是分割线************************************
PjUser 发表于 2012-6-8 14:32 static/image/common/back.gif
貌似现在没有雨露这个项目了啊？
嗯，我也发现官网没有了，但是返回数据里还有这些项目哦。
115可能还在考虑如何修改这些制度吧。(随便他改，别老是改登录就好。。)
{"state":true,"picked":"92MB","picked_num":92,"flag":false,"total_size":"15620MB","used_percent":"0%","exp":966}
这些是115摇奖后的返回数据
*************************我是分割线************************************
2012年5月22日 11:19:47 更新一下
115更新了登录模式，之前的中文用户名不再支持了
现在只支持 邮箱、手机 和 数字帐号
115其实不算太成功，但是用的人多了，也就成功了，就像TX一样。
当然我不是嫉妒他的成功，也不是觊觎他的成就，只是抒发下情感而已。
下面是本人无聊所作。写好代码想在群里找人测试，竟然没人愿意。
无奈，自己创建一个小号测试，非常成功。
下面源码放出，用到的话自己拿吧...
100%原创，什么都不说了。
'Version: 1.1
'Date : 2012-06-07
'Author:乱码
'源码献上，欢迎翻版。
user = "115用户名" '用户名支持 邮箱、手机 和 数字帐号
pass = "115密码"
Set http = CreateObject("Msxml2.ServerXMLHTTP")
If login(user,pass) Then
code=getCode()
If Len(code) Then
Set o=getSpace(code)
If o.state Then
Popup "获得空间:" & o.picked & ", 获得雨露:" & o.exp, 3, "获得的奖励", 16+4096
Else
Popup "摇奖失败 或者 已经摇过了", 3, "失败", 16+4096
End If
Else
Popup "今天已经摇过了...", 3, "提示", 16+4096
End If
Else
Popup "登录失败！...", 3, "失败", 16+4096
End If
Function HttpPost(ByVal url, ByVal data)
With http
.open "POST", url, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send data
HttpPost = .responseText
End With
End Function
Function HttpGet(ByVal url)
With http
.open "GET", url, False
.send
HttpGet = .responseText
End With
End Function
Function UTF8(str)
UTF8 = ""
ZTEP = str & ""
If ZTEP = "" Then Exit Function
For I = 1 To Len(ZTEP)
ZA = Mid(ZTEP, I, 1)
ZC = Asc(ZA)
If ZC > 127 Or ZC < 0 Then
ZC = AscW(ZA)
If ZC < 0 Then ZC = &H10000 + ZC
If ZC < 2048 Then
UTF8 = UTF8 & "%" & Hex(((ZC \ &H40) And &H1F) Or &HC0) & "%" & Hex((ZC And &H3F) Or &H80)
Else
UTF8 = UTF8 & "%" & Hex(((ZC \ &H1000) And &HF) Or &HE0) & "%" & Hex(((ZC \ &H40) And &H3F) Or &H80) & "%" & Hex((ZC And &H3F) + &H80)
End If
Else
UTF8 = UTF8 & ZA
End If
Next
End Function
Function login(user,password)
url="http://passport.115.com/?ac=login"
data="back=http%3A%2F%2Fwww.115.com&goto=http%3A%2F%2F115.com&login%5Baccount%5D=" & UTF8(user) & "&login%5Bpasswd%5D=" & password
login = Len(HttpPost(url,data))<99
End Function
Function getCode()
Set reg = New RegExp
reg.IgnoreCase = True
reg.Global = True
reg.MultiLine = True
reg.Pattern = "Yao\('(.*)',\s*function"
html = HttpGet("http://115.com/?ct=index&ac=home")
If reg.Test(html) Then getCode=Trim(reg.Execute(html).Item(0).Submatches(0)) Else getCode=""
End Function
Function ParseJson(strJson)
Set htmlfile = CreateObject("htmlfile")
Set owindow = htmlfile.parentWindow
owindow.execScript "var json_obj = " & strJson, "JScript"
Set ParseJson = owindow.json_obj
End Function
Function getSpace(code)
url="http://115.com/?ct=ajax_user&ac=pick_space&token=" & code & "&_=" & Rnd
Set getSpace = ParseJson(HttpGet(url))
End Function
Function Popup(msg,t,tit,btn)
CreateObject("Wscript.Shell").Popup msg & vbCrLf & vbCrLf & "本窗口" & t & "秒后自动关闭。", t, tit, btn
End Function
VBS脚本，好强啊！！ 测试OK，很强大~~ {:301_997:}
呵呵... 呵呵要是有每次都可以摇出百兆以上的 就更好了 用的人多了，也就成功了，就像TX一样 是这样的啊！ 很牛掰的,,,,
验证成功 {:1_918:} 好强大啊。能弄个华为的不？
goldmen 发表于 2012-4-2 18:25 static/image/common/back.gif
好强大啊。能弄个华为的不？
没用过，我去看看先... 运气不错。。。都中了