想做一个QQ消息记录器(100分)

  • 主题发起人 主题发起人 liveinwind
  • 开始时间 开始时间
L

liveinwind

Unregistered / Unconfirmed
GUEST, unregistred user!
功能如下:
1。可以实时的记录QQ号上的双方的聊天记录。
2。能够对拦截的消息进行本地保存和Email处理。
3。后台运行,自启动。
4。其他的还没想清楚。^_^

实现(我想的):
1。感觉如果要对QQ消息进行实时记录。就是说依据对方和自己发送消息时间的先后顺
序进行记录。就要求了不能使用钩子对窗口挂钩的方法来获得QQ聊天记录。想过是不是一
定要用拦截QQ数据包来实现呢!就是查看QQ数据包中表示聊天记录的数据来进行保存。而
这就关系到了HOOKAPI的问题了。
2。不过也有另一种方法,当有多个消息送来时,而我们不弹出QQ消息时,本地的QQ图
标也一直在闪烁,双击右下角的图标以后则按时间提取QQ记录到前台(证明了当时QQ聊天
记录一直在本地存放了下来,并且是按时间存放的)不知道用什么方法可以得到这些消息
内容并存盘呢!

不知道怎么才能实时记录QQ的聊天内容呢!望答!
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2385607
 
不是我要的!
 
能有什么好的方法吗????
   求助.
 
一. 捕获别人给自己发来的消息:

既然是挂钩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,'回讯息(&amp;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;



以上是我测试时的代码,只是为了分类阐述的方便,才帖出来.也许还有些不合理的地方. 若这里有什么不详尽之处,在下篇将提供完整代码下载.

hottey于2005-6-2 网站:http://asp.itdrp.com/hottey
 
多人接受答案了。
 
后退
顶部