4709634 发表于 2010-8-24 15:14

vb写的军旗刷分器,请高手指点

本帖最后由 4709634 于 2010-8-24 15:15 编辑




源码:
'******************************************托盘程序
Private Type NOTIFYICONDATA
         cbSize As Long
         hwnd As Long
         uID As Long
         uFlags As Long
   
         uCallbackMessage As Long
         hIcon As Long
         szTip As String * 128
         dwState As Long
         dwStateMask As Long
         szInfo As String * 256
         uTimeoutAndVersion As Long
         szInfoTitle As String * 64
         dwInfoFlags As Long
End Type
Const niif_info = &H1
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_INFO = &H10
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONUP = &H205
Private Const WM_MOUSEMOVE      As Long = &H200
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Dim TrayI As NOTIFYICONDATA
'******************************************刷分器函数声明
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 GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId 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 Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) 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 Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const MK_LBUTTON = &H1
Dim biaoti As Integer
Private Sub Form_Load() '窗体的加载
Call 任务栏
Me.Show
SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
Command1.Visible = True
Command2.Visible = False
List1.Visible = False
Text1.Visible = False
Text2.Visible = False
Text3.Visible = False
Text4.Visible = False
End Sub
Private Sub 多开()
Dim dk As Form
biaoti = biaoti + 1
   Set dk = New Form1
dk.Caption = "军旗刷分器" & biaoti
    dk.Show
    dk.Left = 0
    dk.Top = 0
    dk.Command3.Visible = False
   
End Sub
Private Sub 开始()
Timer1.Enabled = True
End Sub

Private Sub 停止() '******************************************强退扣分
If List1.ListCount <> 0 Then
PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 997 + 17 * 65536
PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 997 + 17 * 65536
PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 997 + 17 * 65536
PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 997 + 17 * 65536
Timer1.Enabled = True
List1.Clear
End If
End Sub
Private Sub 完成调度()
If Text2.Text = 0 Then
   
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 30016038 '是否保存复盘
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 30016038
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 39650145 '完成调度
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 39650145
End If

If Text4.Text = 0 Then
   
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 30016038
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 30016038
   
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 39650145
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 39650145
End If

End Sub
Private Sub 走棋()
If Text1.Text > 0 And Text2.Text < 30 And Text2.Text Mod 2 = 0 Then
   
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 40567294
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 40567294
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 37749245
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 37749245
End If

If Text1.Text > 0 And Text2.Text < 30 And Text2.Text Mod 2 = 1 Then
   
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 37749245
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 37749245
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 40567294
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 40567294
End If
If Text3.Text > 0 And Text4.Text < 30 And Text4.Text Mod 2 = 0 Then
   
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 40567294
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 40567294
   
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 37749245
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 37749245
End If
If Text3.Text > 0 And Text4.Text < 30 And Text4.Text Mod 2 = 1 Then
   
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 37749245
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 37749245
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 40567294
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 40567294
End If
If Text1.Text > 0 And Text2.Text >= 30 Then '**********投降
   PostMessage List1.List(0), WM_LBUTTONDOWN, MK_LBUTTON, 43320156
   PostMessage List1.List(0), WM_LBUTTONUP, MK_LBUTTON, 43320156
End If
If Text3.Text > 0 And Text4.Text >= 30 Then '**********投降
   PostMessage List1.List(1), WM_LBUTTONDOWN, MK_LBUTTON, 43320156
   PostMessage List1.List(1), WM_LBUTTONUP, MK_LBUTTON, 43320156
End If

End Sub
Private Sub command1_click()
Call 开始
Command1.Visible = False
Command2.Visible = True
End Sub
Private Sub command2_click()
Call 停止
Command1.Visible = True
Command2.Visible = False
End Sub
Private Sub command3_click()
Call 多开
End Sub

Private Sub Timer1_Timer() '*****************************找游戏窗口
Dim a As Long
a = FindWindow(vbNullString, "四国军棋角色版")
If a <> 0 And List1.ListCount < 2 Then
         MoveWindow a, -1024, -738, 1024, 738, True
         ShowWindow a, 0
         SetWindowText a, "四国军棋角色版九"
         List1.AddItem a
         
End If
If List1.ListCount = 2 Then
Timer1.Enabled = False
End If
End Sub
Private Sub Timer2_Timer() '**********************************屏蔽提示
Dim tc As Long, tz As Long, tq As Long
tc = FindWindow("#32770", "")
tz = FindWindowEx(tc, 0&, "Button", "")
tq = FindWindowEx(tc, tz, "Button", "")
PostMessage tq, WM_LBUTTONDOWN, MK_LBUTTON, 40 + 20 * 65536
PostMessage tq, WM_LBUTTONUP, MK_LBUTTON, 40 + 20 * 65536
SetWindowText tc, "1"
DoEvents
End Sub
Private Sub Timer3_Timer() '*******************************找时间和步数
Dim b1 As Long, c1 As Long, d1 As Long, e1 As Long
If List1.ListCount = 2 Then
GetWindowThreadProcessId List1.List(0), b1
c1 = OpenProcess(PROCESS_ALL_ACCESS, False, b1)
ReadProcessMemory c1, ByVal &H463B18, d1, 4, 0& '找时间
ReadProcessMemory c1, ByVal &H4967D8, e1, 4, 0& '找步数
CloseHandle c1
Text1.Text = d1
Text2.Text = e1
End If
End Sub
Private Sub Timer4_Timer() '******************************找时间和步数
Dim b2 As Long, c2 As Long, d2 As Long, e2 As Long
If List1.ListCount = 2 Then
GetWindowThreadProcessId List1.List(1), b2
c2 = OpenProcess(PROCESS_ALL_ACCESS, False, b2)
ReadProcessMemory c2, ByVal &H463B18, d2, 4, 0& '找时间
ReadProcessMemory c2, ByVal &H4967D8, e2, 4, 0& '找步数
CloseHandle c2
Text3.Text = d2
Text4.Text = e2
End If
End Sub
Private Sub Timer5_Timer() '***************************点完成调度和走棋
If List1.ListCount = 2 Then
Call 完成调度
Call 走棋
End If
End Sub
Private Sub 气泡() '下面是托盘的程序
Dim infotitle
    infotitle = "刷分"
Dim info
    info = "QQ"
    With TrayI
    .cbSize = Len(TrayI)
    .hwnd = Form1.hwnd
    .uID = vbNull
    .uFlags = NIF_INFO
    .dwInfoFlags = niif_info
    .szInfoTitle = infotitle & vbNullChar
    .szInfo = info & vbNullChar
    End With
Shell_NotifyIcon NIM_MODIFY, TrayI

End Sub
Private Sub 任务栏()
Dim Title_trayAs String
Title_tray = "你好"
    With TrayI
    .cbSize = Len(TrayI)
    .hwnd = Me.hwnd
    .uID = vbNull
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    .uCallbackMessage = WM_MOUSEMOVE
    .hIcon = Form1.Icon
    .szTip = Title_tray & vbNullChar
End With
   Call Shell_NotifyIcon(NIM_ADD, TrayI)
    Me.Visible = False

End Sub
   Private Sub Form_MouseMove(Button As Integer, shift As Integer, x As Single, y As Single)
      If Button = 1 Then
   Me.WindowState = vbNormal
      
   Me.Visible = True
    End If
         If Button = 2 Then
         Call 气泡
          End If
   End Sub
   Private Sub Form_Resize()
      If Me.WindowState = vbMinimized Then
      
            Me.Visible = False
            
   
         Call 任务栏
          End If
   End Sub
Private Sub Form_unload(cancel As Integer)
      
         Call 停止
         Call Shell_NotifyIcon(NIM_DELETE, TrayI)
         Unload Me
         
   End Sub

————————————————————————————————————————————————————————————————————————————
   我是菜鸟刚学vb,开刷后不投降,请高手指点,哪段代码有问题??

Rookietp 发表于 2010-8-24 15:23

不懂,这外挂是什么原理。

liuguiping00 发表于 2010-8-24 15:34

看不懂1

4709634 发表于 2010-8-24 15:38

QQ四国军棋玩过吗?就是利用走完30步可以投降,来赢分的

aw550 发表于 2010-8-24 15:45

不明白!!!看不懂,也不会玩!

4709634 发表于 2010-8-24 19:04

没高手来指点下吗??、

evexiaoyun 发表于 2010-8-25 10:24

能做个透视就好了

lzy52163 发表于 2011-4-30 16:04

能用好用不?
页: [1]
查看完整版本: vb写的军旗刷分器,请高手指点