'注意:以下代码必须在程序编译后才有效,程序根目录必须含有以下三个文件(WinIo WinIo.dll WINIO.VXD),相关文件请到程序附件中下载
Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean
Declare Function ShutdownWinIo Lib "WinIo.dll" () As Boolean
Declare Function InstallWinIoDriver Lib "WinIo.dll" (ByVal DriverPath As String, ByVal Mode As Integer) As Boolean
Declare Function RemoveWinIoDriver Lib "WinIo.dll" () As Boolean
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Public Const KBC_KEY_CMD = &H64   '端口
Public Const KBC_KEY_DATA = &H60   '端口

Sub KBCWait4IBE()
	Dim dwVal As Long
	Do
	GetPortVal &H64, dwVal, 1
	Loop While (dwVal And &H2)
End Sub


Sub MyKeyDown(ByVal vKeyCoad As Long)
	Dim btScancode As Long
	btScancode = MapVirtualKey(vKeyCoad, 0)
	
	KBCWait4IBE
	SetPortVal KBC_KEY_CMD, &HD2, 1
	
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, btScancode, 1
End Sub

Sub MyKeyUp(ByVal vKeyCoad As Long)
	Dim btScancode As Long
	btScancode = MapVirtualKey(vKeyCoad, 0)
	KBCWait4IBE
	SetPortVal KBC_KEY_CMD, &HD2, 1 '发送键盘写入命令
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息，释放键
End Sub

Sub MyKeyDownEx(ByVal vKeyCoad As Long)   '模拟扩展键按下，参数vKeyCoad是扩展键的虚拟码
	Dim btScancode As Long
	btScancode = MapVirtualKey(vKeyCoad, 0)
	
	KBCWait4IBE   '等待键盘缓冲区为空
	SetPortVal KBC_KEY_CMD, &HD2, 1   '发送键盘写入命令
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
	
	KBCWait4IBE   '等待键盘缓冲区为空
	SetPortVal KBC_KEY_CMD, &HD2, 1   '发送键盘写入命令
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, btScancode, 1 '写入按键信息,按下键
End Sub


Sub MyKeyUpEx(ByVal vKeyCoad As Long)   '模拟扩展键弹起
	Dim btScancode As Long
	btScancode = MapVirtualKey(vKeyCoad, 0)
	
	KBCWait4IBE   '等待键盘缓冲区为空
	SetPortVal KBC_KEY_CMD, &HD2, 1   '发送键盘写入命令
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, &HE0, 1 '写入扩展键标志信息
	
	
	KBCWait4IBE   '等待键盘缓冲区为空
	SetPortVal KBC_KEY_CMD, &HD2, 1   '发送键盘写入命令
	KBCWait4IBE
	SetPortVal KBC_KEY_DATA, (btScancode Or &H80), 1 '写入按键信息，释放键
End Sub
'===============================================以上代码放到模块中===============================================

'===============================================以下代码为窗体代码===============================================
Private Sub Form_Load()
	If InitializeWinIo = False Then             '用InitializeWinIo函数加载驱动程序，如果成功会返回true，否则返回false
		MsgBox "驱动加载失败！"
		Unload Me
	End If
	Timer1.Interval = 3000
End Sub

Private Sub Form_Unload(Cancel As Integer)
	ShutdownWinIo                           '程序结束时用ShutdownWinIo函数卸载驱动程序
End Sub

Private Sub Timer1_Timer()
	MyKeyDown vbKeyA                            '模拟按下A键
	MyKeyUp vbKeyA                              '模拟释放A键
End Sub