QQ聊天記錄器演示程序(可針對(duì)QQ2003和QQ2004版本)
注:本篇沒有高手需要的內(nèi)容(因?yàn)榇宋闹械募夹g(shù)實(shí)在無新意可言,只是些簡(jiǎn)單的實(shí)現(xiàn)),各位高手可以就此打住,若浪費(fèi)寶貴時(shí)間,吾將深感不安.
   作者網(wǎng)站:http://asp.itdrp.com/hottey
噓!好不容易有了一點(diǎn)輕松點(diǎn)的時(shí)候.現(xiàn)在才有時(shí)間把前幾天做的QQ聊天記錄器發(fā)上來和大家一起分享.做這個(gè)程序是看到最近網(wǎng)上有一個(gè)叫QQAutoReorder的軟件.它所實(shí)現(xiàn)的功能就是對(duì)QQ聊天記錄進(jìn)行記錄.所采用的技術(shù)是:對(duì)QQ對(duì)話框進(jìn)行掛鉤.它并不能對(duì)用戶沒有點(diǎn)擊的QQ消息進(jìn)行記錄.(我認(rèn)為若想對(duì)QQ消息進(jìn)行實(shí)時(shí)記錄,意思就是不等QQ消息框出來就記錄下QQ的消息.可能只能去攔截QQ的數(shù)據(jù)封包了吧.我也花了一天時(shí)間在這上面,但最后的結(jié)論是’太自不量力了’^_^看來QQ的數(shù)據(jù)封包可不是那么容易就能得到的L)
言歸正傳:本文采用對(duì)QQ消息框進(jìn)行掛鉤了方法(一來比較容易實(shí)現(xiàn),二來也是大多數(shù)此類程序通用的方法.)為了簡(jiǎn)化程序:我將此程序分為兩部實(shí)現(xiàn)(均于QQ2004下實(shí)現(xiàn),到最后在兼容QQ2003的版本):
一. 捕獲別人給自己發(fā)來的消息:
既然是掛鉤QQ的消息框,自然得從眾多的鉤子類型中找出一種最為合理,也最方便的.很容易想到的是無論你用什么方式查看QQ的消息.總會(huì)導(dǎo)致一個(gè)QQ消息窗體的生成.就是會(huì)產(chǎn)生一個(gè)CREATE事件.從這一點(diǎn)上看,用一個(gè)WH_SHELL鉤子是比較明智的.
幫助上對(duì)WH_SHELL的說明是:監(jiān)控Windows外殼通知消息,例如頂級(jí)窗口的創(chuàng)建的釋放.我們這里要關(guān)心是窗口的創(chuàng)建消息.
由于有可能一次出現(xiàn)多個(gè)QQ消息窗口的情況,我在這里使用全局鉤子:并定義以下數(shù)據(jù)結(jié)構(gòu):
HookType.Pas單元
unit HookType;
 
interface
 
uses
Windows, Messages;
 
const
WM_USERCMD = WM_APP + 1; //用戶自定應(yīng)用程序級(jí)消息
UC_WINCREATE = WM_APP + 2; //QQ消息窗口創(chuàng)建
UC_WINDESTROY = WM_APP + 3; //發(fā)送QQ消息
BUFFER_SIZE = 16 * 1024;
HOOK_MEM_FILENAME = 'MEM_FILE';
type
TShared = record
KeyHook : HHook; //鍵盤鉤子
ShellHook: HHook;
CallHook : HHook;
MainWnd : THandle; //窗體的Handle(非application.Handle)
Moudle : THandle; //DLL
end;
PShared = ^TShared;
 
implementation
end.
DLL單元代碼
var
MemFile: THandle;
Shared: PShared;
 
function ShellPRoc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case iCode of
HSHELL_WINDOWCREATED:
//有頂級(jí)窗口創(chuàng)建時(shí)向演示程序發(fā)送自己定義消息WM_USERCMD. Wparamr參數(shù)說明
// wParam specifies the handle of the window being created or destroyed, respectively.
PostMessage(Shared^.MainWnd,WM_USERCMD ,UC_WINCREATE,wParam);
end;
Result := CallNextHookEx(Shared^.ShellHook,iCode,wParam,lParam);
end;
 
function InstallHook:Boolean;
begin
Shared^.Moudle:=GetModuleHandle(PChar('qqhook')); //qqhook是我的DLL文件名.
Shared^.ShellHook := SetWindowsHookEx(WH_SHELL,
@ShellProc,
Shared^.Moudle,
0);
if Shared^.ShellHook = 0 then
begin
Result := False;
Exit;
end;
Result := true;
end;
 
{撤消鉤子過濾函數(shù)}
function UninstallHook: Boolean;
begin
Freelibrary(Shared^.Moudle);
Result:=UnHookWindowsHookEx(Shared^.ShellHook);
UnmapViewOfFile(Shared);
CloseHandle(memFile);
end;
 
procedure DllEntry(dwReason : integer);
begin
case dwReason Of
DLL_PROCESS_ATTACH:
begin
MemFile:= OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);
if MemFile = 0 then
MemFile := CreateFileMapping($FFFFFFFF,nil,
PAGE_READWRITE,
0,
SizeOf(TShared),
HOOK_MEM_FILENAME);
Shared := MapViewOfFile(MemFile,
File_MAP_WRITE,
0,
0,
0);
end;
DLL_PROCESS_DETACH:
begin
//UninstallHook;
end;
else;
end;
end;
 
 
exports
InstallHook;
 
begin
DllProc := @DllEntry;
DllEntry(DLL_PROCESS_ATTACH);
end.
 
//上述代碼對(duì)卸載鉤子沒有加太多說明,它不屬于此范圍討論之內(nèi).
 
演示程序代碼
procedure TForm1.Button1Click(Sender: TObject);
begin
InstallHook;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
MemFile:= OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);
if MemFile = 0 then
MemFile := CreateFileMapping($FFFFFFFF,nil,
PAGE_READWRITE,
0,
SizeOf(TShared),
HOOK_MEM_FILENAME);
Shared := MapViewOfFile(MemFile,
File_MAP_WRITE,
0,
0,
0);
Shared^.MainWnd := Handle; //保存窗體句柄
end;
 
//窗口消息處理過程
procedure TForm1.WndProc(var Msg: TMessage);
begin
with Msg do
begin
if Msg = WM_USERCMD then //DLL發(fā)來的自定義消息
begin
case wParam of
UC_WINCREATE : //QQ消息框創(chuàng)建
begin
GetText(Findhwd(HWND(lParam))); //得到QQ消息框里的文本
end;
end;
end;
end;
inherited;
end;
 
//通過wParam參數(shù)找到QQ窗口句柄
function TForm1.Findhwd(parent: HWND):HWND;
var
hwd,hBtn,hMemo:HWND;
begin
result := 0;
hwd:=findwindowex(parent,0,'#32770',nil); //QQ次級(jí)窗口句柄QQ2003及以前版本沒有此項(xiàng).
if (hwd<>0) then
begin
hBtn := FindwindowEX(hwd,0,nil,'回訊息(&R)'); //可以以此來證明是收到的QQ消息框.
if (hBtn<>0) then
begin
hMemo := GetDlgItem(hwd,$00000380); //RichEdit的句柄,QQ消息就存在于此處.
if (hMemo<>0) then
result := hMemo;
end;
end;
end;
 
//得到指定句柄控件中的文本.
procedure TForm1.GetText(hwd: HWND);
var
Ret: LongInt;
QQText: PChar;
Buf: integer;
begin
GetMem(QQText,1024);
if (hwd<>0) then
begin
try
Ret := SendMessage(hwd, WM_GETTEXTLENGTH, 0, 0) + 1;
Buf := LongInt(QQText);
SendMessage(hwd, WM_GETTEXT, Min(Ret, 1024), Buf);
memo1.Lines.Add(QQText); //在Memo中顯示文本
finally
FreeMem(QQText, 1024);
end;
end;
end;
 
以上是我測(cè)試時(shí)的代碼,只是為了分類闡述的方便,才帖出來.也許還有些不合理的地方. 若這里有什么不詳盡之處,在下篇將提供完整代碼下載.
hottey于2005-6-2 網(wǎng)站:http://asp.itdrp.com/hottey
新聞熱點(diǎn)
疑難解答
圖片精選
網(wǎng)友關(guān)注