frmload源码：
Private Sub Form_Load()
INIfilename = App.Path & "\system.ini"
txtPath.Text = GetINI("游戏目录", "地址", App.Path & "\system.ini") '读取system.ini中的游戏路径
labSm.Caption = " 此工具不会修改游戏数据，只是为方便玩家把游戏窗口化。进入游戏前先把游戏分辨率设为： 800*600
nOrgWidth = GetDisplayWidth
nOrgHeight = GetDisplayHeight
wbLoad.Navigate "http://www.wgbcw.cn"
End Sub
Private Sub comRbut_Click()
Unload Me
If txtPath.Text = "" Then
comDlog.ShowOpen
txtPath.Text = comDlog.FileName
INIfilename = App.Path & "\system.ini"
WritePrivateProfileString "游戏目录", "地址", txtPath.Text, INIfilename
ShellExecute 0, "Open", "Launcher.exe", "", "", vbNormalNoFocus
Else
ShellExecute 0, "Open", ExtractFileName(txtPath.Text), "", ExtractDirName(txtPath.Text), vbNormalNoFocus
End If
frmMain.timCkh.Enabled = True
frmMain.timCkh.Interval = 1000
'Me.Visible = False
End Sub
Private Sub comBsm_Click()
ShellExecute Me.hwnd, "open", App.Path & "\使用说明.txt", "", "", SW_SHOWNORMAL
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
frmMain窗体：
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Dim pNewMode As DEVMODE
Dim pOldMode As Long
Dim nOrgWidth As Integer, nOrgHeight As Integer
Dim JB As String
Dim Zjn As Long: Dim Fjna As Long: Dim Fjnb As Long
'system显示器分辨率的执行函数
Private Function SetDisplayMode(Width As Integer, Height As Integer, Color As Integer) As Long ', Freq As Long) As Long
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const DM_BITSPERPEL = &H40000
Const DM_DISPLAYFLAGS = &H200000
Const DM_DISPLAYFREQUENCY = &H400000
With pNewMode
.dmSize = Len(pNewMode)
If Color = 0 Then 'Color = 0 时不更改屏幕颜色
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
Else
.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_DISPLAYFREQUENCY '属性率的更改还是没办法,不过,不加入此DM_DISPLAYFREQUENCY这个参数,只要系统支持,应该不会更改刷新率的
End If
.dmPelsWidth = Width
.dmPelsHeight = Height
If Color <> 0 Then
.dmBitsPerPel = Color
End If
End With
pOldMode = lstrcpy(pNewMode, pNewMode)
SetDisplayMode = ChangeDisplaySettings(pOldMode, 1)
Exit Function
End Function
Private Function GetDisplayWidth() As Integer
GetDisplayWidth = Screen.Width \ Screen.TwipsPerPixelX
End Function
Private Function GetDisplayHeight() As Integer
GetDisplayHeight = Screen.Height \ Screen.TwipsPerPixelY
End Function
Private Sub RestoreDisplayMode()
Call SetDisplayMode(nOrgWidth, nOrgHeight, 0)
End Sub
Private Sub cmdGck_Click()
End
End Sub
Private Sub cmdMin_Click()
frmMain.WindowState = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
RestoreDisplayMode
DestroyWindow GameMainWindow
Call UnhookWindowsHookEx(hHook)
End Sub
Private Sub Form_Load()
cmdGck.Caption = "×"
cmdMin.Caption = "－"
'cmdGck.Caption = "关闭窗口"
cmdJnk.Caption = "开启技能"
cmdSz.Caption = "保存设置"
'将 KeyboardProc 连接到中断上
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0&, App.ThreadID)
'初始化
cbbZ.AddItem "F1键", 0
cbbZ.AddItem "F2键", 1
cbbZ.AddItem "F3键", 2
cbbZ.AddItem "F4键", 3
cbbZ.AddItem "F5键", 4
cbbZ.AddItem "F6键", 5
cbbZ.AddItem "F7键", 6
cbbZ.AddItem "F8键", 7
cbbZ.AddItem "F9键", 8
cbbZ.AddItem "F10键", 9
If cbbZ.Text = "" Then
cbbZ.Text = cbbZ.List(4)
Else
cbbZ.Text = GetINI("按键", "主技能按键", App.Path & "\system.ini")
txtTma.Text = GetINI("时间", "主技能间隔时间", App.Path & "\system.ini")
End If
cbbFa.AddItem "F1键", 0
cbbFa.AddItem "F2键", 1
cbbFa.AddItem "F3键", 2
cbbFa.AddItem "F4键", 3
cbbFa.AddItem "F5键", 4
cbbFa.AddItem "F6键", 5
cbbFa.AddItem "F7键", 6
cbbFa.AddItem "F8键", 7
cbbFa.AddItem "F9键", 8
cbbFa.AddItem "F10键", 9
If cbbFa.Text = "" Then
cbbFa.Text = cbbFa.List(5)
Else
cbbFa.Text = GetINI("按键", "辅技能1按键", App.Path & "\system.ini")
txtTmb.Text = GetINI("时间", "辅技能1间隔时间", App.Path & "\system.ini")
End If
cbbFb.AddItem "F1键", 0
cbbFb.AddItem "F2键", 1
cbbFb.AddItem "F3键", 2
cbbFb.AddItem "F4键", 3
cbbFb.AddItem "F5键", 4
cbbFb.AddItem "F6键", 5
cbbFb.AddItem "F7键", 6
cbbFb.AddItem "F8键", 7
cbbFb.AddItem "F9键", 8
cbbFb.AddItem "F10键", 9
If cbbFb.Text = "" Then
cbbFb.Text = cbbFb.List(6)
Else
cbbFb.Text = GetINI("按键", "辅技能2按键", App.Path & "\system.ini")
txtTmc.Text = GetINI("时间", "辅技能2间隔时间", App.Path & "\system.ini")
End If
End Sub
Private Sub timCkh_Timer()
Dim nWidth As Integer, nHeight As Integer, nColor As Integer
timCkh.Enabled = False
GameMainWindow = FindWindow(vbNullString, "YB_OnlineClient")
ErrWindow = FindWindow(vbNullString, "YBOnline")
If ErrWindow <> 0 Then frmload.Visible = True
If GameMainWindow <> 0 Then
nWidth = 1024: nHeight = 768: nColor = 0
Call SetDisplayMode(nWidth, nHeight, nColor)
SetParent GameMainWindow, Me.hwnd '定义游戏窗口为子窗口，form2窗口为父窗口
ShowWindow GameMainWindow, SW_SHOWNORMAL
UpdateWindow GameMainWindow
Me.Visible = True
Me.Left = -37
Me.Top = -427
Me.Height = 10000
Me.Width = 12000
Else
timCkh.Enabled = True
End If
End Sub
'Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'If cbZjn.Value = 1 And cmdJnk.Caption = "开启技能" Or cbFjna.Value = 1 And cmdJnk.Caption = "开启技能" Or cbFjnb.Value = 1 And cmdJnk.Caption = "开启技能" Then
'If KeyCode = VK_F11 Then
' cmdJnk_Click
' End If
'End If
'If cbZjn.Value = 1 And cmdJnk.Caption = "停止技能" Or cbFjna.Value = 1 And cmdJnk.Caption = "停止技能" Or cbFjnb.Value = 1 And cmdJnk.Caption = "停止技能" Then
'If KeyCode = VK_F12 Then
'cmdJnk_Click
'End If
' End If
' End Sub
Private Sub cmdJnk_Click()
If cbZjn.Value = 1 And cmdJnk.Caption = "开启技能" Or cbFjna.Value = 1 And cmdJnk.Caption = "开启技能" Or cbFjnb.Value = 1 And cmdJnk.Caption = "开启技能" Then
timZjn.Enabled = True
timZjn.Interval = txtTma.Text * 1000
timFjna.Enabled = True
timFjna.Interval = txtTmb.Text * 1000
timFjnb.Enabled = True
timFjnb.Interval = txtTmc.Text * 1000
cmdJnk.Caption = "停止技能"
Else
timZjn.Enabled = False
timFjna.Enabled = False
timFjnb.Enabled = False
cmdJnk.Caption = "开启技能"
cbbZ.Enabled = True
txtTma.Enabled = True
cbbFa.Enabled = True
txtTmb.Enabled = True
cbbFb.Enabled = True
txtTmc.Enabled = True
End If
End Sub
Private Sub cmdSz_Click()
INIfilename = App.Path & "\system.ini"
WritePrivateProfileString "按键", "主技能按键", cbbZ.Text, INIfilename
WritePrivateProfileString "时间", "主技能间隔时间", txtTma.Text, INIfilename
WritePrivateProfileString "按键", "辅技能1按键", cbbFa.Text, INIfilename
WritePrivateProfileString "时间", "辅技能1间隔时间", txtTmb.Text, INIfilename
WritePrivateProfileString "按键", "辅技能2按键", cbbFb.Text, INIfilename
WritePrivateProfileString "时间", "辅技能2间隔时间", txtTmc.Text, INIfilename
End Sub
Private Sub timZjn_Timer()
Select Case cbbZ.Text
Case "F1键"
Zjn = VK_F1
Case "F2键"
Zjn = VK_F2
Case "F3键"
Zjn = VK_F3
Case "F4键"
Zjn = VK_F4
Case "F5键"
Zjn = VK_F5
Case "F6键"
Zjn = VK_F6
Case "F7键"
Zjn = VK_F7
Case "F8键"
Zjn = VK_F8
Case "F9键"
Zjn = VK_F9
Case "F10键"
Zjn = VK_F10
cbbZ.Text = "F5键"
End Select
If cbZjn.Value = 1 Then
cbbZ.Enabled = False
txtTma.Enabled = False
Call keybd_event(Zjn, MapVirtualKey(Zjn, 0), 0, 0)
Call Sleep(300)
Call keybd_event(Zjn, MapVirtualKey(Zjn, 0), KEYEVENTF_KEYUP, 0)
Else
cbbZ.Enabled = True
txtTma.Enabled = True
End If
End Sub
Private Sub timFjna_Timer()
Select Case cbbFa.Text
Case "F1键"
Fjna = VK_F1
Case "F2键"
Fjna = VK_F2
Case "F3键"
Fjna = VK_F3
Case "F4键"
Fjna = VK_F4
Case "F5键"
Fjna = VK_F5
Case "F6键"
Fjna = VK_F6
Case "F7键"
Fjna = VK_F7
Case "F8键"
Fjna = VK_F8
Case "F9键"
Fjna = VK_F9
Case "F10键"
Fjna = VK_F10
cbbFa.Text = "F6键"
End Select
If cbFjna.Value = 1 Then
txtTmb.Enabled = False
cbbFa.Enabled = False
Call keybd_event(Fjna, MapVirtualKey(Fjna, 0), 0, 0)
Call Sleep(300)
Call keybd_event(Fjna, MapVirtualKey(Fjna, 0), KEYEVENTF_KEYUP, 0)
Else
cbbFa.Enabled = True
txtTmb.Enabled = True
End If
End Sub
Private Sub timFjnb_Timer()
Select Case cbbFb.Text
Case "F1键"
Fjnb = VK_F1
Case "F2键"
Fjnb = VK_F2
Case "F3键"
Fjnb = VK_F3
Case "F4键"
Fjnb = VK_F4
Case "F5键"
Fjnb = VK_F5
Case "F6键"
Fjnb = VK_F6
Case "F7键"
Fjnb = VK_F7
Case "F8键"
Fjnb = VK_F8
Case "F9键"
Fjnb = VK_F9
Case "F10键"
Fjnb = VK_F10
cbbFb.Text = "F7键"
End Select
If cbFjnb.Value = 1 Then
cbbFb.Enabled = False
txtTmc.Enabled = False
Call keybd_event(Fjnb, MapVirtualKey(Fjnb, 0), 0, 0)
Call Sleep(300)
Call keybd_event(Fjnb, MapVirtualKey(Fjnb, 0), KEYEVENTF_KEYUP, 0)
Else
cbbFb.Enabled = True
txtTmc.Enabled = True
End If
End Sub
Private Sub UpDown1_DownClick()
If txtTma.Text <= 0 Then
txtTma.Text = Val(txtTma.Text)
Else
txtTma.Text = Val(txtTma.Text - 0.1)
End If
End Sub
Private Sub UpDown1_UpClick()
txtTma.Text = Val(txtTma.Text + 0.1)
If txtTma.Text < 1 Then txtTma.Text = "0" & txtTma.Text
End Sub
Private Sub UpDown2_DownClick()
If txtTmb.Text <= 0 Then
txtTmb.Text = Val(txtTmb.Text)
Else
txtTmb.Text = Val(txtTmb.Text - 0.1)
End If
End Sub
Private Sub UpDown2_UpClick()
txtTmb.Text = Val(txtTmb.Text + 0.1)
If txtTmb.Text < 1 Then txtTmb.Text = "0" & txtTmb.Text
End Sub
Private Sub UpDown3_DownClick()
If txtTmc.Text <= 0 Then
txtTmc.Text = Val(txtTmc.Text)
Else
txtTmc.Text = Val(txtTmc.Text - 0.1)
End If
End Sub
Private Sub UpDown3_UpClick()
txtTmc.Text = Val(txtTmc.Text + 0.1)
If txtTmc.Text < 1 Then txtTmc.Text = "0" & txtTmc.Text
End Sub
Private Sub Form_Initialize()
InitCommonControls
End Sub
modmain源码：
Option Explicit
'-------------------------------------------这三个函数为写入路经、读取路径、和执行游戏程序的函数
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'-----------------------------------------------------------
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public 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
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
Public Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (ByVal lpDevMode As Long, ByVal dwFlags As Long) As Long
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Declare Sub InitCommonControls Lib "comctl32.dll" () 'XP风格样试
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public 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
Public Const WH_KEYBOARD = 2
Public Const KBH_MASK = &H20000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const SPECIFIC_RIGHTS_ALL = &HFFFF
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_VM_OPERATION = &H8&
Public Const PROCESS_VM_READ = &H10&
Public Const PROCESS_VM_WRITE = &H20&
Public Const SW_SHOWNORMAL = 1
Public Const WS_CAPTION = &HC00000
Public Const WS_EX_STATICEDGE = &H20000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const WS_CHILD = &H40000000
Public Const CW_USEDEFAULT = &H80000000
Public Const SW_NORMAL = 1
Public Const VK_F1 = 112
Public Const VK_F2 = 113
Public Const VK_F3 = 114
Public Const VK_F4 = 115
Public Const VK_F5 = 116
Public Const VK_F6 = 117
Public Const VK_F7 = 118
Public Const VK_F8 = 119
Public Const VK_F9 = 120
Public Const VK_F10 = 121
Public Const VK_F11 = 122
Public Const VK_F12 = 123
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public GameMainWindow As Long
Public GameMain1Window As Long
Public GameFormWindow As Long
Public ErrWindow As Long
Global hHook As Long
Public Function GetINI(AppName As String, KeyName As String, INIfilename As String) As String
Dim RetStr As String '定义读取游戏路径的函数
RetStr = String(10000, Chr(0))
GetINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), INIfilename))
End Function
'模组：抓出文件名
Public Function ExtractFileName(PathName As String) As String
Dim X As Integer
For X = Len(PathName) To 1 Step -1
If Mid$(PathName, X, 1) = "" Then Exit For
Next
ExtractFileName = Right$(PathName, Len(PathName) - X)
End Function
'模组：抓出文件目录
Public Function ExtractDirName(PathName As String) As String
Dim X As Integer
For X = Len(PathName) To 1 Step -1
If Mid$(PathName, X, 1) = "" Then Exit For
Next
ExtractDirName = Left$(PathName, X - 1)
End Function
'-------------------------------------------------
'KeyboardProc 在 VB 应用动作前发生
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode >= 0 Then
If frmMain.cmdJnk.Caption = "开启技能" Then
'处理你希望过滤的键
If wParam = 122 <> 0 Then
If (lParam And &HC0000000) = 0 Then
'模拟在Command1 中单击
frmMain.cmdJnk.SetFocus
Call PostMessage(frmMain.cmdJnk.hwnd, WM_LBUTTONDOWN, 0, &H20002)
Call PostMessage(frmMain.cmdJnk.hwnd, WM_LBUTTONUP, 0, &H20002)
KeyboardProc = 1
Exit Function
End If
End If
End If
If frmMain.cmdJnk.Caption = "停止技能" Then
'处理你希望过滤的键
If wParam = 123 <> 0 Then
If (lParam And &HC0000000) = 0 Then
'模拟在Command1 中单击
frmMain.cmdJnk.SetFocus
Call PostMessage(frmMain.cmdJnk.hwnd, WM_LBUTTONDOWN, 0, &H20002)
Call PostMessage(frmMain.cmdJnk.hwnd, WM_LBUTTONUP, 0, &H20002)
KeyboardProc = 1
Exit Function
End If
End If
'------------------------------------
End If
End If
KeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
End Function
感谢萧萧的编程站分享！