delphi windows操作

输入

procedure TypeKeyString(s: string);

var

  c: Char;

  i: integer;

  off: integer;

  vkw: Word;

begin

  for i :=  to Length(s) do

  begin

    c := s[i];

    if (c < #) then

    begin

      vkw := VkKeyScan(c);

      off := ;

      if vkw and $ = $ then

        keybd_event(VK_SHIFT, , off, );

      if vkw and $ = $ then

        keybd_event(VK_CONTROL, , off, );

      if vkw and $ = $ then

        keybd_event(VK_MENU, , off, );

      off := ;

      keybd_event(Byte(vkw), , off, );

      //sleep(20);

      off := off or KEYEVENTF_KEYUP;

      keybd_event(Byte(vkw), , off, );

      off := off or KEYEVENTF_KEYUP;

      if vkw and $ = $ then

        keybd_event(VK_SHIFT, , off, );

      if vkw and $ = $ then

        keybd_event(VK_CONTROL, , off, );

      if vkw and $ = $ then

        keybd_event(VK_MENU, , off, );

    end;

  end;

end;

procedure SendKeys(focushld:hwnd;sSend:string);//发送中英文混合文本

var

    i,returnint:integer;

    ch: byte;

begin

  if focushld =  then Exit;

  i := ;

  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), );

    end

    else

      returnint:=SendMessage(focushld, WM_IME_CHAR, word(ch), );

    Inc(i);

  end;

if returnint= then

begin

TypeKeyString(sSend);

end;

  //postmessage(focushld,WM_keydown,13,0); //输入回车

end;

procedure Poststring(str:string)

var

a:TPoint; //用来存放坐标

hw:HWND; //用来存放窗口句柄

begin

sleep();

GetCursorPos(a);  //取得鼠标坐标,并存放进a中

hw := WindowFromPoint(a); //取得变量a 对应的 窗口句柄

SendKeys(hw,str);

end;

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:=-;

  Version.dwOSVersionInfoSize:=sizeof(TOSVersionInfo);

  Getversionex(version);

  case  Version.dwPlatformId  of

  VER_PLATFORM_WIN32_NT:

    begin

      if (version.dwMajorVersion=) and (version.dwMinorVersion=) then

      result:=;

      if (version.dwMajorVersion=) and (version.dwMinorVersion=) then

      result:=;

      if (version.dwMajorVersion=) and (version.dwMinorVersion=) then

      result:=;

    end;

  VER_PLATFORM_WIN32_WINDOWS:

    begin

      result:=;

    end;

  end;

end;

procedure TFrmVersion.BtnGetVersionClick(Sender: TObject);

begin

  RGPVersion.ItemIndex:=GetWinVersion;

end;

procedure TFrmVersion.BtnCloseClick(Sender: TObject);

begin

  Close;

end;

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;

向其他程序发送模拟按键

向其他程序发送模拟按键：

、用keybd_event：

var

h : THandle;

begin

h := FindWindow('TFitForm', '1stOpt - [Untitled1]');

SetForegroundWindow(h);

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, ), , );

keybd_event(VK_F9, MapVirtualKey(VK_F9, ), , );

keybd_event(VK_F9, MapVirtualKey(VK_F9, ), KEYEVENTF_KEYUP, );

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, ), KEYEVENTF_KEYUP, );

end;

选找到目标程序的句柄h，在应用Keybd_event之前必须先把目标程序设为当前活动窗口。(如果不想看见的话，把目标程序的位置用SetWindowLong设置在屏幕之外.)

、用SendMessage、PostMessage：不需目标置为最前。

SendMessage(h,WM_KEYDOWN,VK_F9,);

PostMessage(h,WM_KEYDOWN,VK_F9,);

发送组合键：PostMessage(h,WM_SYSKEYDOWN,VK_F9,$);//试验不成功

Ctrl ： $;

Shift： $;

Alt： $

如打开菜单ALT－F，则要WM_SYSKEYDOWM,：PostMessage(h,WM_SYSKEYDOWN,,$);才行。（//试验成功）

、CTL键组合发送不成功。

、向后台应用程序发送按键总结：

4.1 单个按健：PostMessage(h,WM_KEYDOWN,VK_F9,);

.2ALT+按键：PostMessage(h,WM_SYSKEYDOWN,,$);

.3CTL+按键：暂时模仿如下，基本可行。但不用sleep()，有时行，有时不行。换用SendMessage却不行，WHY？

if hwnd<> then

begin

keybd_event(VK_CONTROL,,,);

PostMessage(hwnd,WM_KEYDOWN,VK_F9,);

PostMessage(hwnd,WM_KEYUP,VK_F9,);

sleep();

keybd_event(VK_CONTROL,,KEYEVENTF_KEYUP,);

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）消息。

delphi 获取文件版本

function GetFileVersion(FileName: string): string;

const

InfoNum = ;

InfoStr: array[..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 >  then begin

      Buf := AllocMem(BufSize);

      GetFileVersionInfo(PChar(S), , 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[]), 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;

Delphi中限制鼠标的移动区域

下面把鼠标的移动区域限制在(,,,)

var

rect:TRect;

begin

rect.Left:=;

rect.Top:=;

rect.Bottom:=;

rect.Right:=;

windows.ClipCursor(@rect);

end;

恢复鼠标的移动区域

windows.ClipCursor();

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;

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=$;{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)< ) 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+,wb1.Top+);

  //是把坐标从当前窗体转化成全屏幕的！！！

  Windows.ClientToScreen(wb1.Handle, NewPt);

  //设置鼠标指针位置并点击

  SetCursorPos(NewPt.X, NewPt.Y);

  mouse_event(MOUSEEVENTF_LEFTDOWN, NewPt.X, NewPt.Y, , );

  mouse_event(MOUSEEVENTF_LEFTUP, NewPt.X, NewPt.Y, , ); 

  //还原鼠标位置

  SetCursorPos(oldPt.X, oldPt.Y);

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,); 

//------------------------开始密码输入------------------------------

  Clipboard.Clear;

  //将用户名存入剪切板

  login_user := Trim(edt1.text);

  Clipboard.SetTextBuf(PChar(login_user));

  //模拟按下ctrl+v        

//  ShowMessage(Clipboard.AsText);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,),,);

  keybd_event(,,,);

  keybd_event(,,KEYEVENTF_KEYUP,);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,),KEYEVENTF_KEYUP,);

//------------------------开始密码输入------------------------------

  delay();

  Clipboard.Clear;

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,);

  //再次模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,);

  login_password := Trim(edt2.text);

  Clipboard.AsText := login_password;

  //模拟按下ctrl+v

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,),,);

  keybd_event(,,,);

  keybd_event(,,KEYEVENTF_KEYUP,);

  keybd_event(VK_CONTROL,MapVirtualKey(VK_CONTROL,),KEYEVENTF_KEYUP,);

//------------------------开始按下登录按钮------------------------------

  delay();

  //模拟按下TAB键

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),,);

  keybd_event(VK_TAB,MapVirtualKey(VK_TAB,),KEYEVENTF_KEYUP,);

  //模拟按下回车键不管用,只能用空格键

  keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,),,);

  keybd_event(VK_SPACE,MapVirtualKey(VK_SPACE,),KEYEVENTF_KEYUP,);

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(,);

  //是把坐标从当前窗体转化成全屏幕的！！！

  Windows.ClientToScreen(wb1.Handle, NewPt);

  //设置鼠标指针位置并右击

  SetCursorPos(NewPt.X, NewPt.Y);

  mouse_event(MOUSEEVENTF_RIGHTDOWN, NewPt.X, NewPt.Y, , );

  mouse_event(MOUSEEVENTF_RIGHTUP, NewPt.X, NewPt.Y, , );

  yzmPath := GetShellFolder('Personal')+'My Pictures\无标题.bmp';

  if FileExists(yzmPath) then

    DeleteFile(yzmPath);

  SetCursorPos(NewPt.X+, NewPt.Y+);   //鼠标移动到“图像另存为(s)...”

  //单击ENTER键，保存图片

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,),,);

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,),KEYEVENTF_KEYUP,);

  //单击ENTER键,关闭保存图片窗口

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,),,);

  keybd_event(VK_RETURN,MapVirtualKey(VK_RETURN,),KEYEVENTF_KEYUP,);

  //监听窗口是否关闭掉

  timer_Listen_PopuForm.Enabled := True;

  delay();

  kGetCodeFromFile(PChar(yzmPath), '', '', 'dv', pCode, Length(code), '');

  Result := code;

//  if ImmIsIME(myhkl) then     //判断是否在中文状态,若是则关闭它

//    immsimulateHotkey(handle,IME_CHotKey_IME_NonIME_Toggle);

  SetCursorPos(oldPt.x,oldPt.Y);

end;

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();

  end;

  Result:=CallNextHookEx(hHook1,nCode,wParam,lParam);

end;

//设置鼠标钩子

function setHook:Boolean;stdcall;

begin

  hHook1:=SetWindowsHookEx(WH_MOUSE,@hookProc,HInstance,);

  Result:=hHook1<>;

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.

巴特西

delphi windows操作

最新文章

热门文章