unit1.pas

不许干坏事哦,只可以学习研究 不许干坏事哦,只可以学习研究

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, CommCtrl, WinSkinData;

type
  TFRM = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Lv: TListView;
    Button2: TButton;
    ComboBox1: TComboBox;
    Button3: TButton;
    Edit2: TEdit;
    Button4: TButton;
    Timer: TTimer;
    Label1: TLabel;
    Button5: TButton;
    Edit3: TEdit;
    CB: TCheckBox;
    DateTimePicker1: TDateTimePicker;
    Button6: TButton;
    Edit4: TEdit;
    Button7: TButton;
    CBB: TCheckBox;
    SkinData1: TSkinData;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure LvClick(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    HotkeyID:Integer;
    procedure ShorCut(var Msg:TMessage); Message WM_HOTKEY;
    { Private declarations }
  public
    { Public declarations }
  end;
  function EnumChildWndProc(AhWnd:LongInt;AlParam:lParam):boolean;stdcall;
  function GetText(IHwnd:LongInt):String;
  procedure Delay(const uDelay: DWORD);
  procedure SendDBCSString(hFocus: HWND; const sSend: string);
  procedure sendpaste(Hwnd:THandle);

var
  FRM: TFRM;

implementation

{$R *.dfm}

//枚举控件句柄过程
function EnumChildWndProc(AHWnd:LongInt;ALParam:LParam):boolean;stdcall;
var
  WndClassName:Array [0..254] of Char;
  Li:TListItem;
begin
  GetClassName(AHWnd,wndClassName,255);
  with FRM do
  begin
    Li:=Lv.Items.Add;
    Li.Caption:=String(wndClassName);
    Li.SubItems.Add(GetText(AHWnd));
    Li.SubItems.Add(inttostr(AHWnd));
  end;
  result:=true;
end;

//获取控件文本
function GetText(IHwnd:LongInt):String;
var
  TextLen:LongInt;
  TextStr:Array [0..254] of Char;
begin
  TextLen:=SendMessage(IHwnd, WM_GETTEXTLENGTH, 0, 0);
  if TextLen=0 Then
  begin
    Result:='>No Text<';
    Exit;
  end;
    SendMessage(IHwnd, WM_GETTEXT, 255, Integer(@TextStr));
    Result:=StrPas(@TextStr);
end;

procedure TFRM.Button1Click(Sender: TObject);
var
  HD:LongInt;
begin
  Lv.Clear;
  HD:=FindWindow(nil,pchar(Edit1.Text));
  if HD<>0 then
  begin
    EnumChildWindows(HD,@EnumChildWndProc,0);
  end
  else
    MessageBox(Self.Handle,'没找到该窗口句柄','提示',0);
end;

procedure TFRM.Button2Click(Sender: TObject);
var
  HD:THandle;
  i:Integer;
  PStr:Array [0..254] of Char;
begin
  if Lv.ItemIndex>=0 then
  begin
    HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
    for i:=0 to SendMessage(HD,CB_GETCOUNT,0,0)-1 do begin
      SendMessage(HD,CB_GETLBTEXT,i,Integer(@PStr));
      if Edit1.Text=string(PStr) then
      SendMessage(HD,CB_SETCURSEL,i,0);
    end;
  end
  else
  Showmessage('没有选择句柄！');
end;

procedure TFRM.Button3Click(Sender: TObject);
var
  HD:THandle;
  str:string;
  i:integer;
begin
  if Lv.ItemIndex>=0 then
  begin
    HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
    str:=edit2.Text;
    SendMessage(HD,WM_SETTEXT,255,integer(pchar('')));
    for i:=1 to length(str) do
    if i mod 2>0 then
    begin
      SendDBCSString(HD,copy(str,i,2));
    end;
    SendMessage(HD,WM_CHAR,13,0);
  end
  else
  Showmessage('没有选择句柄！');
end;

procedure TFRM.Button4Click(Sender: TObject);
begin
  Timer.Enabled:=Not Timer.Enabled;
end;

procedure TFRM.TimerTimer(Sender: TObject);
var
  Point:TPoint;
  HD:THandle;
  WndClassName:Array [0..254] of Char;
  Li:TListItem;
begin
  GetCursorPos(Point);
  HD:=WindowFromPoint(point);
  Lv.Clear;
  if HD>0 then
  begin
    GetClassName(HD,wndClassName,255);
    Label1.Caption:='类名：'+ string(wndClassName)+' '+
                    '名称：'+ GetText(HD)+' '+
                    '句柄：'+ inttostr(HD);
    if CBB.Checked then
    begin
    Li:=Lv.Items.Add;
    Li.Caption:=String(wndClassName);
    Li.SubItems.Add(GetText(HD));
    Li.SubItems.Add(inttostr(HD));
    end
    else
    EnumChildWindows(HD,@EnumChildWndProc,0);
  end;
  if cb.Checked then SendMessage(HD,WM_NEXTDLGCTL,0,0);
end;

procedure Delay(const uDelay: DWORD);
var
  n: DWORD;
begin
  n := GetTickCount;
  while ((GetTickCount - n) <= uDelay) do
    Application.ProcessMessages;
end;

procedure TFRM.Button5Click(Sender: TObject);
var
  HD:THandle;
begin
  if Lv.ItemIndex>=0 then
  begin
    HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
    SendMessage(HD, WM_SETFOCUS, 0, 0);
    sendpaste(HD);
  end
  else
    Showmessage('没有选择句柄！');
end;

procedure SendDBCSString(hFocus: HWND; const sSend: string);
var
  i : integer;
  ch : byte;
begin
  i := 1;
  while i <= Length(sSend) do begin
    ch := byte(sSend[i]);
    if Windows.IsDBCSLeadByte(ch) then
    begin
      Inc(i);
      SendMessage(hFocus, WM_IME_CHAR, MakeWord(byte(sSend[i]), ch), 0);
    end
    else
      SendMessage(hFocus, WM_IME_CHAR, word(ch), 0);
    Inc(i);
  end;
end;

procedure sendpaste(Hwnd:THandle);
begin
  keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
  SendMessage(Hwnd,WM_KEYDOWN, 37, 0);
  keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);
end;

procedure TFRM.LvClick(Sender: TObject);
begin
  if Lv.ItemIndex>=0 then
  Edit3.Text:=Lv.Selected.SubItems.Strings[0];
end;

procedure TFRM.Button6Click(Sender: TObject);
var
  HD:THandle;
  ST:TSystemTime;
begin
  if Lv.ItemIndex>=0 then
  begin
    HD:=StrToInt(Lv.Selected.SubItems.Strings[1]);
    DateTimetoSystemTime(StrtoDateTime(Edit4.Text),ST);
    SendMessage(HD, DTM_SETSYSTEMTIME, 0, Integer(@ST));
  end
  else
  Showmessage('没有选择句柄！');
end;

procedure TFRM.ShorCut(var Msg:TMessage);
begin
  Msg.Result:=1; //表示消息已经用过!
  Application.BringToFront;
  Timer.Enabled:=False;
end;

procedure TFRM.FormCreate(Sender: TObject);
begin
  HotkeyID:=GlobalAddATom('FRMKey');
  RegisterHotkey(Handle,HotkeyID,Mod_Win,$53);
end;

procedure TFRM.FormDestroy(Sender: TObject);
begin
  UnregisterHotKey(Handle,HotkeyID);
end;

procedure TFRM.Button7Click(Sender: TObject);
begin
  Close;
end;

end.