delphi编写能够模拟键盘输入应用程序的源代码

下面是我很多年前编写的一个在“江湖”游戏里面泡点的程序，该程序手动选择浏览器的HANDLE，然后自动完成打怪、发言等功能。，程序如下：

program jianghu

{$apptype console}

uses windows,messages

function GetFocusHld: hwnd

var

windowhld:hwnd

threadld:dword

begin

windowhld:=GetForegroundWindow

threadld:=GetWindowThreadProcessId(Windowhld,nil)

AttachThreadInput(GetCurrentThreadId,threadld,true)

Result:=getfocus

AttachThreadInput(GetCurrentThreadId,threadld,false)

end

procedure SendKeys(focushld:hwndsSend:string)

var

i:integer

ch: byte

begin

if focushld = 0 then Exit

i := 1

while i <= Length(sSend) do

begin

ch := byte(sSend[i])

if Windows.IsDBCSLeadByte(ch) then

begin

Inc(i)

SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[i]), ch), 0)

end

else

SendMessage(focushld, WM_IME_CHAR, word(ch), 0)

Inc(i)

end

postmessage(focushld,WM_keydown,13,0)

end

procedure CloseIEPopWind

var

hCurrentWindow, hActWind: HWnd

szText: array [0..255] of char

begin

hActWind:=FindWindow('Progman',nil)

hCurrentWindow := GetWindow(hActWind, GW_HWNDFIRST)

while hCurrentWindow <>0 do

begin

if (GetWindowText(hCurrentWindow, @szText, 255)>0) and (szText='Microsoft Internet Explorer')

then begin

//writeln('Found IE Pop Window ',hCurrentWindow, #9, szText)

PostMessage(hCurrentWindow,WM_CLOSE,1,0)

end

hCurrentWindow:=GetWindow(hCurrentWindow, GW_HWNDNEXT)

end

end

var

s: string

i,n: integer

focushld: hwnd

nosay: boolean

begin

n:=0

nosay:=false

if ParamCount>0 then begin

val(ParamStr(1),n,i)

nosay:=(i=0)and(n=0)

if i<>0 then n:=0

end

if n=0 then n:=10

writeln('江湖自动泡点程序－－杨光彬 2002年5月7日修订版'#13#10)

writeln('用法：',ParamStr(0),' [自动重复时间(这次为',n,'秒)]'#13#10)

n:=n*1000

if not nosay then begin

writeln('请在五秒之内移动到江湖窗口，鼠标点击话语输入框，等待自动说出0'#13#10)

sleep(5000)

focushld:=getfocushld

write('已经开始自动泡点，按Ctrl+C退出程序。(',focushld,') ... ')

end else write('此次仅仅是自动关闭IEd出窗口，按Ctrl+C退出程序 ... ')

i:=0

repeat

CloseIEPopWind

if not nosay then begin

str(i,s)

if i mod (180000 div n)=0 then sendkeys(focushld,'/练武$') else

sendkeys(focushld,s)

inc(i)

end

sleep(n)

until false

end.

使用时定义一个TBevel控件，锁定鼠标实际上是将光标控制在这个TBevel区间内，也可以把光标控制在屏幕左上角一个点的位置：LockRect := Rect(0,0,1,1)

调试时要注意在程序中控制开启鼠标或键盘，否则输入设备都被封锁了，只有关电源重启．

procedure TForm1.LockKeyAndCursor(Lock: boolean)

var

LockRect: TRect

begin

if Lock = True then

begin

LockRect := Rect(Form1.Left + bvLockCursor.Left,

Form1.Top + bvLockCursor.Top,

Form1.Left + bvLockCursor.Left + bvLockCursor.Width,

Form1.Top + bvLockCursor.Top + bvLockCursor.Height)

ClipCursor(@LockRect)

LockKey(True)

end

else

begin

FreeRect := Rect(0,0,Screen.Width,Screen.Height)

ClipCursor(@FreeRect)

LockKey(False)

end

end

procedure TForm1.LockKey(Lock: boolean)

var

temp: integer

begin

if Lock = True then

begin

asm

IN AL,21H

OR AL,02H

OUT 21H,AL

end

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @temp, 0)//封锁组合键Ctrl+Alt+Del

end

else

begin

asm

IN AL,21H

AND AL,0FDH

OUT 21H,AL

end

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @temp, 0)//解开组合键Ctrl+Alt+Del

end

end

（以上代码出自大富翁）

---