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.