源码：
'******************************************托盘程序
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(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_tray As 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
[复制链接]
发表于 2010-8-24 15:14
发表于 2010-8-24 15:23
|
发表于 2010-8-24 15:38
