QQ农场外挂源码-VB源代码

Option Explicit

'|-------------------------------------------------
'|
'| 程序：QQ农场辅助 [2012/02/04]
'| 制作：E旺 QQ 407542585
'|
'|-------------------------------------------------
Dim http As XMLHttpClass
Dim header_Referer As String
Dim g_myFarmUrl As String, g_FriendUrl As String, g_timerCount As Long

Dim meHeight As Long, meWidth As Long
Dim meList1Height As Long, meList1Width As Long



'| 参数：qqUser    - [in]QQ号码
'|       qqPsw     - [in]QQ密码
'|       DengJi    - [out]等级
'|       JingYan   - [out]经验
'|       JinBi     - [out]金币
'|       FriendUrl - [out/Optional]好友页面的URL
'|
'| 返回：Boolean(True-登录成功, False-登录失败)
'|
Private Function 登录QQ农场(ByVal qqUser As String, ByVal qqPsw As String, ByRef DengJi As String, ByRef JingYan As String, ByRef JinBi As String, Optional ByRef FriendUrl As String = "1") As Boolean
    Dim gUrl As String, Data, retB As Boolean
    Dim pUrl As String, pData As String ', pRef As String
    Dim verUrl As String, verPath As String, verCode As String
    Dim i As Long, Arr, one As String, sName As String, sValue As String
    '显示状态
    showStatus "开始登录账号：" & qqUser, 2
    '重新建立连接
    Set http = Nothing
    Set http = New XMLHttpClass
    retB = False
    '打开登录页
    gUrl = "http://pt.3g.qq.com/s?aid=nLogin"
    Data = http.GetData(gUrl, gUrl, "", "utf-8")
    header_Referer = gUrl
    Data = SubstringExtraction(Data, "<form", "</form>", 1, 1)
    '取得登录地址和组合要提交的数据
    pUrl = SubstringExtraction(Data, "action=""", """", 1, 0)
    'pData = "login_url=http%3A%2F%2Fpt.3g.qq.com%2Fs%3Faid%3DnLogin&q_from=&loginTitle=%E6%89%8B%E6%9C%BA%E8%85%BE%E8%AE%AF%E7%BD%91&bid=0&go_url=http%3A%2F%2Finfo.3g.qq.com&qq=" & qqUser & "&pwd=" & qqPsw & "&loginType=3&loginsubmit=%E7%99%BB%E5%BD%95"
    pData = "login_url=http%3A%2F%2Fpt.3g.qq.com%2Fs%3Faid%3DnLogin&q_from=&loginTitle=%E6%89%8B%E6%9C%BA%E8%85%BE%E8%AE%AF%E7%BD%91&bid=0&go_url=http%3A%2F%2Fnc.z.qq.com%2Ffarm%2Findex.jsp&qq=" & qqUser & "&pwd=" & qqPsw & "&loginType=3&loginsubmit=%E7%99%BB%E5%BD%95"
    '开始登录
    Data = http.PostData(pUrl, pData, header_Referer, "", "utf-8")
    header_Referer = pUrl
    If InStr(Data, ">退出</a>") Then
        '登录成功
        retB = True
    Else
        '登录失败
        If InStr(Data, "输入验证码") Then
            '显示状态
            showStatus "要求输入验证码！"
            '要输验证码
            verUrl = SubstringExtraction(Data, "<img src=""", """", 1, 0)
            verPath = App.Path & "\vCode.gif"
            Call http.DownFile(verUrl, header_Referer, "", verPath)
            '显示验证码
            verCodeForm.Show
            verCodeForm.Picture1.Picture = LoadPicture(verPath)
            verCode = InputBox("请输入窗体中显示的验证码", "输入验证码", "")
            verCodeForm.隐藏窗体