[原创] 115摇一摇脚本 v1.2 多帐号版 [VBS POST]

乱码

前些天我写的，在吾爱上发布的，既然来这了，那么也就奉献一下、
115摇一摇脚本 v1.2 多帐号版 [VBS POST]
http://www.52pojie.cn/thread-156176-1-1.html
效果图啥的就不发了，可以去这篇帖子上看效果、、


'Version: 1.2 (多帐号版)
'Date   : 2012-07-10
'Author : 乱码
'源码献上，欢迎翻版。

CmdMode "115摇一摇 v1.2(多帐号版) By.乱码","3f"

'用户名支持：邮箱、手机 和 数字帐号
user = Array( _
    "115帐号1" ,_
    "115帐号2" ,_
    "115帐号3" ,_
    "115帐号4" _
)
'密码要对应上面的用户名
pass = Array( _
    "115密码1" ,_
    "115密码2" ,_
    "115密码3" ,_
    "115密码4" _
)

autoExit = 0 '自动退出开关 [0不自动退出, 1自动退出]

For i=0 To UBound(user)
    Set http = CreateObject("Msxml2.ServerXMLHTTP")
    If login(user(i),pass(i)) Then '登录
        code = getCode() '获取摇奖码
        If Len(code) Then
            Set o=getSpace(code) '摇奖，返回json对象
            If o.state Then '判断摇奖状态
                '返回数据样例：{"state":true,"picked":"92MB","picked_num":92,"flag":false,"total_size":"15620MB","used_percent":"0%","exp":966}
                WScript.Echo vbCrLf, user(i), "本次摇奖信息：", vbCrLf, "获得空间:", o.picked, ", 获得雨露:", o.Exp, ", 总空间:",  o.total_size, ", 已经使用:",  o.used_percent
            Else
                WScript.Echo user(i), "摇奖失败 或者 已经摇过了"
            End If
        Else
            WScript.Echo user(i), "今天已经摇过了..."
        End If
    Else
        WScript.Echo user(i), "登录失败！..."
    End If
    Set http = Nothing
Next

If autoExit Then WScript.Quit '是否自动退出
WScript.Echo vbCrLf, "按任意键退出..."
WScript.StdIn.ReadLine


Function HttpPost(ByVal url, ByVal data) 'POST函数
    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) 'GET函数
    With http
        .open "GET", url, False
        .send
        HttpGet = .responseText
    End With
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=" & 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 getSpace(code) '摇奖
    url="http://115.com/?ct=ajax_user&ac=pick_space&token=" & code & "&_=" & Rnd
    Set getSpace = ParseJson(HttpGet(url))
End Function

Function ParseJson(strJson) 'JSON数据解析
    Set htmlfile = CreateObject("htmlfile")
    Set owindow = htmlfile.parentWindow
    owindow.execScript "var json_obj = " & strJson, "JScript"
    Set ParseJson = owindow.json_obj
End Function

Function CmdMode(ByVal title,ByVal color) '命令行模式运行
    If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
        With CreateObject("Wscript.Shell")
            .Run "cmd /c title " & title & "&color " & color & "&Cscript //Nologo """ & WScript.ScriptFullName & """"
            .Run "taskkill /f /im cmd.exe",0
        End With
        WScript.Quit
    End If
End Function

zhangop9

你写的代码我都很喜欢，请给我了个包好不，我的邮箱是：[email]zhangop9@qq.com[/email]