所见及所得的类分析跟踪器

2008-04-09 04:31:49来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

{以下代码可以分析Windows下的鼠标处的对象类名,句柄及其递归父类等信息,是很久以前火鸟的工具软件视窗超人中的一段代码。其触发使用了Timer控件,其实更好的实现是用Windows Mouse Hook来做触发,就当抛砖引玉吧;此代码还实现了不依赖于Windows2000以上要求的半透明窗口(在Win98/WinMe下也可半透明),本实现的实现其实比较类似于金山词霸的即指即译功能,只不过大家在做不同的应用而已。 在Delphi环境下,新建一个窗体,把代码贴入即可,本工具主要会对做Windows环境下的开发人员工作有些帮助(如分析别人的程序的控件对象,跟踪对象句柄等)}
unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Timer1: TTimer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var poss:TPoint;
ic:Hdc;
Bmp:TbitMap;
Hands: HWND;
Buf: array[0..129] of Char;
Stmp:TStrings;
itmp,iwidth,iheight:integer;
sword,sline:string;
begin
GetCursorPos(Poss);
with self do
begin
if (poss.x <> tag-10) or (poss.y<>timer1.Tag-10) then left:=screen.Width
else
begin
Hands := WindowFromPoint(Poss);
if (left=tag) or (hands=handle) then exit;
stmp:=TStringList.create;
stmp.Add(''''句柄: '''' IntToStr(Hands));
GetClassName(Hands, Buf, 128);
stmp.Add (''''类名: '''' Buf);
itmp:=GetParent(Hands);
while itmp>0 do
begin
GetClassName(itmp, Buf, 128);
if buf<>'''''''' then stmp.Add (inttostr(stmp.Count-1) ''''级父类: '''' Buf);
itmp:=GetParent(itmp);
end;
SendMessage(Hands, WM_GETTEXT, 128, Integer(@Buf));
sword:=''''字符: '''' buf;
if length(sword)>132 then sword:=sword ''''....'''';
repeat
itmp:=pos(chr(10),sWord);
if itmp>0 then
begin
sline:=copy(sWord,1,itmp-1);
sword:=copy(sWord,itmp 1,length(sword));
end
else sline:=sword;
itmp:=pos(chr(13),sline);
if itmp>0 then sline:=copy(sline,1,itmp-1);
stmp.Add(sline);
until sline=sword;
iwidth:=0;
for itmp:=0 to stmp.Count-1 do if canvas.TextWidth(stmp[itmp]) 15>iWidth then iWidth:=canvas.TextWidth(stmp[itmp]) 15;
iheight:=stmp.Count*(canvas.TextHeight(stmp[0]) 2);
width:=iwidth;
height:=iheight;
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE SWP_NOSIZE SWP_NOACTIVATE SWP_NOOWNERZORDER);
ic:=CreateDC(''''DISPLAY'''',nil,nil,nil);
if tag width>screen.Width then tag:=screen.Width-width;
if timer1.Tag height>screen.Height then timer1.Tag:=screen.Height-height;
Bmp:=Tbitmap.Create;
bmp.Width := Width;
bmp.Height :=Height;
bitblt(bmp.Canvas.handle,0,0,Width,Height,ic,tag,timer1.Tag,SRCCOPY);
Left :=tag;
Top :=timer1.tag;
bitblt(canvas.handle,0,0,Width,Height,bmp.Canvas.handle,0,0,SRCAND);
canvas.Font.Color:=$0000FF;
SetBkMode(canvas.handle,TRANSPARENT);
for itmp:=0 to stmp.Count-1 do canvas.TextOut(5,5 itmp*canvas.TextHeight(stmp[itmp]),TrimRight(stmp[itmp]));
deletedc(ic);
bmp.free;
stmp.Free;
end;
tag:=poss.x 10;
timer1.Tag:=poss.y 10;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
self.BorderStyle:=bsNone;
Timer1:=TTimer.Create(self);
timer1.Interval:=300;
timer1.OnTimer:=Timer1Timer;
end;

end.

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:动态加载和动态注册类技术的深入探索

下一篇:Delphi的拨号连接类