Kugoo號碼自動申請

軟件源程序如下:

本程序加上界面即可實現全自動申請。

注釋沒有加。因為主要只涉及幾個api函數。希望用得到的朋友可以用用

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function sendmessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Type POINTAPI           ´定義鼠標位置用
    x As Long
    y As Long
End Type
Const MOUSEEVENTF_LEFTDOWN = &H2 ´模擬鼠標左鍵按下
Const MOUSEEVENTF_LEFTUP = &H4   ´模擬鼠標左鍵抬起
Const WM_SETTEXT = &HC          ´設置文本框的值
Const GW_CHILD = 5              ´查找子控件
Const GW_HWNDNEXT = 2           ´查找下一個子控件
Const BM_CLICK = &HF5           ´發送單擊事件
Private Const WM_CLOSE = &H10
Private ppt As POINTAPI
Private dddd, phnd As Long, tt
Private Const SYNCHRONIZE = &H100000
Const PROCESS_QUERY_INFORMATION = &H400
Private pid, pnd, ppd
Private Sub Command1_Click()
tt = 1
Timer1.Interval = 50
Randomize
a1 = Int((90 - 65 + 1) * Rnd + 65)
a2 = Int((90 - 65 + 1) * Rnd + 65)
a3 = Int((90 - 65 + 1) * Rnd + 65)
a4 = Int((90 - 65 + 1) * Rnd + 65)
a5 = Int((90 - 65 + 1) * Rnd + 65)
a6 = Int((90 - 65 + 1) * Rnd + 65)
Text2.Text = Chr$(a1) + Chr$(a2) + Chr$(a3) + Chr$(a4) + Chr$(a5) + Chr$(a6)
pid = Shell(App.Path + "\kugoo.exe", vbNormalFocus)
´"c:\Program Files\KuGoo\kugoo.exe", vbNormalFocus)
Sleep 1000
End Sub
Private Sub Command2_Click()
Timer1.Interval = 0
End Sub
Private Function MyHotKey(vKeyCode) As Boolean  ´設置熱鍵
    MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function

Private Sub Timer1_Timer()
If MyHotKey(vbKeyF2) Then
    Timer1.Interval = 0                                            ´如果是F2那么停止
    MsgBox "stop!", vbOKOnly, "warning!"
    Exit Sub
End If
aa = FindWindow(vbNullString, "注冊新用戶 - 基本信息")
If aa <> 0 And tt = 2 Then
    SetWindowPos aa, -1, 0, 0, 0, 0, 3
    bb = FindWindowEx(aa, ByVal 0&, "TPageControl", vbNullString)
    cc = FindWindowEx(bb, ByVal 0&, vbNullString, "基本信息")
    cc = FindWindowEx(cc, ByVal 0&, "TEdit", vbNullString)
    ewnd = GetWindow(cc, GW_HWNDNEXT)
    ewnd = GetWindow(ewnd, GW_HWNDNEXT)
    ewnd = GetWindow(ewnd, GW_HWNDNEXT)
    sendmessage ewnd, WM_SETTEXT, 0, ByVal Text1.Text
    cc = FindWindowEx(aa, ByVal 0&, vbNullString, "下一步(&N) >")
    sendmessage cc, BM_CLICK, 0, 0
    Sleep 100
    tt = 3
    Exit Sub
End If
aa = FindWindow(vbNullString, "注冊新用戶 - 個人信息")
If aa <> 0 And tt = 3 Then
    SetWindowPos aa, -1, 0, 0, 0, 0, 3
    cc = FindWindowEx(aa, ByVal 0&, vbNullString, "下一步(&N) >")
    sendmessage cc, BM_CLICK, 0, 0
    Sleep 100
    tt = 4
    Exit Sub
End If
aa = FindWindow(vbNullString, "注冊新用戶 - 安全信息")
If aa <> 0 And tt = 4 Then
    SetWindowPos aa, -1, 0, 0, 0, 0, 3
    bb = FindWindowEx(aa, ByVal 0&, "TPageControl", vbNullString)
    cc = FindWindowEx(bb, ByVal 0&, vbNullString, "安全信息")
    cc = FindWindowEx(cc, ByVal 0&, "TEdit", vbNullString)
    sendmessage cc, WM_SETTEXT, 0, ByVal Text2.Text
    cc = GetWindow(cc, GW_HWNDNEXT)
    sendmessage cc, WM_SETTEXT, 0, ByVal Text2.Text
    cc = GetWindow(cc, GW_HWNDNEXT)
    sendmessage cc, WM_SETTEXT, 0, ByVal Text2.Text
    cc = FindWindowEx(aa, ByVal 0&, vbNullString, "下一步(&N) >")
    sendmessage cc, BM_CLICK, 0, 0
    tt = 5
    Sleep 100
    Exit Sub
End If
aa = FindWindow(vbNullString, "注冊新用戶 - 注冊結果")
If aa <> 0 And tt = 5 Then
    SetWindowPos aa, -1, 0, 0, 0, 0, 3
    bb = FindWindowEx(aa, ByVal 0&, "TPageControl", vbNullString)
    cc = FindWindowEx(bb, ByVal 0&, vbNullString, "注冊結果")
    cc = GetWindow(cc, GW_CHILD)
    cc = GetWindow(cc, GW_CHILD)
    mystr$ = Space$(GetWindowTextLength(cc) + 1)
    GetWindowText cc, mystr$, Len(mystr$)
    number1 = Left$(mystr$, 7)
    If Len(number1) > 4 Then
        Open App.Path + "\kugoo.txt" For Append As #3
        Print #3, CStr(number1) + "----" + Text2.Text
        Close #3
    Else
        Call Command1_Click
    End If
    tt = 6
    Me.Caption = CStr(number1)
    PostMessage aa, WM_CLOSE, 0, 0
    Sleep 100
    Exit Sub
End If
aa = FindWindow(vbNullString, "登陸 Kugoo")
If aa <> 0 And tt = 1 Then
    SetWindowPos aa, -1, 0, 0, 0, 0, 3
    bb = FindWindowEx(aa, ByVal 0&, "TPanel", vbNullString)
    bb = FindWindowEx(bb, ByVal 0&, "TPanel", vbNullString)
    ppt.x = 0: ppt.y = 0
    ClientToScreen bb, ppt
    If ppt.x < 100 Then Exit Sub
    SetCursorPos ppt.x + 100, ppt.y + 20
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    tt = 2
    Sleep 100
    Exit Sub
End If
aa = FindWindow(vbNullString, "KuGoo共享")
If aa <> 0 Then
    PostMessage aa, WM_CLOSE, 0, 0
    Sleep 100
    Exit Sub
End If
aa = FindWindow(vbNullString, "瀏覽文件夾")
If aa <> 0 Then
    PostMessage aa, WM_CLOSE, 0, 0
    Sleep 100
    Exit Sub
End If
aa = FindWindow(vbNullString, "KuGoo")
If aa <> 0 And tt = 6 Then
    PostMessage aa, WM_CLOSE, 0, 0
    Sleep 1000
    Call Command1_Click
    Exit Sub
End If
End Sub

原文轉自：http://www.anti-gravitydesign.com