程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> QQ聊天記錄器演示程序

QQ聊天記錄器演示程序

編輯:Delphi

QQ聊天記錄器演示程序(可針對QQ2003和QQ2004版本)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

注:本篇沒有高手需要的內容(因為此文中的技術實在無新意可言,只是些簡單的實現),各位高手可以就此打住,若浪費寶貴時間,吾將深感不安.

   作者網站:http://asp.itdrp.com/hottey                                 ----------------hottey

   噓!好不容易有了一點輕松點的時候.現在才有時間把前幾天做的QQ聊天記錄器發上來和大家一起分享.做這個程序是看到最近網上有一個叫QQAutoReorder的軟件.它所實現的功能就是對QQ聊天記錄進行記錄.所采用的技術是:對QQ對話框進行掛鉤.它並不能對用戶沒有點擊的QQ消息進行記錄.(我認為若想對QQ消息進行實時記錄,意思就是不等QQ消息框出來就記錄下QQ的消息.可能只能去攔截QQ的數據封包了吧.我也花了一天時間在這上面,但最後的結論是’太自不量力了’^_^看來QQ的數據封包可不是那麼容易就能得到的L)

言歸正傳:本文采用對QQ消息框進行掛鉤了方法(一來比較容易實現,二來也是大多數此類程序通用的方法.)為了簡化程序:我將此程序分為兩部實現(均於QQ2004下實現,到最後在兼容QQ2003的版本):

一.   捕獲別人給自己發來的消息:

既然是掛鉤QQ的消息框,自然得從眾多的鉤子類型中找出一種最為合理,也最方便的.很容易想到的是無論你用什麼方式查看QQ的消息.總會導致一個QQ消息窗體的生成.就是會產生一個CREATE事件.從這一點上看,用一個WH_SHELL鉤子是比較明智的.

幫助上對WH_SHELL的說明是:監控Windows外殼通知消息,例如頂級窗口的創建的釋放.我們這裡要關心是窗口的創建消息.

由於有可能一次出現多個QQ消息窗口的情況,我在這裡使用全局鉤子:並定義以下數據結構:

HookType.Pas單元

unit HookType;

 

interface

 

uses

  Windows, Messages;

 

const

  WM_USERCMD   = WM_APP + 1;  //用戶自定應用程序級消息

  UC_WINCREATE  = WM_APP + 2;   //QQ消息窗口創建

  UC_WINDESTROY = WM_APP + 3;  //發送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:

//有頂級窗口創建時向演示程序發送自己定義消息WM_USERCMD. Wparamr參數說明

// 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;

 

{撤消鉤子過濾函數}

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.

 

//上述代碼對卸載鉤子沒有加太多說明,它不屬於此范圍討論之內.

 

演示程序代碼

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發來的自定義消息

      begin

      case wParam of

        UC_WINCREATE :         //QQ消息框創建

        begin

          GetText(Findhwd(HWND(lParam)));  //得到QQ消息框裡的文本

        end;

      end;

   end;

 end;

 inherited;

end;

 

//通過wParam參數找到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;

 

以上是我測試時的代碼,只是為了分類闡述的方便,才帖出來.也許還有些不合理的地方. 若這裡有什麼不詳盡之處,在下篇將提供完整代碼下載.

<SCRIPT src="http://home.ncust.edu.cn/count.php?id=hottey"></SCRIPT>

   

  hottey於2005-6-2                 網站:http://asp.itdrp.com/hottey

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved