上一篇
下一篇
VB外挂和底层操作
作者:admin 日期:2009-11-13
VB编外挂１--取游戏ＩＤ
需要VB API函数：
FindWindow ←寻找窗口列表中第一个符合指定条件的顶级窗口
GetWindowThreadProcessId ←获取与指定窗口关联在一起的一个进程和线程标识符
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
FindWindow
↓
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
GetWindowThreadProcessId
↓
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
As Long
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Label、Timer
-------------------------------------------------------------------------------------------------------------------------------------------------------- 自定义函数：
Dim hwnd As Long
-------------------------------------------------------------------------------------------------------------------------------------------------------- 源代码：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)As Long
Private Sub Timer1_Timer()
Dim hwnd As Long' 储存 FindWindow 函数返回的句柄
hwnd = FindWindow(vbNullString, "Windows Media Player")' 取得进程标识符
'只要把Windows Media Player换成游戏的名称就可了！
If hwnd = 0 Then
Label1.Caption = "游戏未运行"
Else
Label1.Caption = "游戏已运行"
End If
End Sub
VB编外挂２--模拟键盘行动
需要VB API函数：
keybd_event ←函数模拟了键盘行动
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
keybd_event
↓
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Timer（interval不为空）
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub Timer1_Timer()
Call keybd_event(82, 0, 0, 0) '模拟按下"R"键
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------
其它模拟：
方法一：
AppActivate sTitle
SendKeys "5"
方法二：
AppActivate sTitle
SendKeys vbKey5
方法三：
SendMessage Hwnd, WM_KEYDOWN, vbKey5, 0&
SendMessage Hwnd, WM_KEYUP, vbKey5, 0&
方法四：
AppActivate sTitle
keybd_event 53, 0, 0, 0
keybd_event 53, 0, KEYEVENTF_KEYUP, 0
方法五：
PostMessage lHwnd, WM_KEYDOWN, vbKey5, 0&
PostMessage lHwnd, WM_KEYUP, vbKey5, 0&
VB编外挂３－－添加快捷键
需要VB API函数：
GetAsyncKeyState ←判断函数调用时指定虚拟键的状态
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
GetAsyncKeyState
↓
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Function MyHotKey(vKeyCode) As Boolean
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Timer（interval不为空）
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function
'然后在循环中或Timer的Timer事件中检测:
Private Sub Timer1_Timer()
If MyHotKey(vbKeyA) And vbKeyControl Then 'ctrl+A
End '关闭
End If
'其中vbkeyA是键盘″A″的常数，其他键可按F1查得。
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------
其它方法：
比如按下"ctrl+A"就退出!
'可以设置Form的KeyPreview属性为True，然后在Form_KeyDown事件中添加代码：
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = Asc("A") And Shift = vbCtrlMask Then unload me '如果ctrl+A键被按下就退出
End Sub
VB编外挂４---模拟鼠标。
相关API声明：
mouse_event
↓
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 )
--------------------------------------------------------------------------------------------------------------------------------------------------------
定义变量：
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
--------------------------------------------------------------------------------------------------------------------------------------------------------
MOUSEEVENTF_LEFTDOWN'鼠标左键按下
MOUSEEVENTF_LEFTUP'鼠标松开
MOUSEEVENTF_RIGHTDOWN '鼠标右键按下
MOUSEEVENTF_RIGHTUP'鼠标右键松开
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
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 )
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
'这里是 鼠标左键按下 和松开两个事件的组合即一次单击
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标右键单击事件
mouse_event MOUSEEVENTF_RIGHTDOWN or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'两次连续的鼠标左键单击事件 构成一次鼠标双击事件
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
2005-08-02 12:26:42
VB编外挂５--钩子
钩子：喜欢外挂的人都知道，很多外挂都是在游戏当中才能呼出。这个就用到了钩子
N多人说：“哎，VB做钩子想都别想！去学C语言吧！”只要大家遇到这种人，就别理会他。
可以说他是个垃圾。在实现钩子方面VB可能没有VC快，但是也不像那种人说的“想都别想”
C语言，我最近几天看了看。{ } ；这些太多了。脑袋也大了！可能那些学C语言的人是接触电脑
编程的时候就学的它吧！但是呢，我接触电脑学的就是VB。没办法我爱它！
--------------------------------------------------------------------------------------------------------------------------------------------------------
好了下面介绍简单的钩子吧！
--------------------------------------------------------------------------------------------------------------------------------------------------------
SetWindowsHookEx定义如下：
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
idHook是钩子类型，如WH_KEYBOARD捕捉键盘消息，而WH_MOUSE捕捉鼠标消息。
hmod用于全局钩子，VB要实现钩子，必须设为0。
dwThreadId用于线程钩子VB中可以设置为App.ThreadID。
lpfn为钩子函数，在VB中可以使用AddressOf获得钩子函数的地址。
这个函数因为钩子类型不同而有所不同。
--------------------------------------------------------------------------------------------------------------------------------------------------------
如键盘钩子为：
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果Code不为0，钩子函数必须调用CallNextHookEx，将消息传递给下面的钩子。wParam和lParam不是按键。
不用 API ，直接调用关联的程序
不用 API ，直接调用关联的程序
有时候，我们会忘记简单的方法：
' Notepad:
Result = Shell("start.exe notepad", vbHide)
' E-mail:
nResult = Shell("start.exe mailto:kenj@163.net", vbHide)
' Internet:
nResult = Shell("start.exe http://vbtt.yeah.net", vbHide)
' Word
nResult = Shell("start.exe myfile.doc", vbHide)
' Picture Viewer
nResult = Shell("start.exe myfile.jpg", vbHide
VB获取Windows内存的信息
我们经常要访问Windows管理的内存。对应用程序性能影响最大的因素是可用的内存容量，访问系
统内存在处理类似于位图文件之类的大文件时非常有用，因为程序通过交换文件（Swap）的方法，可以
获得比实际可用内存更大的内存。知道内存如何分配后，就可以读入内存值并操作大型数字文件。可以
用丰富的Win32 API函数确定Windows 的全局内存并操作数据文件，这些对于确定程序能否正常工作非
常有用。
dwLength 数据结构的长度
dwMemoryLoad 内存使用百分比
dwTotalPhys 实际内存总字节数
dwAvailPhys 可用的实际内存字节数
dwTotalPageFile 分页文件总字节数
dwAvailPageFile 分页文件可用字节数
dwTotalVirtual 虚拟内存的总字节数
dwAvailVirtual 可用的虚拟内存字节数
加入代码如下的模块：
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
窗体中加入如下代码：
Private Sub Form_Click()
Dim m As MEMORYSTATUS
m.dwLength = Len(m)
GlobalMemoryStatus m
Print "数据结构的长度", m.dwLength
Print "内存使用百分比", m.dwMemoryLoad
Print "实际内存总字节数 ", m.dwTotalPhys
Print "可用的实际内存字节数", m.dwAvailPhys
Print "分页文件总字节数", m.dwTotalPageFile
Print "分页文件可用字节数", m.dwAvailPageFile
Print "虚拟内存的总字节数", m.dwTotalVirtual
Print "可用的虚拟内存字节数", m.dwAvailVirtual
End Sub
VB提升进程权限
提升权限--------------------
'获得进程访问令牌的句柄,
'第一参数是要修改访问权限的进程句柄；
'第三个参数就是返回的访问令牌指针；
'第二个参数指定你要进行的操作类型，如要修改令牌我们要指定第二个参数为TOKEN_ADJUST_PRIVILEGES
'（其它一些参数可参考Platform SDK）。通过这个函数我们就可以得到当前进程的访问令牌的句柄
'（指定函数的第一个参数为GetCurrentProcess()就可以了）
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'访问令牌进行修改
'第一个参数是访问令牌的句柄；第二个参数决定是进行权限修改还是除能（Disable）所有权限；
'第三个参数指明要修改的权限，是一个指向TOKEN_PRIVILEGES结构的指针，该结构包含一个数组，
'数据组的每个项指明了权限的类型和要进行的操作; 第四个参数是结构PreviousState的长度，
'如果PreviousState为空，该参数应为NULL；第五个参数也是一个指向TOKEN_PRIVILEGES结构的指针，
'存放修改前的访问权限的信息，可空；最后一个参数为实际PreviousState结构返回的大小
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
'一个权限对应的LUID值是多少
'第一个参数是系统的名称，如果是本地系统只要指明为NULL就可以了，
'第三个参数就是返回LUID的指针，第二个参数就是指明了权限的名称，如"SeDebugPrivilege"。
'在Winnt.h中还定义了一些权限名称的宏，如：SE_BACKUP_NAME SE_RESTORE_NAME SE_SHUTDOWN_NAME SE_DEBUG_NAME
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Sub 提升进程权限()
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
'LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
LookupPrivilegeValue "", "SeDebugPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
' enable shutdown privilege for the current application
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
在程序中注册和注销 OCX 控件
在程序中注册和注销 OCX 控件
声明（在本例子里使用的是 ComCtl32.OCX，如果是其他，使用相应的名称）：
Declare Function RegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllRegisterServer" () As Long
Declare Function UnRegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllUnregisterServer" () As Long
Const ERROR_SUCCESS = &H0
使用：
If RegComCtl32 = ERROR_SUCCESS Then
MsgBox "Registration Successful"
Else
MsgBox "Registration Unsuccessful"
End If
If UnRegComCtl32 = ERROR_SUCCESS Then
MsgBox "UnRegistration Successful"
Else
MsgBox "UnRegistration Unsuccessful"
End If
VB：对低层硬件访问控制--利用DLL读写端口
一、利用DLL读写端口
若在应用程序中只是简单地读写端口，利用DLL编程实现较为简便。从http://personal.vsnl.com/sr网站可下载一个免费的32位VBIO.DLL，该连接库允许在VB4、5或6中使用，共有七个函数和过程,分别为:
Anjan DLL的解锁过程
Inp 端口读字节函数
Inpw 端口读字函数
Out 端口写字节过程
Outw 端口写字过程
GetLptBaseAddr 获取并口基地址的函数
GetComBaseAddr 获取串口基地址的函数
----图1是一个发声示例程序的窗体，在输入框中键入一频率值并按SoundOn钮，则在PC机的扬声器中发出指定频率音调，程序中对音调的变化、 声音的开关是用VBIO.DLL的过程和函数访问发声系统的定时器/计数器和控制端口实现的。编程要点：1.应在Form _Load中加入Anjan解锁过程。2.若在模块中声明函数和过程，应去掉private或用Public替代。3.VBIO.DLL应拷贝到 windowssystem子目录下。
----程序清单：
Option Explicit
Private Declare Sub Anjan Lib
“vbio.dll" ()
Private Declare Function Inp Lib
“vbio.dll" (ByVal port ＆) As Integer
Private Declare Function Inpw Lib
“vbio.dll" (ByVal port ＆) As Long
Private Declare Sub Out Lib
“vbio.dll" (ByVal port ＆, ByVal byt ％)
Private Declare Sub Outw Lib
“vbio.dll" (ByVal port ＆, ByVal wrd ＆)
Private Declare Function GetLptBaseAddr Lib
“vbio.dll" (ByVal lpt ＆) As Integer
Private Declare Function GetComBaseAddr Lib
“vbio.dll" (ByVal com ＆) As Integer
Public Sub SetFreq(soundHz As Integer) ' 设 置 频 率
If soundHz Then
Dim divisor As Long
divisor = 1193180 / soundHz ' 计 算 时 间 常 数
Out ＆H42, ＆HB6
'8253 －5 通 道2 设 置 为 方 式3
Out ＆H42, divisor Mod 256 ' 送 时 间 常 数
Out ＆H42, divisor 256 '
Speaker True
Else
Speaker False
End If
End Sub
Public Sub Speaker(sOn As Boolean) ' 开 关 声 音
Dim portVal As Integer
portVal = Inp( ＆H61)
If sOn Then
portVal = portVal or 3
' 低 位 为 通 道2 的 门 控 信 号
Else ' 次 低 位 为 整 形 与 门 控 制 信 号
portVal = portVal And (Not 3)
End If
Out ＆H61, portVal
End Sub
Private Sub Form_Load()
Anjan ' 软 件 解 锁
End Sub
Private Sub SoundOff_Click()
Speaker False
End Sub
Private Sub SoundOn_Click()
SetFreq Val(TextHz)
End Sub
VB：对低层硬件访问控制--利用ActiveX处理硬件中断
二、利用ActiveX处理硬件中断
----在应用程序中如果需要访问存储单元、端口以及处理硬件中断，使用TVicHW32 ActiveX控件是一很好的选择，该控件是一个共享软件，支持Windows 95/98/NT，可从http://www.entechtaiwan.com/tools.htm处下载。该控件除具备直接访问存储单元和端口的功能外，还提供了丰富的处理并口的属性和方法，以及处理硬件中断的属性、方法和事件，极大地拓展了VB对低层硬件的访问控制。下面通过一个显示键盘中断次数和按键扫描码的示例介绍控件的使用过程。
下载TVicHW32压缩软件包并解压到一个目录中，如HW。把driver子目录下的vichw00.vxd文件拷贝到windowssystem 子目录下，该文件是控件访问硬件的驱动程序，使用控件前先用OpenDriver打开，最后用Close_Driver方法关闭。
把ocx子目录下的tvichw32.ocx拷贝到windowssystem子目录下，并在DOS命令行状态下键入以下命令进行注册：
----regsvr32 tvichw32.ocx 在VB环境下通过菜单工程－－部件－－控件并选择TVicHW32 ActiveX Control Module将控件添加到工具箱中。
相关的属性、方法及事件
方法 OpenDriver 打开支持访问硬件的驱动程序vichw.vxd（windows95下）
方法 CloseDriver 关闭驱动程序
属性 ActiveHW As Bool 驱动程序打开则为True;关闭为False
中断事件 OnHwInterrupt(ByVal HwCounter As Long, ByVal LPT_DataReg As Integer, ByVal LPT_StatusReg As Integer, ByVal ScanCode As Integer)
参数
HwCounter :中断次数
LPT_DataReg :如果使用IRQ7，则为打印并口的数据
LPT_StatusReg :如果使用IRQ7，则为打印并口的数据
ScanKode :如果使用IRQ1，则为按键的扫描码
属性 IRQNumber指定中断号，范围IRQ1－－15
属性 IRQMasked中断非屏蔽则为True；屏蔽为False。
----图2是示例的窗体，程序运行后首先按Open_Driver钮打开驱动程序，然后选择Unmarsk复选框开放中断，此时每按一次键框中分别显示该键的扫描码和中断次数。处理其他中断只需更改中断号即可（中断号1 -15）。
----程序清单：
Public Sub ShowButtons()
Open_Driver.Enabled = Not HwCtrl.ActiveHW
Close_Driver.Enabled = HwCtrl.ActiveHW
B_Unmask.Enabled = HwCtrl.ActiveHWEnd Sub
Private Sub Form_Load()ShowButtonsEnd Sub
Private Sub Open_Driver_Click()
HwCtrl.OpenDriver '打开驱动程序
If Not HwCtrl.ActiveHW Then
MsgBox ("The driver VICHWxx not found")
Else:
HwCtrl.IRQNumber = 1 '中断号为1,键盘中断
End If
ShowButtonsEnd Sub
Private Sub Close_Driver_Click()
HwCtrl.CloseDriver '关闭驱动程序
B_Unmask.Value = 0
ShowButtonsEnd Sub
Private Sub B_Unmask_Click()
If B_Unmask.Value = 0 Then
HwCtrl.IRQMasked = True
Else
HwCtrl.IRQNumber = 1
Scan_Code = 0
HwCtrl.IRQMasked = False '开放中断
End IfEnd Sub
Private Sub HwCtrl_OnHwInterrupt(ByVal HwCounter As Long, ByVal LPT_DataReg As Integer, ByVal LPT_StatusReg As Integer, ByVal ScanCode As Integer)
Scan_Code.Caption = ScanCode
IRQC.Caption = HwCounterEnd Sub
用VB轻松调用其他程序
我们编写程序时，有时会遇到在一个程序中调用并控制另一个程序执行的情况，在一些编程语言中实现起来较为繁琐，但如果用VB编写时，则可轻松实现。下面我就以在程序中调用“计算器”为例，总结了以下几种方法：
一、以异步方式来执行其他程序
Shell 函数是以异步方式来调用其他程序的。也就是说，用Shell启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。
语法：Shell(pathname[,windowstyle])
说明：pathname：必要参数。Variant (String)，要执行的程序名，以及任何必需的参数或命令行变量，可能还包括目录或文件夹，以及驱动器。
例如：RetVal = Shell(″C:\WINDOWS\CALC.EXE″, 1) ′ 调用计算器。
二、以同步方式来执行其他程序
有时候，我们需要让VB在执行完外部程序后再执行下一语句，这就需要使用API函数。
我们可通过OpenProcess和CloseHandle函数来检测调用软件的运行情况。这两个函数的声明如下：
Declare Function OpenProcess Lib ″kernel32″ Alias ″OpenProcess″ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib ″kernel32″ Alias ″CloseHandle″ (ByVal hObject As Long) As Long
建立下面函数，用以判断程序是否在运行，如果是，则在运行时返回True。
Function IsRunning(ByVal ProgramID) As Boolean ′传入进程标识ID
Dim hProgram As Long ′被检测的程序进程句柄
hProgram=OpenProcess(0,False,ProgramID)
If Not hProgram=0 Then
IsRunning=True
Else
IsRunning=False
End If
CloseHandle hProgram
End Function
例如要调用计算器(CALC.EXE)并等到它运行完成后再执行下一语句，可以使用以下代码：
Dim RetVal
MsgBox ″开始运行″
RetVal = Shell(″C:\WINDOWS\CALC.EXE″, 1)
While IsRunning(RetVal)
DoEvents
Wend
MsgBox ″结束运行″
三、关闭正在运行中的其他软件
如果要在程序中关闭正在运行中的其他程序，可以先使用FindWindow函数找出相应的程序句柄，然后调用PostMessage函数关闭该程序即可。
这两个函数的声明如下：
Declare Function FindWindow Lib ″user32″ Alias ″FindWindowA″ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
例如要检测“计算器”程序是否正在运行，如果是则关闭它，可以使用如下代码来实现：
Dim winHwnd As Long
Dim RetVal As Long
winHwnd=FindWindow(vbNullString,″计算器″)
If winHwnd〈〉0 Then
RetVal=PostMessage(winHwnd,＆H10,0＆,0＆)
If RetVal=0 Then
MsgBox ″关闭计算器出错！″
End If
Else
MsgBox ″计算器程序没有运行。″
End If
捕捉 MouseExit 事件(源程序)
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么！对！还差 MouseExit（鼠标移出）事件。在 VB 中，我们要捕捉 MouseExit 事件，必须用 API 函数：
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
然后，我们可以在控件（以 Picture1 为例）的 MouseMove 事件上加上以下代码：
With Picture1 'Change this to the name of the control
If Button = 0 Then
If (X < 0) or (Y < 0) or (X > .Width) or (Y > .Height) Then
'Mouse pointer is outside button, so let other controls receive
'mouseevents too:
ReleaseCapture
' 放入鼠标离开的代码
Else
' Mouse pointer is over button, so we'll capture it, thus
' we'll receive mouse messages even if the mouse pointer is
' not over the button
SetCapture .hwnd
' 放入鼠标进入的代码
End If
内容
发帖数量:41
显示动画鼠标图标
显示动画鼠标图标
Win95 的动画鼠标为应用程序增色不少，而 VB 则只提供一般的鼠标图标支持。要用VB
显示动画鼠标形状，你可以使用以下方法：
函数声明：
Public Const GCL_HCURSOR = -12
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Any) As Long
Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (_
ByVal lpFileName As String) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long) As Long
使用：
Dim mhBaseCursor As Long, mhAniCursor As Long
Dim lResult As Long
mhAniCursor = LoadCursorFromFile("c:\windows\cursors\appstart.ani")
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhAniCursor)
怎样限制鼠标移动
本文介绍如何限制鼠标在窗口的指定范围内移动。这个技术在需要防止用户鼠标在指定区域内活动时非常
有用。例如在一个射击游戏中，需要限制鼠标在射击区内移动。
操作步骤
1、建立一个新工程项目，缺省建立窗体FORM1
2、添加一个新模体
3、粘贴下面代码到新模体
Option ExplicitDeclare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
X As Long
Y As Long
End Type
Public RetValue As Long
Public ClipMode As Boolean
Public Sub SetCursor(ClipObject As Object, Setting As Boolean)
' used to clip the cursor into the viewport and
' turn off the default windows cursor
Dim CurrentPoint As POINTAPI
Dim ClipRect As RECT
If Setting = False Then
' set clip state back to normal
RetValue = ClipCursorClear(0)
Exit Sub
End If
' set current position
With CurrentPoint
.X = 0
.Y = 0
End With
' find position on the screen (not the window)
RetValue = ClientToScreen(ClipObject.hwnd, CurrentPoint)
' designate clip area
With ClipRect
.Top = CurrentPoint.Y
.Left = CurrentPoint.X
.Right = .Left + ClipObject.ScaleWidth
.Bottom = .Top + ClipObject.ScaleHeight
End With ' clip it
RetValue = ClipCursor(ClipRect)
End Sub
4、添加一个图片框控件（PICTURE1）到窗体（FORM1）
5、设置PICTURE1的尺寸和FORM1的一样大
6、在PICTURE1的CLICK事件中添加以下代码：
Private Sub Picture1_Click()
ClipMode = Not ClipMode
SetCursor Picture1, ClipMode
End Sub
7、保存工程项目
8、运行程序。在图片框单击鼠标，鼠标将被包含在图片框控件的区域内。要释放限制状态只需再次单击鼠标。
注意：如果释放限制状态失败，鼠标将被永久限制，只能用重新启动机器来解决。
另一个限制鼠标活动范围的方法是关闭鼠标，用其他图象代替光标，例如手枪。
需要VB API函数：
FindWindow ←寻找窗口列表中第一个符合指定条件的顶级窗口
GetWindowThreadProcessId ←获取与指定窗口关联在一起的一个进程和线程标识符
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
FindWindow
↓
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
GetWindowThreadProcessId
↓
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
As Long
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Label、Timer
-------------------------------------------------------------------------------------------------------------------------------------------------------- 自定义函数：
Dim hwnd As Long
-------------------------------------------------------------------------------------------------------------------------------------------------------- 源代码：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)As Long
Private Sub Timer1_Timer()
Dim hwnd As Long' 储存 FindWindow 函数返回的句柄
hwnd = FindWindow(vbNullString, "Windows Media Player")' 取得进程标识符
'只要把Windows Media Player换成游戏的名称就可了！
If hwnd = 0 Then
Label1.Caption = "游戏未运行"
Else
Label1.Caption = "游戏已运行"
End If
End Sub
VB编外挂２--模拟键盘行动
需要VB API函数：
keybd_event ←函数模拟了键盘行动
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
keybd_event
↓
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Timer（interval不为空）
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal Scan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub Timer1_Timer()
Call keybd_event(82, 0, 0, 0) '模拟按下"R"键
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------
其它模拟：
方法一：
AppActivate sTitle
SendKeys "5"
方法二：
AppActivate sTitle
SendKeys vbKey5
方法三：
SendMessage Hwnd, WM_KEYDOWN, vbKey5, 0&
SendMessage Hwnd, WM_KEYUP, vbKey5, 0&
方法四：
AppActivate sTitle
keybd_event 53, 0, 0, 0
keybd_event 53, 0, KEYEVENTF_KEYUP, 0
方法五：
PostMessage lHwnd, WM_KEYDOWN, vbKey5, 0&
PostMessage lHwnd, WM_KEYUP, vbKey5, 0&
VB编外挂３－－添加快捷键
需要VB API函数：
GetAsyncKeyState ←判断函数调用时指定虚拟键的状态
--------------------------------------------------------------------------------------------------------------------------------------------------------
相关API声明：
GetAsyncKeyState
↓
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Function MyHotKey(vKeyCode) As Boolean
--------------------------------------------------------------------------------------------------------------------------------------------------------
需要的控件：Timer（interval不为空）
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function
'然后在循环中或Timer的Timer事件中检测:
Private Sub Timer1_Timer()
If MyHotKey(vbKeyA) And vbKeyControl Then 'ctrl+A
End '关闭
End If
'其中vbkeyA是键盘″A″的常数，其他键可按F1查得。
End Sub
--------------------------------------------------------------------------------------------------------------------------------------------------------
其它方法：
比如按下"ctrl+A"就退出!
'可以设置Form的KeyPreview属性为True，然后在Form_KeyDown事件中添加代码：
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = Asc("A") And Shift = vbCtrlMask Then unload me '如果ctrl+A键被按下就退出
End Sub
VB编外挂４---模拟鼠标。
相关API声明：
mouse_event
↓
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 )
--------------------------------------------------------------------------------------------------------------------------------------------------------
定义变量：
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
--------------------------------------------------------------------------------------------------------------------------------------------------------
MOUSEEVENTF_LEFTDOWN'鼠标左键按下
MOUSEEVENTF_LEFTUP'鼠标松开
MOUSEEVENTF_RIGHTDOWN '鼠标右键按下
MOUSEEVENTF_RIGHTUP'鼠标右键松开
--------------------------------------------------------------------------------------------------------------------------------------------------------
代码：
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 )
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
'这里是 鼠标左键按下 和松开两个事件的组合即一次单击
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
'模拟鼠标右键单击事件
mouse_event MOUSEEVENTF_RIGHTDOWN or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
'两次连续的鼠标左键单击事件 构成一次鼠标双击事件
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
2005-08-02 12:26:42
VB编外挂５--钩子
钩子：喜欢外挂的人都知道，很多外挂都是在游戏当中才能呼出。这个就用到了钩子
N多人说：“哎，VB做钩子想都别想！去学C语言吧！”只要大家遇到这种人，就别理会他。
可以说他是个垃圾。在实现钩子方面VB可能没有VC快，但是也不像那种人说的“想都别想”
C语言，我最近几天看了看。{ } ；这些太多了。脑袋也大了！可能那些学C语言的人是接触电脑
编程的时候就学的它吧！但是呢，我接触电脑学的就是VB。没办法我爱它！
--------------------------------------------------------------------------------------------------------------------------------------------------------
好了下面介绍简单的钩子吧！
--------------------------------------------------------------------------------------------------------------------------------------------------------
SetWindowsHookEx定义如下：
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
idHook是钩子类型，如WH_KEYBOARD捕捉键盘消息，而WH_MOUSE捕捉鼠标消息。
hmod用于全局钩子，VB要实现钩子，必须设为0。
dwThreadId用于线程钩子VB中可以设置为App.ThreadID。
lpfn为钩子函数，在VB中可以使用AddressOf获得钩子函数的地址。
这个函数因为钩子类型不同而有所不同。
--------------------------------------------------------------------------------------------------------------------------------------------------------
如键盘钩子为：
Public Function KeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果Code不为0，钩子函数必须调用CallNextHookEx，将消息传递给下面的钩子。wParam和lParam不是按键。
不用 API ，直接调用关联的程序
不用 API ，直接调用关联的程序
有时候，我们会忘记简单的方法：
' Notepad:
Result = Shell("start.exe notepad", vbHide)
' E-mail:
nResult = Shell("start.exe mailto:kenj@163.net", vbHide)
' Internet:
nResult = Shell("start.exe http://vbtt.yeah.net", vbHide)
' Word
nResult = Shell("start.exe myfile.doc", vbHide)
' Picture Viewer
nResult = Shell("start.exe myfile.jpg", vbHide
VB获取Windows内存的信息
我们经常要访问Windows管理的内存。对应用程序性能影响最大的因素是可用的内存容量，访问系
统内存在处理类似于位图文件之类的大文件时非常有用，因为程序通过交换文件（Swap）的方法，可以
获得比实际可用内存更大的内存。知道内存如何分配后，就可以读入内存值并操作大型数字文件。可以
用丰富的Win32 API函数确定Windows 的全局内存并操作数据文件，这些对于确定程序能否正常工作非
常有用。
dwLength 数据结构的长度
dwMemoryLoad 内存使用百分比
dwTotalPhys 实际内存总字节数
dwAvailPhys 可用的实际内存字节数
dwTotalPageFile 分页文件总字节数
dwAvailPageFile 分页文件可用字节数
dwTotalVirtual 虚拟内存的总字节数
dwAvailVirtual 可用的虚拟内存字节数
加入代码如下的模块：
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
窗体中加入如下代码：
Private Sub Form_Click()
Dim m As MEMORYSTATUS
m.dwLength = Len(m)
GlobalMemoryStatus m
Print "数据结构的长度", m.dwLength
Print "内存使用百分比", m.dwMemoryLoad
Print "实际内存总字节数 ", m.dwTotalPhys
Print "可用的实际内存字节数", m.dwAvailPhys
Print "分页文件总字节数", m.dwTotalPageFile
Print "分页文件可用字节数", m.dwAvailPageFile
Print "虚拟内存的总字节数", m.dwTotalVirtual
Print "可用的虚拟内存字节数", m.dwAvailVirtual
End Sub
VB提升进程权限
提升权限--------------------
'获得进程访问令牌的句柄,
'第一参数是要修改访问权限的进程句柄；
'第三个参数就是返回的访问令牌指针；
'第二个参数指定你要进行的操作类型，如要修改令牌我们要指定第二个参数为TOKEN_ADJUST_PRIVILEGES
'（其它一些参数可参考Platform SDK）。通过这个函数我们就可以得到当前进程的访问令牌的句柄
'（指定函数的第一个参数为GetCurrentProcess()就可以了）
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'访问令牌进行修改
'第一个参数是访问令牌的句柄；第二个参数决定是进行权限修改还是除能（Disable）所有权限；
'第三个参数指明要修改的权限，是一个指向TOKEN_PRIVILEGES结构的指针，该结构包含一个数组，
'数据组的每个项指明了权限的类型和要进行的操作; 第四个参数是结构PreviousState的长度，
'如果PreviousState为空，该参数应为NULL；第五个参数也是一个指向TOKEN_PRIVILEGES结构的指针，
'存放修改前的访问权限的信息，可空；最后一个参数为实际PreviousState结构返回的大小
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
'一个权限对应的LUID值是多少
'第一个参数是系统的名称，如果是本地系统只要指明为NULL就可以了，
'第三个参数就是返回LUID的指针，第二个参数就是指明了权限的名称，如"SeDebugPrivilege"。
'在Winnt.h中还定义了一些权限名称的宏，如：SE_BACKUP_NAME SE_RESTORE_NAME SE_SHUTDOWN_NAME SE_DEBUG_NAME
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Sub 提升进程权限()
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
'LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
LookupPrivilegeValue "", "SeDebugPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
' enable shutdown privilege for the current application
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
在程序中注册和注销 OCX 控件
在程序中注册和注销 OCX 控件
声明（在本例子里使用的是 ComCtl32.OCX，如果是其他，使用相应的名称）：
Declare Function RegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllRegisterServer" () As Long
Declare Function UnRegComCtl32 Lib "ComCtl32.OCX" _
Alias "DllUnregisterServer" () As Long
Const ERROR_SUCCESS = &H0
使用：
If RegComCtl32 = ERROR_SUCCESS Then
MsgBox "Registration Successful"
Else
MsgBox "Registration Unsuccessful"
End If
If UnRegComCtl32 = ERROR_SUCCESS Then
MsgBox "UnRegistration Successful"
Else
MsgBox "UnRegistration Unsuccessful"
End If
VB：对低层硬件访问控制--利用DLL读写端口
一、利用DLL读写端口
若在应用程序中只是简单地读写端口，利用DLL编程实现较为简便。从http://personal.vsnl.com/sr网站可下载一个免费的32位VBIO.DLL，该连接库允许在VB4、5或6中使用，共有七个函数和过程,分别为:
Anjan DLL的解锁过程
Inp 端口读字节函数
Inpw 端口读字函数
Out 端口写字节过程
Outw 端口写字过程
GetLptBaseAddr 获取并口基地址的函数
GetComBaseAddr 获取串口基地址的函数
----图1是一个发声示例程序的窗体，在输入框中键入一频率值并按SoundOn钮，则在PC机的扬声器中发出指定频率音调，程序中对音调的变化、 声音的开关是用VBIO.DLL的过程和函数访问发声系统的定时器/计数器和控制端口实现的。编程要点：1.应在Form _Load中加入Anjan解锁过程。2.若在模块中声明函数和过程，应去掉private或用Public替代。3.VBIO.DLL应拷贝到 windowssystem子目录下。
----程序清单：
Option Explicit
Private Declare Sub Anjan Lib
“vbio.dll" ()
Private Declare Function Inp Lib
“vbio.dll" (ByVal port ＆) As Integer
Private Declare Function Inpw Lib
“vbio.dll" (ByVal port ＆) As Long
Private Declare Sub Out Lib
“vbio.dll" (ByVal port ＆, ByVal byt ％)
Private Declare Sub Outw Lib
“vbio.dll" (ByVal port ＆, ByVal wrd ＆)
Private Declare Function GetLptBaseAddr Lib
“vbio.dll" (ByVal lpt ＆) As Integer
Private Declare Function GetComBaseAddr Lib
“vbio.dll" (ByVal com ＆) As Integer
Public Sub SetFreq(soundHz As Integer) ' 设 置 频 率
If soundHz Then
Dim divisor As Long
divisor = 1193180 / soundHz ' 计 算 时 间 常 数
Out ＆H42, ＆HB6
'8253 －5 通 道2 设 置 为 方 式3
Out ＆H42, divisor Mod 256 ' 送 时 间 常 数
Out ＆H42, divisor 256 '
Speaker True
Else
Speaker False
End If
End Sub
Public Sub Speaker(sOn As Boolean) ' 开 关 声 音
Dim portVal As Integer
portVal = Inp( ＆H61)
If sOn Then
portVal = portVal or 3
' 低 位 为 通 道2 的 门 控 信 号
Else ' 次 低 位 为 整 形 与 门 控 制 信 号
portVal = portVal And (Not 3)
End If
Out ＆H61, portVal
End Sub
Private Sub Form_Load()
Anjan ' 软 件 解 锁
End Sub
Private Sub SoundOff_Click()
Speaker False
End Sub
Private Sub SoundOn_Click()
SetFreq Val(TextHz)
End Sub
VB：对低层硬件访问控制--利用ActiveX处理硬件中断
二、利用ActiveX处理硬件中断
----在应用程序中如果需要访问存储单元、端口以及处理硬件中断，使用TVicHW32 ActiveX控件是一很好的选择，该控件是一个共享软件，支持Windows 95/98/NT，可从http://www.entechtaiwan.com/tools.htm处下载。该控件除具备直接访问存储单元和端口的功能外，还提供了丰富的处理并口的属性和方法，以及处理硬件中断的属性、方法和事件，极大地拓展了VB对低层硬件的访问控制。下面通过一个显示键盘中断次数和按键扫描码的示例介绍控件的使用过程。
下载TVicHW32压缩软件包并解压到一个目录中，如HW。把driver子目录下的vichw00.vxd文件拷贝到windowssystem 子目录下，该文件是控件访问硬件的驱动程序，使用控件前先用OpenDriver打开，最后用Close_Driver方法关闭。
把ocx子目录下的tvichw32.ocx拷贝到windowssystem子目录下，并在DOS命令行状态下键入以下命令进行注册：
----regsvr32 tvichw32.ocx 在VB环境下通过菜单工程－－部件－－控件并选择TVicHW32 ActiveX Control Module将控件添加到工具箱中。
相关的属性、方法及事件
方法 OpenDriver 打开支持访问硬件的驱动程序vichw.vxd（windows95下）
方法 CloseDriver 关闭驱动程序
属性 ActiveHW As Bool 驱动程序打开则为True;关闭为False
中断事件 OnHwInterrupt(ByVal HwCounter As Long, ByVal LPT_DataReg As Integer, ByVal LPT_StatusReg As Integer, ByVal ScanCode As Integer)
参数
HwCounter :中断次数
LPT_DataReg :如果使用IRQ7，则为打印并口的数据
LPT_StatusReg :如果使用IRQ7，则为打印并口的数据
ScanKode :如果使用IRQ1，则为按键的扫描码
属性 IRQNumber指定中断号，范围IRQ1－－15
属性 IRQMasked中断非屏蔽则为True；屏蔽为False。
----图2是示例的窗体，程序运行后首先按Open_Driver钮打开驱动程序，然后选择Unmarsk复选框开放中断，此时每按一次键框中分别显示该键的扫描码和中断次数。处理其他中断只需更改中断号即可（中断号1 -15）。
----程序清单：
Public Sub ShowButtons()
Open_Driver.Enabled = Not HwCtrl.ActiveHW
Close_Driver.Enabled = HwCtrl.ActiveHW
B_Unmask.Enabled = HwCtrl.ActiveHWEnd Sub
Private Sub Form_Load()ShowButtonsEnd Sub
Private Sub Open_Driver_Click()
HwCtrl.OpenDriver '打开驱动程序
If Not HwCtrl.ActiveHW Then
MsgBox ("The driver VICHWxx not found")
Else:
HwCtrl.IRQNumber = 1 '中断号为1,键盘中断
End If
ShowButtonsEnd Sub
Private Sub Close_Driver_Click()
HwCtrl.CloseDriver '关闭驱动程序
B_Unmask.Value = 0
ShowButtonsEnd Sub
Private Sub B_Unmask_Click()
If B_Unmask.Value = 0 Then
HwCtrl.IRQMasked = True
Else
HwCtrl.IRQNumber = 1
Scan_Code = 0
HwCtrl.IRQMasked = False '开放中断
End IfEnd Sub
Private Sub HwCtrl_OnHwInterrupt(ByVal HwCounter As Long, ByVal LPT_DataReg As Integer, ByVal LPT_StatusReg As Integer, ByVal ScanCode As Integer)
Scan_Code.Caption = ScanCode
IRQC.Caption = HwCounterEnd Sub
用VB轻松调用其他程序
我们编写程序时，有时会遇到在一个程序中调用并控制另一个程序执行的情况，在一些编程语言中实现起来较为繁琐，但如果用VB编写时，则可轻松实现。下面我就以在程序中调用“计算器”为例，总结了以下几种方法：
一、以异步方式来执行其他程序
Shell 函数是以异步方式来调用其他程序的。也就是说，用Shell启动的程序可能还没有完成执行过程，就已经执行到 Shell 函数之后的语句。
语法：Shell(pathname[,windowstyle])
说明：pathname：必要参数。Variant (String)，要执行的程序名，以及任何必需的参数或命令行变量，可能还包括目录或文件夹，以及驱动器。
例如：RetVal = Shell(″C:\WINDOWS\CALC.EXE″, 1) ′ 调用计算器。
二、以同步方式来执行其他程序
有时候，我们需要让VB在执行完外部程序后再执行下一语句，这就需要使用API函数。
我们可通过OpenProcess和CloseHandle函数来检测调用软件的运行情况。这两个函数的声明如下：
Declare Function OpenProcess Lib ″kernel32″ Alias ″OpenProcess″ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib ″kernel32″ Alias ″CloseHandle″ (ByVal hObject As Long) As Long
建立下面函数，用以判断程序是否在运行，如果是，则在运行时返回True。
Function IsRunning(ByVal ProgramID) As Boolean ′传入进程标识ID
Dim hProgram As Long ′被检测的程序进程句柄
hProgram=OpenProcess(0,False,ProgramID)
If Not hProgram=0 Then
IsRunning=True
Else
IsRunning=False
End If
CloseHandle hProgram
End Function
例如要调用计算器(CALC.EXE)并等到它运行完成后再执行下一语句，可以使用以下代码：
Dim RetVal
MsgBox ″开始运行″
RetVal = Shell(″C:\WINDOWS\CALC.EXE″, 1)
While IsRunning(RetVal)
DoEvents
Wend
MsgBox ″结束运行″
三、关闭正在运行中的其他软件
如果要在程序中关闭正在运行中的其他程序，可以先使用FindWindow函数找出相应的程序句柄，然后调用PostMessage函数关闭该程序即可。
这两个函数的声明如下：
Declare Function FindWindow Lib ″user32″ Alias ″FindWindowA″ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
例如要检测“计算器”程序是否正在运行，如果是则关闭它，可以使用如下代码来实现：
Dim winHwnd As Long
Dim RetVal As Long
winHwnd=FindWindow(vbNullString,″计算器″)
If winHwnd〈〉0 Then
RetVal=PostMessage(winHwnd,＆H10,0＆,0＆)
If RetVal=0 Then
MsgBox ″关闭计算器出错！″
End If
Else
MsgBox ″计算器程序没有运行。″
End If
捕捉 MouseExit 事件(源程序)
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么！对！还差 MouseExit（鼠标移出）事件。在 VB 中，我们要捕捉 MouseExit 事件，必须用 API 函数：
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
然后，我们可以在控件（以 Picture1 为例）的 MouseMove 事件上加上以下代码：
With Picture1 'Change this to the name of the control
If Button = 0 Then
If (X < 0) or (Y < 0) or (X > .Width) or (Y > .Height) Then
'Mouse pointer is outside button, so let other controls receive
'mouseevents too:
ReleaseCapture
' 放入鼠标离开的代码
Else
' Mouse pointer is over button, so we'll capture it, thus
' we'll receive mouse messages even if the mouse pointer is
' not over the button
SetCapture .hwnd
' 放入鼠标进入的代码
End If
内容
发帖数量:41
显示动画鼠标图标
显示动画鼠标图标
Win95 的动画鼠标为应用程序增色不少，而 VB 则只提供一般的鼠标图标支持。要用VB
显示动画鼠标形状，你可以使用以下方法：
函数声明：
Public Const GCL_HCURSOR = -12
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Any) As Long
Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (_
ByVal lpFileName As String) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd _
As Long, ByVal nIndex As Long) As Long
使用：
Dim mhBaseCursor As Long, mhAniCursor As Long
Dim lResult As Long
mhAniCursor = LoadCursorFromFile("c:\windows\cursors\appstart.ani")
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhAniCursor)
怎样限制鼠标移动
本文介绍如何限制鼠标在窗口的指定范围内移动。这个技术在需要防止用户鼠标在指定区域内活动时非常
有用。例如在一个射击游戏中，需要限制鼠标在射击区内移动。
操作步骤
1、建立一个新工程项目，缺省建立窗体FORM1
2、添加一个新模体
3、粘贴下面代码到新模体
Option ExplicitDeclare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
X As Long
Y As Long
End Type
Public RetValue As Long
Public ClipMode As Boolean
Public Sub SetCursor(ClipObject As Object, Setting As Boolean)
' used to clip the cursor into the viewport and
' turn off the default windows cursor
Dim CurrentPoint As POINTAPI
Dim ClipRect As RECT
If Setting = False Then
' set clip state back to normal
RetValue = ClipCursorClear(0)
Exit Sub
End If
' set current position
With CurrentPoint
.X = 0
.Y = 0
End With
' find position on the screen (not the window)
RetValue = ClientToScreen(ClipObject.hwnd, CurrentPoint)
' designate clip area
With ClipRect
.Top = CurrentPoint.Y
.Left = CurrentPoint.X
.Right = .Left + ClipObject.ScaleWidth
.Bottom = .Top + ClipObject.ScaleHeight
End With ' clip it
RetValue = ClipCursor(ClipRect)
End Sub
4、添加一个图片框控件（PICTURE1）到窗体（FORM1）
5、设置PICTURE1的尺寸和FORM1的一样大
6、在PICTURE1的CLICK事件中添加以下代码：
Private Sub Picture1_Click()
ClipMode = Not ClipMode
SetCursor Picture1, ClipMode
End Sub
7、保存工程项目
8、运行程序。在图片框单击鼠标，鼠标将被包含在图片框控件的区域内。要释放限制状态只需再次单击鼠标。
注意：如果释放限制状态失败，鼠标将被永久限制，只能用重新启动机器来解决。
另一个限制鼠标活动范围的方法是关闭鼠标，用其他图象代替光标，例如手枪。
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论