输入
procedure TypeKeyString(s: string);
var
c: Char;
i: integer;
off: integer;
vkw: Word;
begin
for i := 1 to Length(s) do
begin
c := s[i];
if (c < #128) then
begin
vkw := VkKeyScan(c);
off := 0;
if vkw and $100 = $100 then
keybd_event(VK_SHIFT, 0, off, 0);
if vkw and $200 = $200 then
keybd_event(VK_CONTROL, 0, off, 0);
if vkw and $400 = $400 then
keybd_event(VK_MENU, 0, off, 0);
off := 0;
keybd_event(Byte(vkw), 0, off, 0);
//sleep(20);
off := off or KEYEVENTF_KEYUP;
keybd_event(Byte(vkw), 0, off, 0);
off := off or KEYEVENTF_KEYUP;
if vkw and $100 = $100 then
keybd_event(VK_SHIFT, 0, off, 0);
if vkw and $200 = $200 then
keybd_event(VK_CONTROL, 0, off, 0);
if vkw and $400 = $400 then
keybd_event(VK_MENU, 0, off, 0);
end;
end;
end;
procedure SendKeys(focushld:hwnd;sSend:string);//发送中英文混合文本
var
i,returnint: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);
returnint:=SendMessage(focushld, WM_IME_CHAR, MakeWord(byte(sSend[i]), ch), 0);
end
else
returnint:=SendMessage(focushld, WM_IME_CHAR, word(ch), 0);
Inc(i);
end;
if returnint=0 then
begin
TypeKeyString(sSend);
end;
//postmessage(focushld,WM_keydown,13,0); //输入回车
end;
procedure Poststring(str:string)
var
a:TPoint; //用来存放坐标
hw:HWND; //用来存放窗口句柄
begin
sleep(1000);
GetCursorPos(a); //取得鼠标坐标,并存放进a中
hw := WindowFromPoint(a); //取得变量a 对应的 窗口句柄
SendKeys(hw,str);
end;
View Code
windows版本信息
Function TFrmVersion.GetWinVersion:integer;
var
version:TOSVersionInfo;
begin
//result 0 is Winxp
//result 1 is Windows NT
//result 2 is Windows 98
//result 3 is windows 2000
result:=-1;
Version.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);
Getversionex(version);
case Version.dwPlatformId of
VER_PLATFORM_WIN32_NT:
begin
if (version.dwMajorVersion=5) and (version.dwMinorVersion=1) then
result:=0;
if (version.dwMajorVersion=4) and (version.dwMinorVersion=0) then
result:=1;
if (version.dwMajorVersion=5) and (version.dwMinorVersion=0) then
result:=3;
end;
VER_PLATFORM_WIN32_WINDOWS:
begin
result:=2;
end;
end;
end;
procedure TFrmVersion.BtnGetVersionClick(Sender: TObject);
begin
RGPVersion.ItemIndex:=GetWinVersion;
end;
procedure TFrmVersion.BtnCloseClick(Sender: TObject);
begin
Close;
end;
View Code
delphi中获取光标句柄代码
{
当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。
本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
例如,想在屏幕截取程序中放置光标时该如何做。
}
function GetCursorHandle: HCURSOR;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
// 检查哪个窗体掌握光标
GetCursorPos(pt);
hWindow := WindowFromPoint(pt);
// 获得光标所有者的线程ID
dwThreadID := GetWindowThreadProcessId(hWindow, nil);
// 获得当前线程的ID
dwCurrentThreadID := GetCurrentThreadId;
// 如果光标所有者的线程不是当前线程,就要把光标所有者的线程配属到当前线程。
//然后调用GetCursor()来获得正确的光标句柄(hCursor)。
if (dwCurrentThreadID <> dwThreadID) then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
begin
// 获得光标句柄
Result := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end else
begin
Result := GetCursor;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
CurPosX, CurPoxY: Integer;
MyCursor: TIcon;
pIconInfo: TIconInfo;
begin
MyCursor := TIcon.Create;
try
MyCursor.Handle := GetCursorHandle;
// 获得光标位置
GetIconInfo(MyCursor.Handle, pIconInfo);
CurPosX := pIconInfo.xHotspot;
CurPoxY := pIconInfo.yHotspot;
// 在窗体上画出光标
Canvas.Draw(CurPoxY, CurPoxY, MyCursor);
finally
当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
=========================================================
{
当光标被另外一个线程掌握时,就无法用GetCursor()应用接口获得光标句柄。
本文阐述如何在任何线程掌握光标时都能够获取光标句柄。
例如,想在屏幕截取程序中放置光标时该如何做。
}
function GetCursorHandle: HCURSOR;
var
hWindow: HWND;
pt: TPoint;
pIconInfo: TIconInfo;
dwThreadID, dwCurrentThreadID: DWORD;
begin
// 检查哪个窗体掌握光标
GetCursorPos(pt);
hWindow := WindowFromPoint(pt);
// 获得光标所有者的线程ID
dwThreadID := GetWindowThreadProcessId(hWindow, nil);
// 获得当前线程的ID
dwCurrentThreadID := GetCurrentThreadId;
// 如果光标所有者的线程不是当前线程,就要把光标所有者的线程配属到当前线程。
//然后调用GetCursor()来获得正确的光标句柄(hCursor)。
if (dwCurrentThreadID <> dwThreadID) then
begin
if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
begin
// 获得光标句柄
Result := GetCursor;
AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
end;
end else
begin
Result := GetCursor;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
CurPosX, CurPoxY: Integer;
MyCursor: TIcon;
pIconInfo: TIconInfo;
begin
MyCursor := TIcon.Create;
try
MyCursor.Handle := GetCursorHandle;
// 获得光标位置
GetIconInfo(MyCursor.Handle, pIconInfo);
CurPosX := pIconInfo.xHotspot;
CurPoxY := pIconInfo.yHotspot;
// 在窗体上画出光标
Canvas.Draw(CurPoxY, CurPoxY, MyCursor);
finally
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
end;
// 另外一种解决办法:
procedure TForm1.Timer1Timer(Sender: TObject);
var
CI: TCursorInfo;
begin
CI.cbSize := SizeOf(CI);
GetCursorInfo(CI);
Image1.Picture.Icon.Handle := CI.hCursor;
end;
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
end;
// 另外一种解决办法:
procedure TForm1.Timer1Timer(Sender: TObject);
var
CI: TCursorInfo;
begin
CI.cbSize := SizeOf(CI);
GetCursorInfo(CI);
Image1.Picture.Icon.Handle := CI.hCursor;
end;
View Code
向其他程序发送模拟按键
向其他程序发送模拟按键:
1、用keybd_event:
var
h : THandle;
begin
h := FindWindow('TFitForm', '1stOpt - [Untitled1]');
SetForegroundWindow(h);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(VK_F9, MapVirtualKey(VK_F9, 0), 0, 0);
keybd_event(VK_F9, MapVirtualKey(VK_F9, 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0);
end;
选找到目标程序的句柄h,在应用Keybd_event之前必须先把目标程序设为当前活动窗口。(如果不想看见的话,把目标程序的位置用SetWindowLong设置在屏幕之外.)
2、用SendMessage、PostMessage:不需目标置为最前。
SendMessage(h,WM_KEYDOWN,VK_F9,0);
PostMessage(h,WM_KEYDOWN,VK_F9,0);
发送组合键:PostMessage(h,WM_SYSKEYDOWN,VK_F9,$10000000);//试验不成功
Ctrl : $10000000;
Shift: $08000000;
Alt: $20000000
如打开菜单ALT-F,则要WM_SYSKEYDOWM,:PostMessage(h,WM_SYSKEYDOWN,70,$20000000);才行。(//试验成功)
3、CTL键组合发送不成功。
4、向后台应用程序发送按键总结:
4.1 单个按健:PostMessage(h,WM_KEYDOWN,VK_F9,0);
4.2ALT+按键:PostMessage(h,WM_SYSKEYDOWN,70,$20000000);
4.3CTL+按键:暂时模仿如下,基本可行。但不用sleep(10),有时行,有时不行。换用SendMessage却不行,WHY?
if hwnd<>0 then
begin
keybd_event(VK_CONTROL,0,0,0);
PostMessage(hwnd,WM_KEYDOWN,VK_F9,0);
PostMessage(hwnd,WM_KEYUP,VK_F9,0);
sleep(10);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
end;
说明:
键盘事件消息可以分为“击键”和“字符”两类。对于可以显示字符的击键组合,Windows不仅向程序发送击键消息,还发送字符消息。有些键不产生字符,这些键包括shift键、Fn功能键、光标移动键和特殊字符如Insert和Delete。
击键消息包括WM_KEYDOWN、WM_KEYUP、WM_SYSKEYDOWN、WM_SYSKEYUP四种类型。WM_KEYDOWN和WM_KEYUP消息通常是在按下或释放不带Alt键的键时产生;WM_SYSKEYDOWN和WM_SYSKEYUP消息通常由与Alt组合的击键产生,这些键激活程序菜单或系统菜单上的选项,或切换活动窗口,也可以用作系统菜单加速键。由于Windows处理所有Alt键的功能,应用程序无需捕获这些消息。对于4类击键消息,wParam是虚拟键代码,代表按下或释放的键,而lParam包含击键的其他数据。如果按住一个键不放使得自动重复功能生效,那么该键最后被释放时,Windows会给窗口过程发送一系列的WM_KEYDOWN(或WM_SYSKEYDWON)消息和一个WM_KEYUP(或WM_SYSKEYUP)消息。
View Code
delphi 获取文件版本
function GetFileVersion(FileName: string): string;
const
InfoNum = 9;
InfoStr: array[1..InfoNum] of string = (
'ProductName',
'ProductVersion',
'FileDescription',
'LegalCopyright',
'FileVersion',
'CompanyName',
'LegalTradeMarks',
'InternalName',
'OriginalFileName'
);
var
S: string;
BufSize, Len: DWORD;
Buf: PChar;
Value: PChar;
begin
S := FileName;
BufSize := GetFileVersionInfoSize(PChar(S), BufSize);
if BufSize > 0 then begin
Buf := AllocMem(BufSize);
GetFileVersionInfo(PChar(S), 0, BufSize, Buf);
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[1]), Pointer(Value), Len) then
// result := Value;
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[2]), Pointer(Value), Len) then
// result := Value; //产品版本:
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[3]), Pointer(Value), Len) then
// result := Value;//'文件说明: '
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[4]), Pointer(Value), Len) then
// result := Value; //'合法版权: ' +
if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[5]), Pointer(Value), Len) then
result := Value; //'文件版本: ' +
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[6]), Pointer(Value), Len) then
// result := Value; //'公司名称: ' +
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[7]), Pointer(Value), Len) then
// result := Value;// '合法商标: ' +
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[8]), Pointer(Value), Len) then
// result := Value;// '内部名称: ' +
// if VerQueryValue(Buf, PChar('StringFileInfo\080403A8\' + InfoStr[9]), Pointer(Value), Len) then
// result := Value; //'原文件名: ' +
FreeMem(Buf, BufSize);
end
else begin
// Application.MessageBox('获取产品信息时遇到致命错误,请尝试重新启动软件。'+ #13 + '若仍未能解决问题,请联系产品服务人员。','错误',MB_OK + MB_ICONSTOP);
result := '0.0.0.0';
end;
end;
View Code
Delphi中限制鼠标的移动区域
下面把鼠标的移动区域限制在(100,100,200,200)
var
rect:TRect;
begin
rect.Left:=100;
rect.Top:=100;
rect.Bottom:=200;
rect.Right:=200;
windows.ClipCursor(@rect);
end;
恢复鼠标的移动区域
windows.ClipCursor(0);
var
P: tpoint;
h: thandle;
getCursorpos(p); //鼠标点击位置
h:= windowFromPoint(p);
if h= wincontrol.handle then
showmessage('在某一控键上');
procedure TForm2.Timer1Timer(Sender: TObject);
var
p: TPoint;
h: HWND;
r:trect;
begin
GetCursorPos(p);
h := WindowFromPoint(p);
GetWindowRect(h,r);//得到窗口的左上角坐标
label4.Caption:=format('x: %d, y: %d',[r.left,r.top]);
Windows.ScreenToClient(h, p);
label1.Caption:=format('x: %d, y: %d',[p.X,p.y]);//鼠标在窗口里的相对位置坐标
end;
View Code
Delphi模拟按键精灵操作网页
一、让Webbrowser响应回车事件!
在窗体中放入一个ApplicationEvents1,然后定义事件:
private
procedure ApplicationEvents1Message(var Msg: tagMSG;var Handled: Boolean); //响应回车事件(Alt+Enter)
//程序实现:只需改动webForm.wb1.Handle即可
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
{fixesthemalfunctionofsomekeyswithinwebbrowsercontrol}
const
StdKeys=[VK_TAB,VK_RETURN];{standardkeys}
ExtKeys=[VK_DELETE,VK_BACK,VK_LEFT,VK_RIGHT];{extendedkeys}
fExtended=$01000000;{extendedkeyflag}
begin
Handled := False;
with Msg do
if ((Message>= WM_KEYFIRST) and (Message<=WM_KEYLAST)) and
( (wParam in StdKeys) or {$IFDEF VER120}(GetKeyState(VK_CONTROL)<0 ) or {$ENDIF}
(wParam in ExtKeys) and ( (lParam and fExtended)= fExtended) )
then
try
if IsChild(webForm.wb1.Handle, hWnd) then
{ handles all browser related messages }
begin
with webForm.wb1.Application as IOleInPlaceActiveObject do
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end;
二、delphi模拟按键精灵鼠标、键盘操作
procedure TForm1.wjLoginClick(Sender: TObject);
var
login_user : string;
login_password : string;
oldPt,newPt : TPoint;
begin
// webForm.Show;
//获取当前光标位置,并赋值给oldPt
GetCursorPos(OldPt);
//设置新光标位置
NewPt:=Point(wb1.Left+1,wb1.Top+1);
//是把坐标从当前窗体转化成全屏幕的!!!
Windows.ClientToScreen(wb1.Handle, NewPt);
//设置鼠标指针位置并点击
SetCursorPos(NewPt.X, NewPt.Y);
mouse_event(MOUSEEVENTF_LEFTDOWN, NewPt.X, NewPt.Y, 0, 0);
mouse_event(MOUSEEVENTF_LEFTUP, NewPt.X, NewPt.Y, 0, 0);
//还原鼠标位置
SetCursorPos(oldPt.X, oldPt.Y);
//模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
//再次模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
//再次模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
//------------------------开始密码输入------------------------------
Clipboard.Clear;
//将用户名存入剪切板
login_user := Trim(edt1.text);
Clipboard.SetTextBuf(PChar(login_user));
//模拟按下ctrl+v
// ShowMessage(Clipboard.AsText);
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0);
keybd_event(86,0,0,0);
keybd_event(86,0,KEYEVENTF_KEYUP,0);
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);
//------------------------开始密码输入------------------------------
delay(500);
Clipboard.Clear;
//模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
//再次模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
login_password := Trim(edt2.text);
Clipboard.AsText := login_password;
//模拟按下ctrl+v
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),0,0);
keybd_event(86,0,0,0);
keybd_event(86,0,KEYEVENTF_KEYUP,0);
keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,0),KEYEVENTF_KEYUP,0);
//------------------------开始按下登录按钮------------------------------
delay(500);
//模拟按下TAB键
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),0,0);
keybd_event(VK_TAB,MapVirtualKey(VK_TAB,0),KEYEVENTF_KEYUP,0);
//模拟按下回车键不管用,只能用空格键
keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),0,0);
keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,0),KEYEVENTF_KEYUP,0);
end;
三、在指定位置单击保存验证码图片
function TForm1.getcheckcode :string;
var
oldPt : Tpoint;
NewPt : TPoint;
i,N : Integer;
myhkl : hkl;
h : HWND;
r : TRect;
yzmPath : String;
begin
//获取当前光标位置,并赋值给oldPt
GetCursorPos(OldPt);
//设置新光标位置
NewPt:=Point(540,445);
//是把坐标从当前窗体转化成全屏幕的!!!
Windows.ClientToScreen(wb1.Handle, NewPt);
//设置鼠标指针位置并右击
SetCursorPos(NewPt.X, NewPt.Y);
mouse_event(MOUSEEVENTF_RIGHTDOWN, NewPt.X, NewPt.Y, 0, 0);
mouse_event(MOUSEEVENTF_RIGHTUP, NewPt.X, NewPt.Y, 0, 0);
yzmPath := GetShellFolder('Personal')+'My Pictures\无标题.bmp';
if FileExists(yzmPath) then
DeleteFile(yzmPath);
SetCursorPos(NewPt.X+85, NewPt.Y+105); //鼠标移动到“图像另存为(s)...”
//单击ENTER键,保存图片
keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),0,0);
keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),KEYEVENTF_KEYUP,0);
//单击ENTER键,关闭保存图片窗口
keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),0,0);
keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,0),KEYEVENTF_KEYUP,0);
//监听窗口是否关闭掉
timer_Listen_PopuForm.Enabled := True;
delay(500);
kGetCodeFromFile(PChar(yzmPath), '', '1', 'dv', pCode, Length(code), '');
Result := code;
// if ImmIsIME(myhkl) then //判断是否在中文状态,若是则关闭它
// immsimulateHotkey(handle,IME_CHotKey_IME_NonIME_Toggle);
SetCursorPos(oldPt.x,oldPt.Y);
end;
View Code
Delphi 全局鼠标钩子的简单演程序
dll源代码:
---------------------------------------------------------------------------
library Project2;
uses
SysUtils,
Classes,
Windows,Messages;
{$R *.res}
var
hHook1:HHOOK;
function hookProc(
nCode:Integer; // hook code
wParam:WPARAM; // message identifier消息标识
lParam:LPARAM // mouse coordinates鼠标坐标
):LRESULT;stdcall;
begin
if wParam=WM_LBUTTONDOWN then //只处理鼠标的左键按下消息
begin
MessageBeep(0);
end;
Result:=CallNextHookEx(hHook1,nCode,wParam,lParam);
end;
//设置鼠标钩子
function setHook:Boolean;stdcall;
begin
hHook1:=SetWindowsHookEx(WH_MOUSE,@hookProc,HInstance,0);
Result:=hHook1<>0;
end;
//删除鼠标钩子
function delHook:Boolean;stdcall;
begin
Result:=UnhookWindowsHookEx(hHook1);
end;
exports //导出函数
setHook name 'setHook',
delHook name 'delHook',
hookProc name 'hookProc';
begin
end.
调用源代码:
---------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
Private
{ Private declarations }
public
constructor Create(AOwner: TComponent); override;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function setHook:Boolean;external 'project2.dll' name 'setHook';
function delHook:Boolean;external 'project2.dll' name 'delHook';
procedure TForm1.Button1Click(Sender: TObject);
begin
if sethook then
Label1.Caption:='钩子安装成功,按鼠标左键会发出声音';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if delHook then
Label1.Caption:='勾子已经删除';
end;
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
form1.Label1.Caption:='';
end;
end.