明輝手游網(wǎng)中心:是一個免費提供流行視頻軟件教程、在線學(xué)習(xí)分享的學(xué)習(xí)平臺!

QQ聊天記錄器演示程序(一)

[摘要]注:本篇沒有高手需要的內(nèi)容,因為此文中的技術(shù)實在無新意可言,只是些簡單的實現(xiàn)(可針對QQ2003和QQ2004版本),各位高手可以就此打住,若浪費寶貴時間,吾將深感不安。 作者網(wǎng)站:http://asp.itdrp.com/hottey 噓!好不容易有了一點輕松點的時候.現(xiàn)在才有時間把...

注:本篇沒有高手需要的內(nèi)容,因為此文中的技術(shù)實在無新意可言,只是些簡單的實現(xiàn)(可針對QQ2003和QQ2004版本),各位高手可以就此打住,若浪費寶貴時間,吾將深感不安。   作者網(wǎng)站:http://asp.itdrp.com/hottey
     噓!好不容易有了一點輕松點的時候.現(xiàn)在才有時間把前幾天做的QQ聊天記錄器發(fā)上來和大家一起分享.做這個程序是看到最近網(wǎng)上有一個叫QQAutoReorder的軟件.它所實現(xiàn)的功能就是對QQ聊天記錄進行記錄.所采用的技術(shù)是:對QQ對話框進行掛鉤.它并不能對用戶沒有點擊的QQ消息進行記錄.(我認(rèn)為若想對QQ消息進行實時記錄,意思就是不等QQ消息框出來就記錄下QQ的消息.可能只能去攔截QQ的數(shù)據(jù)封包了吧.我也花了一天時間在這上面,但最后的結(jié)論是’太自不量力了’^_^看來QQ的數(shù)據(jù)封包可不是那么容易就能得到的L)   言歸正傳:本文采用對QQ消息框進行掛鉤了方法(一來比較容易實現(xiàn),二來也是大多數(shù)此類程序通用的方法.)為了簡化程序:我將此程序分為兩部實現(xiàn)(均于QQ2004下實現(xiàn),到最后在兼容QQ2003的版本):  一.   捕獲別人給自己發(fā)來的消息:  既然是掛鉤QQ的消息框,自然得從眾多的鉤子類型中找出一種最為合理,也最方便的.很容易想到的是無論你用什么方式查看QQ的消息.總會導(dǎo)致一個QQ消息窗體的生成.就是會產(chǎn)生一個CREATE事件.從這一點上看,用一個WH_SHELL鉤子是比較明智的.  幫助上對WH_SHELL的說明是:監(jiān)控Windows外殼通知消息,例如頂級窗口的創(chuàng)建的釋放.我們這里要關(guān)心是窗口的創(chuàng)建消息.  由于有可能一次出現(xiàn)多個QQ消息窗口的情況,我在這里使用全局鉤子:并定義以下數(shù)據(jù)結(jié)構(gòu):


HookType.Pas單元unit HookType;interfaceuses  Windows, Messages;
const  WM_USERCMD   = WM_APP + 1;  //用戶自定應(yīng)用程序級消息  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;implementationend.DLL單元代碼


var  MemFile: THandle;  Shared: PShared;function ShellProc(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;begin  case iCode of    HSHELL_WINDOWCREATED://有頂級窗口創(chuàng)建時向演示程序發(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. 
 //上述代碼對卸載鉤子沒有加太多說明,它不屬于此范圍討論之內(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次級窗口句柄QQ2003及以前版本沒有此項.    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; 
以上是我測試時的代碼,只是為了分類闡述的方便,才帖出來.也許還有些不合理的地方. 若這里有什么不詳盡之處,在下篇將提供完整代碼下載.