[reqyz]

Доброго времени суток форумчане. Пытаюсь реализовать программу которая будет ловить пакеты сообщений передаваемых от программы на моём компе к серверу. программа явно многопоточная, перехват реализовываю следующим образом:

Код:

library mydll;

uses
  Windows,psapi,winsock,sysutils;

type
 OldCode = packed record
  One: dword;
  two: word;
 end;

far_jmp = packed record
  PuhsOp: byte;
  PushArg: pointer;
  RetOp: byte;
 end;

 TSocket=integer;
var
 hhPort:HWND;

 Jmp_Recv,Jmp_Send: far_jmp;
 Old_Recv,Old_Send: OldCode;
 Recv_Adr,Send_Adr: Pointer;
 FHandle:THandle;

 SendText:PChar=#13#10'Send ';
 RecvText:PChar=#13#10'Recv ';

Procedure Unhook();
var
 Bytes: dword;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, Recv_Adr, @Old_Recv, SizeOf(OldCode), Bytes);
  WriteProcessMemory(INVALID_HANDLE_VALUE, Send_Adr, @Old_Send, SizeOf(OldCode), Bytes);
end;

var
  sendok:boolean=false;
  recvok:boolean=false;

function New_Recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  Written:dword;
  i:integer;
  buf2:string;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, Recv_Adr,@Old_Recv, SizeOf(OldCode), Written);
  Result:=Recv(s,Buf,len,flags);
  {if(not recvok)then
  begin
    recvok:=true;
    ShowMessage('Recv');
  end;}
  if(len<30)then
  begin
    WriteFile(FHandle,RecvText^,7,Written,nil);
    WriteFile(FHandle,buf,Cardinal(len),Written,nil);
 { end
  else
  begin  
    buf2:=RecvText;
    for i:=0 to len-1 do
      buf2:=buf2+IntToStr(byte(Pointer(cardinal(@buf)+i)^))+' ';
    WriteFile(FHandle,buf2[1],length(buf2),Written,nil);//}
  end;
  WriteProcessMemory(INVALID_HANDLE_VALUE, Recv_Adr,@Jmp_Recv, SizeOf(far_jmp), Written);
  //
end;

function New_Send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  Written:dword;
  i:integer;
  buf2:string;
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, Send_Adr,@Old_Send, SizeOf(OldCode), Written);
  {if(not sendok)then
  begin
    sendok:=true;
    ShowMessage('Send');
  end;}
  if(len<30)then
  begin
    WriteFile(FHandle,SendText^,7,Written,nil);
    WriteFile(FHandle,buf,Cardinal(len),Written,nil);
  {end
  else
  begin
    buf2:=SendText;
    for i:=0 to len-1 do
      buf2:=buf2+IntToStr(byte(Pointer(cardinal(@buf)+i)^))+' ';
    WriteFile(FHandle,buf2[1],length(buf2),Written,nil);//}
  end;
  Result:=Send(s,Buf,len,flags);
  WriteProcessMemory(INVALID_HANDLE_VALUE, Send_Adr,@Jmp_Send, SizeOf(far_jmp), Written);
end;

//----------------------------------------------------------------------
//*******************************************************************************
Procedure SetHook();
var
 hkernel32: dword;
 Bytes: dword;
 s:string;
begin
//  if(LowerCase(ExtractFileName(ParamStr(0)))=AppName)then
  begin
    hkernel32 := GetModuleHandle('wsock32.dll');
    Recv_Adr:=GetProcAddress(hkernel32, 'recv');
    Send_Adr:=GetProcAddress(hkernel32, 'send');
    ReadProcessMemory(INVALID_HANDLE_VALUE, Recv_Adr, @Old_Recv, SizeOf(OldCode), Bytes);
    ReadProcessMemory(INVALID_HANDLE_VALUE, Send_Adr, @Old_Send, SizeOf(OldCode), Bytes);
    with Jmp_Recv do
    begin
      PuhsOp  := $68;
      PushArg := @New_Recv ;
      RetOp   := $C3;
    end;
    with Jmp_Send do
    begin
      PuhsOp  := $68;
      PushArg := @New_Send ;
      RetOp   := $C3;
    end;
    WriteProcessMemory(INVALID_HANDLE_VALUE, Recv_Adr, @Jmp_Recv, SizeOf(far_jmp), Bytes);
    WriteProcessMemory(INVALID_HANDLE_VALUE, Send_Adr, @Jmp_Send, SizeOf(far_jmp), Bytes);
    s:=ParamStr(0);
    FHandle:=CreateFile(PChar(s+'.log'),GENERIC_WRITE,0,nil,OPEN_ALWAYS,0,0);
    //ShowMessage(s);
  end;
end;
//*******************************************************************************

//*******************************************************************************
Function MessageProc(code : integer; wParam : word;
                    lParam : longint) : longint; stdcall;
begin
 CallNextHookEx(0, Code, wParam, lparam);
 Result := 0;
end;

var
  HookH:HHOOK=0;
  hMutex: dword=0;
  dwThreadId:Cardinal=0;

//*******************************************************************************
Procedure SetGlobalHookProc();
begin
 HookH:=SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, dwThreadId);
 Sleep(INFINITE);
end;
//*******************************************************************************

Procedure SetGlobalHook(TID:cardinal);
var
 TrId: dword;
begin
 dwThreadId:=TID;//ГЛАВНЫЙ ПОТОК НУЖНОЙ ПРОГРАММЫ
 hMutex := CreateMutex(nil, false, {'AdvareHook'}'java');
 if GetLastError = 0 then
  CreateThread(nil, 0, @SetGlobalHookProc, nil, 0, TrId)
 else
  CloseHandle(hMutex);
end;

//*******************************************************************************
procedure DLLEntryPoint(dwReason: DWord);
begin
  case dwReason of
    DLL_PROCESS_ATTACH: SetHook();
    DLL_PROCESS_DETACH: UnHook();
  end;
end;

procedure RemoveGlobalHook; stdcall;
begin
  if HookH<>0 then
  begin
    UnHookWindowsHookEx(HookH);
    CloseHandle(hMutex);
    HookH:=0;
  end;
end;

exports
  SetGlobalHook,RemoveGlobalHook;
//*******************************************************************************
begin
 DllProc := @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

библиотека запускается вызовом функции SetGlobalHook, в аргументах которой передаю главный поток нужного приложения

файл логов создается и что то даже записывается, но большая часть пакетов пропускается, грешу на многопоточность, в чём моя ошибка, не посылайте на литературу, не новичёк, а реально подскажите, заранее благодарен)