1,183
社区成员




unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TKeyThread = class(TThread)
private
procedure WaitEmpty();
procedure mKeyDown(vk: byte);
procedure mKeyUp(vk: byte);
protected
procedure Execute;override;
end;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function InitializeWinIo:Boolean;stdcall;external 'WinIo.dll' name'InitializeWinIo';
function GetPortVal(PortAddr:Word;PortVal:pDWord;bSize:Byte):Boolean;stdcall;external 'WinIo.dll' name 'GetPortVal';
function SetPortVal(PortAddr:Word;PortVal:DWord;bSize:Byte):Boolean;stdcall;external 'WinIo.dll' name 'SetPortVal';
{
function InstallWinIoDriver(pszWinIoDriverPath:PString;IsDemandLoaded:boolean=false):Boolean;stdcall;external 'WinIo.dll' name 'InstallWinIoDriver';
function RemoveWinIoDriver:Boolean;stdcall;external 'WinIo.dll' name 'RemoveWinIoDriver';
function GetPhysLong(PhysAddr:PByte;PhysVal:PDWord):Boolean;stdcall;external 'WinIo.dll' name 'GetPhysLong';
function SetPhysLong(PhysAddr:PByte;PhysVal:DWord):Boolean;stdcall;external 'WinIo.dll' name 'SetPhysLong';
function MapPhysToLin(PhysAddr:PByte;PhysSize:DWord;PhysMemHandle:PHandle):PByte;stdcall;external 'WinIo.dll' name 'MapPhysToLin';
function UnMapPhysicalMemory(PhysMemHandle:THandle;LinAddr:PByte):Boolean;stdcall;external 'WinIo.dll' name 'UnmapPhysicalMemory';
}
procedure ShutdownWinIo;stdcall;external 'WinIo.dll' name'ShutdownWinIo';
procedure TKeyThread.WaitEmpty();
var
mValue: byte;
begin
repeat
GetPortVal($64,@mValue,1);
if (mValue and $2)=0 then break;
sleep(10);
until (mValue and $2)=0;
end;
procedure TKeyThread.mKeyDown(vk: byte);
begin
WaitEmpty();
SetPortVal($64,$D2,1);
WaitEmpty();
SetPortVal($60,MapVirtualKey(vk,0),1);
end;
procedure TKeyThread.mKeyUp(vk: byte);
begin
WaitEmpty();
SetPortVal($64,$D2,1);
WaitEmpty();
SetPortVal($60,MapVirtualKey(vk,0) or $80,1);
end;
procedure TKeyThread.Execute();
begin
mKeyDown(VK_SPACE);
//keybd_event( 32, 0, 0, 0);
sleep(2000);
//keybd_event( 32,0, KEYEVENTF_KEYUP, 0);
mKeyUp(VK_SPACE);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
mKeyThread: TKeyThread;
begin
Memo1.SetFocus;
mKeyThread := TKeyThread.Create(True);
mKeyThread.FreeOnTerminate := True;
mKeyThread.Resume;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if InitializeWinIo=False then begin
ShowMessage('初始化失败!');
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ShutdownWinIo;
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Memo1.Lines.Add('down');
end;
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Memo1.Lines.Add('up')
end;
end.
procedure TKeyThread.Execute();
begin
mKeyDown(VK_CONTROL); //ctrl
mKeyDown($56); //v
//mKeyDown(VK_SPACE);
//keybd_event( 32, 0, 0, 0);
sleep(2000);
//keybd_event( 32,0, KEYEVENTF_KEYUP, 0);
mKeyUp($56);
//mKeyUp(VK_SPACE);
mKeyUp(VK_CONTROL);
end;