form1.frm

VB编的一个war3防秒退程序 内附使用说明

Debug.Print "目标没有运行"
Exit Sub
End If


'***************
Dim l_addrWrite(0 To 5) As Long                          '写入代码
Dim l_byteCodeWrite() As Byte
Dim l_byteCodeWrite2() As Byte
Dim l_byteCodeWrite3() As Byte
Dim l_byteCodeWrite4() As Byte
Dim l_byteCodeWrite5() As Byte

Dim l_strCodeWrite As String
Dim l_strCodeWrite2 As String
Dim l_strCodeWrite3 As String
Dim l_strCodeWrite4 As String
Dim l_strCodeWrite5 As String



l_addrWrite(1) = &H6F23D20C                   '&
l_addrWrite(2) = &H6F23D60F                   '
l_addrWrite(3) = &H6F23D648                   '
l_addrWrite(4) = &H6F7049FC                   '
l_addrWrite(5) = &H6F1573EC                   '

'*******************共用
'---{{
l_strCodeWrite = "83 F9 12 0F 87 9F 01 00 00 "
ReDim l_byteCodeWrite(0 To Len(l_strCodeWrite) / 3 - 1)

Call ClsMem1.Asc2Dec(l_strCodeWrite, l_byteCodeWrite)                     '11写入代码:修改判断倒计时/LOAding
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(1), l_byteCodeWrite(), 0)
'----'}}


'end************恢复完成
Timer1.Enabled = False

Label1(1).Caption = "Off " & Time
Frame3.Caption = "Off"
Debug.Print "恢复完成"
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Debug.Print "key down:", KeyCode
End Sub

Private Sub Form_Load()
Dim i As Long
Dim MyApp As AppMsg

MyApp.title = "War3防秒退2"                   '程序信息:名称,说明等
MyApp.formname = MyApp.title
MyApp.explain = vbCrLf & Space(4) & "说明：" & vbCrLf & _
Space(9) & "War3 1.20E做主机时防止游戏倒计时被秒退；" & vbCrLf & vbCrLf & _
Space(4) & "使用：" & vbCrLf & _
Space(9) & "运行魔兽争霸,运行工具,选择方式并点""On""；" & vbCrLf & _
Space(9) & "方式1会直接Loading不读秒;方式2会在倒计时" & vbCrLf & _
Space(9) & "为0时暂停War3,这时用[空格键]进入Loading," & vbCrLf & _
Space(9) & "[Esc键]退出；" & vbCrLf & _
Space(9) & "关闭程序前要先点""Off"",否则会War3会挂掉；" & vbCrLf & vbCrLf

                                                      '详细说明
MyApp.explain2 = vbCrLf

                                                      '详细说明

'@@@@@@@@@@@@@@@外观
Dim l_Form1Height As Long
Dim l_Form1Width As Long
l_Form1Height = Form1.Height
l_Form1Width = Form1.Width
For i = 1 To l_Form1Height
Form1.Line (0, i)-(l_Form1Width, i), &HFF00 + i * 10
Next




'@@@@@@@@@@@@@@代码开始
ClsMem1.LookUp (0)                                 '提升权限,0表示自己
App.title = MyApp.title

Form1.Caption = MyApp.formname                      '初试化界面文字
'Label1(1).Caption = "游戏Hack论坛:http://css.a.lunqun.com"
'Label3(1).Caption = "游戏Hack论坛:http://css.a.lunqun.com"
Label3(2).Caption = MyApp.title
Label3(3).Caption = MyApp.explain                  '详细说明


With nfIconData                                    '加入托盘
        .hwnd = Form1.hwnd
        .uID = Form1.Icon
        .uFlags = &H2 Or &H1 Or &H4
        .uCallbackMessage = &H200
        .hIcon = Form1.Icon.Handle
        '定义鼠标移动到托盘上时显示的Tip
        .szTip = MyApp.title & vbNullChar
        .cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(&H0, nfIconData)



'====将写入的代码

'-------------


End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
      Dim lMsg As Single
      lMsg = x / Screen.TwipsPerPixelX
      Select Case lMsg
        Case &H201
          '单击左键，显示窗体
Form1.Show
Call SetForegroundWindow(Me.hwnd)

          Case &H202
'          ShowWindow Me.hWnd, 9
          '' PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
          '' Case WM_MOUSEMOVE
          '' Case WM_LBUTTONDOWN
          '' Case WM_LBUTTONDBLCLK
          '' Case WM_RBUTTONDOWN
          '' Case WM_RBUTTONDBLCLK
          '' Case Else
      End Select
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(&H2, nfIconData)              '去掉托盘

End Sub


Private Sub Form_Resize()                           '最小化隐藏
If Form1.WindowState = 1 Then
    Form1.Visible = False
End If
End Sub


Private Sub Label2_Click(Index As Integer)          '最小化和关闭按钮,说明按钮
Select Case Index
    Case 0
    Form1.WindowState = 1
    Case 1                                          '退出
    Call Shell_NotifyIcon(&H2, nfIconData)              '去掉托盘
    End
    
    Case 3                                          '说明

End Select
End Sub

Private Sub Label2_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
If Index = 2 Then                                   '拖动窗体
ClsMem1.MoveForm Form1.hwnd
End If
End Sub



Private Function ProcF_WriteProcess() As Long       '这个CALL是主要代码：增加代码修改跳转
ProcF_WriteProcess = 0


Dim l_HandleOpen As Long
Dim l_WindowName As String
Dim l_WarPid As Long

l_WindowName = "WarCraft III"
l_WarPid = ClsMem1.GetPidbyWindow(ClsMem1.FindWindowcls(l_WindowName))
Debug.Print "L_warpid", l_WarPid
l_HandleOpen = ClsMem1.OpenHandleByWin(l_WindowName, vbNullString)

If l_HandleOpen = 0 Then
Debug.Print "目标没有运行"
Exit Function
End If


'***************
Dim l_addrWrite(0 To 7) As Long                          '写入代码
Dim l_byteCodeWrite() As Byte
Dim l_byteCodeWrite2() As Byte
Dim l_byteCodeWrite3() As Byte
Dim l_byteCodeWrite4() As Byte
Dim l_byteCodeWrite5() As Byte
Dim l_byteCodeWrite6() As Byte
Dim l_byteCodeWrite7() As Byte

Dim l_strCodeWrite As String
Dim l_strCodeWrite2 As String
Dim l_strCodeWrite3 As String
Dim l_strCodeWrite4 As String
Dim l_strCodeWrite5 As String
Dim l_strCodeWrite6 As String
Dim l_strCodeWrite7 As String



l_addrWrite(1) = &H6F23D20C                   '&
l_addrWrite(2) = &H6F23D60F                   '
l_addrWrite(3) = &H6F23D648                   '
l_addrWrite(4) = &H6F704BB0                   '
l_addrWrite(5) = &H6F704BB0                  '
l_addrWrite(6) = &H6F704BE0                   '&
l_addrWrite(7) = &H6F704BE1                   '&

'*******************共用
'---{{
l_strCodeWrite = "E9 9F 79 4C 00 "
ReDim l_byteCodeWrite(0 To Len(l_strCodeWrite) / 3 - 1)

Call ClsMem1.Asc2Dec(l_strCodeWrite, l_byteCodeWrite)                     '1写入代码:修改判断倒计时/LOAding
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(1), l_byteCodeWrite(), 0)
'----'}}


l_strCodeWrite2 = "EB 29 "
ReDim l_byteCodeWrite2(0 To Len(l_strCodeWrite2) / 3 - 1)
Call ClsMem1.Asc2Dec(l_strCodeWrite2, l_byteCodeWrite2)                     '2和3写入代码:不禁选族和退出
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(2), l_byteCodeWrite2(), 0)


l_strCodeWrite3 = "EB 1A "
ReDim l_byteCodeWrite3(0 To Len(l_strCodeWrite3) / 3 - 1)
Call ClsMem1.Asc2Dec(l_strCodeWrite3, l_byteCodeWrite3)                     '3写入代码:
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(3), l_byteCodeWrite3(), 0)


'********共用End



If Option2(0).Value = True Then               '若方式为直接Loading
l_strCodeWrite4 = "83 F9 00 0F 85 03 00 00 00 6A 03 59 83 F9 12 0F 87 EF 87 B3 FF E9 4B 86 B3 FF "
ReDim l_byteCodeWrite4(0 To Len(l_strCodeWrite4) / 3 - 1)
Call ClsMem1.Asc2Dec(l_strCodeWrite4, l_byteCodeWrite4)                     '4写入代码:
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(4), l_byteCodeWrite4(), 0)


ElseIf Option2(1).Value = True Then           '若方式为暂停倒计时
l_strCodeWrite5 = "83 F9 03 75 18 50 A1 E0 4B 70 6F 83 F8 00 74 0C 83 F8 01 74 02 EB EF 6A 12 59 90 90 58 83 F9 12 0F 87 D6 87 B3 FF E9 3A 86 B3 FF "           '写入的代码
ReDim l_byteCodeWrite5(0 To Len(l_strCodeWrite5) / 3 - 1)
Call ClsMem1.Asc2Dec(l_strCodeWrite5, l_byteCodeWrite5)                     '4写入代码:去掉物品无法取下提示
Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(5), l_byteCodeWrite5(), 0)



Dim l_addrCorrect As Long, l_dataCorrect As Long '标志默认置2，表示倒计时=0时进入等待
l_addrCorrect = &H6F704BE0
l_dataCorrect = &H2
Call ClsMem1.WriteMemL(l_HandleOpen, l_addrCorrect, l_dataCorrect)
End If

'&&&&local var
'Dim l_AddrAlloc As Long
'Dim l_addrCorrect(0 To 2) As Long
'&&&&&&&&&

'l_addrCorrect(1) = &H6F704BB7
'l_addrCorrect(2) = &H6F704BE2

'++++++
'l_AddrAlloc = ClsMem1.VirtualallocMem(l_HandleOpen, 4)
'Debug.Print "virtualalloc结果:", Hex(l_AddrAlloc)
'+++++++++++

'__________
'Call ClsMem1.WriteMemL(l_HandleOpen, l_addrCorrect(1), l_AddrAlloc) '修正地址1,用来保存esi值
'____________

'=========
'l_strCodeWrite6 = "8B 0D 00 00 80 07 E8 B5 89 B3 FF C3"
'ReDim l_byteCodeWrite6(0 To Len(l_strCodeWrite6) / 3 - 1)

'Call ClsMem1.Asc2Dec(l_strCodeWrite6, l_byteCodeWrite6)                     '11写入代码:取得start press时esi的值
'Call ClsMem1.WriteMem(l_HandleOpen, l_addrWrite(6), l_byteCodeWrite6(), 0)
'============

'Call ClsMem1.WriteMemL(l_HandleOpen, l_addrCorrect(2), l_AddrAlloc) '修正地址2,用来获得esi值



'end************
ProcF_WriteProcess = 1
Debug.Print "写入完成"

End Function

Private Sub Timer1_Timer()              'TIMER用getkeystate来获取ESC和SPACE键，控制在等待中的魔兽(此时倒计时=0)下一步是退出还是等待，或loading

Dim l_lngAddrWrite(0 To 6) As Long
Dim l_lngDataWrite(0 To 6) As Long
l_lngAddrWrite(1) = &H6F704BE0         '修改的进入loading地址
l_lngAddrWrite(2) = &H6F704BE0         '恢复地址1
l_lngAddrWrite(3) = &H6F704BE0         '退出倒计时的地址
l_lngAddrWrite(4) = &H6F704BE0         '恢复地址2
l_lngAddrWrite(5) = &H6F704BE0         '等待倒计时的地址
l_lngAddrWrite(6) = &H6F704BE0         '恢复地址3

l_lngDataWrite(1) = &H0                '0为正常进行,1为退出，2为等待
l_lngDataWrite(2) = &H2
l_lngDataWrite(3) = &H1
l_lngDataWrite(4) = &H2
l_lngDataWrite(5) = &H2
l_lngDataWrite(6) = &H2


'%%%%%%%%%%%%%%
If GetKeyState(32) = -127 Or GetKeyState(32) = -128 Then 'space按下则进入loading
Timer1.Enabled = False                 '如果TIMER1不关闭就会重复执行，导致标志数据不正确
Call Procf_WriteLong("Warcraft III", l_lngAddrWrite(1), l_lngDataWrite(1))
ClsMem1.Wait (1000)
Call Procf_WriteLong("Warcraft III", l_lngAddrWrite(2), l_lngDataWrite(2))
Debug.Print "space press " & Time
Timer1.Enabled = True               '如果TIMER1不关闭就会重复执行，导致标志数据不正确


ElseIf GetKeyState(27) = -127 Or GetKeyState(27) = -128 Then 'ESC按下则退出倒计时
Timer1.Enabled = False                 '如果TIMER1不关闭就会重复执行，导致标志数据不正确
Call Procf_WriteLong("Warcraft III", l_lngAddrWrite(3), l_lngDataWrite(3))
ClsMem1.Wait (1000)
Call Procf_WriteLong("Warcraft III", l_lngAddrWrite(4), l_lngDataWrite(4))
Debug.Print "esc press " & Time
Timer1.Enabled = True


End If
'%%%%%%%%%%%%%%%%%%

End Sub



'往n_NameWindow窗口的地址写入long类型
Private Function Procf_WriteLong(ByVal In_NameWindow As String, ByVal In_addrWrite As Long, ByVal In_DataWrite As Long) As Long
Procf_WriteLong = 0

Dim l_HandleOpen As Long
l_HandleOpen = ClsMem1.OpenHandleByWin(In_NameWindow, vbNullString)

If l_HandleOpen = 0 Then
Debug.Print "procf_writelong : 目标没有运行"
Exit Function
End If


Procf_WriteLong = ClsMem1.WriteMemL(l_HandleOpen, In_addrWrite, In_DataWrite)
End Function