Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Перехват и модификация исходящих tcp пакетов

Автор: lifer 30.5.2005, 14:22

Нужно в реальном времени изменять некоторые исходящие пакеты, передающиеся приложением.

Это выполнимо на Delphi ?

Автор: <Spawn> 31.5.2005, 05:13

Да, выполнимо - тебе нужно делать перехват winsock32 функций в нужном приложении и менять пакеты в сулчае необходимости. Темы такие были, так что используй поиск.

Автор: lifer 31.5.2005, 12:01

Я так понял что мне надо перехватывать ф-цию send. Я прав?

Автор: RA 31.5.2005, 13:56

Сразу дам пример перехвата входящих и исходящих пакетов.

необходим юнит madCodeHook из библы madCollection.
http://madshi.net/madCollection.exe

Внедрение hook.dll в нужный тебе процесс

Код



procedure TForm1.Button1Click(Sender: TObject);
var
  SInfo: TStartupInfo;
  PInfo: TProcessInformation;
begin
      ZeroMemory(@SInfo, SizeOf(TStartupInfo));
      ZeroMemory(@PInfo, SizeOf(TProcessInformation));
      SInfo.dwFlags := STARTF_USESHOWWINDOW;
      SInfo.wShowWindow := SW_SHOW;
      CreateProcess(PChar( Edit1.text ), nil, nil, nil, False, 0, nil, nil, SInfo, PInfo);
      Sleep(3000);
      // Лутше было бы использовать InjectLibrarySession но так как это пример перехвата а не внедрения то так ....
      InjectLibrary(PInfo.hProcess, IncludeTrailingPathDelimiter( ExtractFilePath(Application.ExeName) ) + 'hook.dll' );
end;

А вот так выглядит Hook.dll .

Код



library Hook;

uses
  Windows,
  Winsock,
  SysUtils,
  madCodeHook;

var
  sendNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  recvNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;

function recvHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
  Result := recvNextHook(s, Buf, len, flags);
end;

function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
  Result := sendNextHook(s, Buf, len, flags);
end;

procedure EntryPoint(Ac: dword); stdcall;
begin
  if Ac = DLL_PROCESS_ATTACH then
  begin
      HookCode(@send, @sendHookProc, @sendNextHook);
      HookCode(@recv, @recvHookProc, @recvNextHook);
  end;
end;

begin
  DLLProc := @EntryPoint;
  EntryPoint(DLL_PROCESS_ATTACH);
end.

ЗЫ: надеюсь принцип ясен.

Автор: Guest 2.6.2005, 16:57

Разобрался с madCollection...
Несколько вопросов:

1.

Код


CreateProcess(PChar( Edit1.text ), nil, nil, nil, False, 0, nil, nil, SInfo, PInfo);

Зачем запускать процесс?
У меня ведь будет уже запущенное приложение из которого надо будет перехватывать пакеты.

2.

Код


function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
  Result := sendNextHook(s, Buf, len, flags);
end;

Я так понял что при вызове ф-ции send будет выполняться сначала ф-ция sendHookProc. А в переменных s; var ; len, flags будет нужный мне пакет?

Автор: RA 2.6.2005, 17:47

Цитата(Guest @ 2.6.2005, 16:57)

Зачем запускать процесс?

Ну запуская процесс мы получаем TProcessInformation каторый потом используем для того что бы внедрить в чужой процесс свою dll. (просто так проще).

Ну если процесс уже запущен то внедряйся в запущенный процесс...
{Пример дать ?}

Цитата(Guest @ 2.6.2005, 16:57)

Я так понял что при вызове ф-ции send будет выполняться сначала ф-ция sendHookProc. А в переменных s; var ; len, flags будет нужный мне пакет?

Именно так.

Автор: haword 3.6.2005, 06:46

RAdmin
если не трудно тай примерчик внедрения smile

или вообщем инфу где насчет этого можно почитать? smile

Автор: RA 3.6.2005, 10:03

Цитата(haword @ 3.6.2005, 06:46)

если не трудно тай примерчик внедрения

Не трудно, только ты создай про это отдельную тему в разделе winapi или общие вопросы.
правила тут такие: один вопрос один топик. smile

Автор: lifer 5.6.2005, 12:30

Цитата

Ну запуская процесс мы получаем TProcessInformation каторый потом используем для того что бы внедрить в чужой процесс свою dll. (просто так проще).

Это понятно, только вот приложение при запуске через CreateProcess не хочет работать так, как нужно... так что лучше запускать его вручную...

Цитата

The function "InjectLibrary" is able to inject your DLL into any already running 32bit process. You can specify one specific target process or any of the special flags.

Можете привести небольшой примерчик по внедрению в конкретный процесс? а то в хелпе по MadCodeHook рассматривается внедрение во все работающие проуессы.

Автор: RA 5.6.2005, 13:13

Код


function GetProcessID (FileName: string) : DWORD;
var
 wnd1, wnd2 : THandle;
 Pe32 : TProcessEntry32;
 Me32 : TModuleEntry32;
  tmp  : boolean;
begin
  tmp := false;
 FileName := AnsiUpperCase(FileName);
 wnd1 := CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS, 0);
 Pe32.dwSize := SizeOf(pe32);
 Me32.dwSize := SizeOf(me32);
 if Process32First(wnd1, pe32) then
 repeat
   tmp:= FileName = AnsiUpperCase(pe32.szExeFile);
   if not tmp then
     if ExtractFileName(FileName) = AnsiUpperCase(ExtractFileName(pe32.szExeFile)) then
     begin
       wnd2 := CreateToolhelp32Snapshot (TH32CS_SNAPMODULE, pe32.th32ProcessID);
       if Module32First(wnd2, me32) then
       repeat
         if (FileName = AnsiUpperCase(me32.szExePath)) then
         begin
           tmp := true;
           Break;
         end;
       until not Module32Next(wnd2, me32);
       CloseHandle(wnd2);
     end;
   if tmp then
   begin
     Result :=  pe32.th32ProcessID;
   end;
 until not Process32Next(wnd1, pe32);
 CloseHandle (wnd1);
end;
InjectLibrary(GetProcessID('c:\myfile.exe'),'c:\myDll.dll'   );

Вроде так должно работать, но не проверял.

Автор: lifer 5.6.2005, 13:38

Код


Result := false;

[Error] Unit1.pas(34): Incompatible types: 'Cardinal' and 'Boolean'

тут что-то не так...

Автор: RA 5.6.2005, 14:05

Подредактировал, но всёравно не проверял.

Автор: Guest 6.6.2005, 16:01

Я уже сделал вот так:

Код


Function GetProcessId(exename:string):integer;
var
 hSnap:THandle; 
 pe:TProcessEntry32; 
 procid:integer;
 procexe:string; 
begin 
 pe.dwSize:=SizeOf(pe);
 hSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); 
 If Process32First(hSnap,pe) then begin
   While Process32Next(hSnap,pe) do begin 
   procexe:=pe.szExeFile;procid:=pe.th32processid;
   if uppercase(procexe)<>uppercase(exename) then continue;
   result:=procid; 
   closehandle(hSnap);
   exit;
   end;
 end;
 result:=0;
 closehandle(hSnap);
end;

Теперь буду разбираться с dll smile

Автор: RA 6.6.2005, 17:47

Цитата(Guest @ 6.6.2005, 16:01)

Я уже сделал вот так:

Окинув это своим взглядом я пришел к выводу, что такая модификация в XP приведёт к получению ID рандомного процесса имеющего сходное имя файла но другую директорию запуска.

Автор: lifer 6.6.2005, 17:50

Код


library hook;

uses
  Windows,
  Messages,
  Winsock,
  SysUtils,
  madCodeHook;

var
  sendNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  recvNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;

function recvHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
  Result := -1;
end;

function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
   Result := -1;
end;



begin
  HookCode(@send, @sendHookProc, @sendNextHook);
  HookCode(@recv, @recvHookProc, @recvNextHook);
end.

Захотел протестировать dll, по идее Result := -1; должен блокировать передачу данных. Я правильно понял?

Вот код инжекта в исполняемом файле:

Код


InjectLibrary(GetProcessID('mirc.exe'),IncludeTrailingPathDelimiter( ExtractFilePath(Application.ExeName) ) + 'hook.dll'   );

Такая конструкция у меня не работает smile

Причем ф-ция GetProcessID определяет ID нормально). hook.dll в каталоге тоже присутствует. Не подскажете в чем может быть проблема?

Цитата

У меня windows 2000 smile

Но тема не об этом. Эту функцию я доделаю, сейчас же у меня нету двух процессов с одинаковыми именами.

Автор: RA 6.6.2005, 21:33

lifer

Завтра приду домой всё проверю.

Автор: lifer 7.6.2005, 09:19

Цитата

Завтра приду домой всё проверю.

спасибо.

P.S. Извините что так много вопросов задаю, просто с темой перехвата API первый раз столкнулся.

Да, и еще, чем такая конструкция:

Код


HookCode(@send, @sendHookProc, @sendNextHook);

отличается от такой:

Код


HookAPI('wsock32.dll', 'send', @sendHookProc, @sendNextHook);

Автор: RA 7.6.2005, 12:42

HookAPI('wsock32.dll', 'send', @sendHookProc, @sendNextHook);

наложыт хук на функцию send в модуле wsock32.dll, тоесть получать мы будем весь трафик, а нам как я понял нужно только от конкретного процесса.

Цитата(lifer @ 6.6.2005, 17:50)

Захотел протестировать dll, по идее Result := -1; должен блокировать передачу данных. Я правильно понял?

Ну по идее так можно сделать, только чужое приложение будет ожидать таймаута если это поставить на sendHookProc.

Собсно вот прилагаю проверенный код внедрения с дллкой.

Автор: lifer 7.6.2005, 16:58

Спасибо большое за помощь, разобрался в вашем коде, теперь с помощью MadCodeHook SendIpcMessage сделал передачу данных между hook.dll и приложением.
Вроде проблема решена.

Если еще появятся вопросы я обращусь к вам.

Автор: RA 7.6.2005, 19:46

Обращайся. smile

Автор: lifer 9.6.2005, 15:46

Помогите найти ошибку.
Я перевожу данные, передаваемые приложением в hex-вид, для редактирования. Все работает, только при передаче вот таких данных:
89 00 00 00 1F A1 7B 0E 00
89 00 00 00 1F 20 95 0F 00
89 00 00 00 1F 07 C4 0F 00
89 00 00 00 1F FE F2 0F 00
89 00 00 00 1F FE F2 0F 00
89 00 00 00 1F E6 21 10 00

(смотрю с помощью commview)

получается вот это:
89 00 00 00 34 1D D2 14 34
89 00 00 00 34 1D D2 14 34
89 00 00 00 34 1D D2 14 34
89 00 00 00 34 1D D2 14 34
89 00 00 00 34 1D D2 14 34
89 00 00 00 34 1D D2 14 34

данные, не содержащие 00 00 00 обрабатываются корректно. Я наверное неправильно обрабатываю данные в строке Data := Copy (PChar(@Buf),1,len); ?

Вот код перевода в hex:

Код


function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
Data,ResData : string;
i : integer;
begin
   ResData := '';
   Data := Copy (PChar(@Buf),1,len);
   for i := 1 to len do
        begin
        ResData := ResData + IntToHex(Ord(Data[i]),2) + ' ';
        end;
   ShowMessage(ResData);
   
   Result := sendNextHook(s, Buf, len, flags);
end;

Автор: RA 10.6.2005, 22:10

Код


function InHex(Buffer: pointer; Length: Word): string;
var
  i: integer;
  HexBuf: string;
begin
  HexBuf := '';
  for Iterator := 0 to Length - 1 do
  begin
    HexBuffer := HexBuf + IntToHex(Ord(char(pointer(integer(Buffer) + i)^)), 2) + ' ';
  end;
  Result := HexBuf;
end;


function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  HexData: string;
  BufData: pchar;
begin


  Result := 0;

  GetMem(BufData, Result);


  try
    CopyMemory(BufData, @Buf, Result);
    BufData[0] := chr(10);
    BufData[1] := chr(20);
    BufData[2] := chr(30); 
    word(pointer(BufData)^) := 10; 
    dword(pointer(integer(BufData) + 2)^) := 20; 
    word(pointer(integer(BufData) + 6)^) := 30; 
    CopyMemory(@Buf, BufData, Result);
  finally
    FreeMem(BufData);
  end;


...............
  HexData := InHex(@Buf, Result);
................

  Result := sendNextHook(s, Buf, len, flags);
end;

Автор: lifer 11.6.2005, 12:37

Спасибо, только вот зачем вот этот кусок кода:

Код


 Result := 0;

  GetMem(BufData, Result);


  try
    CopyMemory(BufData, @Buf, Result);
    BufData[0] := chr(10);
    BufData[1] := chr(20);
    BufData[2] := chr(30); 
    word(pointer(BufData)^) := 10; 
    dword(pointer(integer(BufData) + 2)^) := 20; 
    word(pointer(integer(BufData) + 6)^) := 30; 
    CopyMemory(@Buf, BufData, Result);
  finally
    FreeMem(BufData);
  end;

У меня все работает вот так:

Код


function InHex(Buffer: pointer; Length: Word): string;
var
  i: integer;
  HexBuf: string;
begin
  HexBuf := '';
  for i := 0 to Length - 1 do
  begin
    HexBuf := HexBuf + IntToHex(Ord(char(pointer(integer(Buffer) + i)^)), 2) + ' ';
  end;
  Result := HexBuf;
end;

function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  HexData: string;
  BufData: pchar;
begin
  HexData := InHex(@Buf, len);
  ShowMessage(HexData);

  Result := sendNextHook(s, Buf, len, flags);
end;

Автор: RA 11.6.2005, 14:45

Цитата(lifer @ 11.6.2005, 12:37)

Спасибо, только вот зачем вот этот кусок кода:

Ну это модификаци, если конечно тебе это нужно. smile

Автор: Guest 11.6.2005, 15:14

Цитата

Ну это модификаци, если конечно тебе это нужно

А... ну тогда наверное должно быть так:

Код


CopyMemory(@Buf, BufData, Result); 
...
CopyMemory(BufData, @Buf, Result);

Мне нужно будет модифицировать пакеты вручную, для этого я и делаю перевод в Hex.

Автор: lifer 12.6.2005, 15:18

Цитата

А... ну тогда наверное должно быть так:

Ой, ошибся, вы были правы. я не туда глядел smile

Автор: Tosik 5.4.2010, 22:56

Тема хоть и старая, но вопрос актуальный. Есть желающие помочь разобраться с тем о чём говориться в теме?

Автор: Rennigth 6.4.2010, 00:36

А в чем вопрос-то? Проблемма в чем?

Автор: Tosik 6.4.2010, 08:46

Разбираю вот этот код
Присоединённый файл ( Кол-во скачиваний: 150 )
InjectandhookDll.rar 2,36 Kb
(Выложенный выше).

Нужно изменить все вот это

Код


procedure InjectTo(Dll,FileName:String);
var
  dll_to_inject: String;

  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
  ContinueLoop: BOOL;
  hp: Thandle;
begin
  GetDebugPrivs;
  dll_to_inject := Dll;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  While ContinueLoop do
  begin
    If LowerCase(FProcessEntry32.szExeFile) = LowerCase(FileName) then
    begin
      InjectDllToTarget(dll_to_inject, FProcessEntry32.th32ProcessID, @InjectedProc, 1000);
      Break;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);  
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 InjectTo(ExtractFilePath(ParamStr(0)) + 'Hook.dll',Edit1.text);
end;

end.

На то чтобы, по нажатию проверялось CRC файла, если совпадает exe'шка запускается и внедряется dll .

Также желательно примерчик, как шифровать трафик в dll, ну и вообще интересует как можно зашифровать трафик, чтобы потом его расшифровать сервером.

Автор: KotJ 16.4.2010, 12:02

Код библиотеки :

Код


library Hook;

uses
  Windows,
  Winsock,
  SysUtils,
  madCodeHook;

var
  sendNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  sendtoNextHook: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;

function sendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var f:file;
begin
  AssignFile(f,'h:\\text.txt');
  Rewrite(f);
  CloseFile(f);
  Result := sendNextHook(s, Buf, len, flags);;
end;

function sendtoHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var f:file;
begin
  AssignFile(f,'h:\\text.txt');
  Rewrite(f);
  CloseFile(f);
  Result := sendtoNextHook(s, Buf, len, flags);;
end;

begin
  //HookAPI(PChar('c:\\WINDOWS\\system32\\WSOCK32.DLL'), PChar('send'), @sendHookProc, @sendNextHook);
  //HookAPI(PChar('c:\\WINDOWS\\system32\\WSOCK32.DLL'), PChar('sendto'), @sendtoHookProc, @sendtoNextHook);
  HookCode(@send, @sendHookProc, @sendNextHook);
  HookCode(@sendto, @sendtoHookProc, @sendtoNextHook);
end.

библиотека внедряется в оперу, файл внедряемой библиотеки не удаляется, я так полагаю что это признак что нормально внедрилась.
Но при лазании по Инету, никаких файлов не создается, хотя по идее должно?
Что я делаю не так? не могу никак понять.. пробовал и HookCode и HookAPI..

Автор: KotJ 16.4.2010, 12:48

Код


HookAPI(PChar('c:\\WINDOWS\\system32\\WS2_32.DLL'), PChar('WSASend'), @sendHookProc, @sendNextHook);
HookAPI(PChar('c:\\WINDOWS\\system32\\WS2_32.DLL'), PChar('WSASendTo'), @sendtoHookProc, @sendtoNextHook);

Исправил на это файл создался.
Но..
некоторые ресурсы не загружаются. Некоторые загружаются. Почему?

Автор: UFO007 16.7.2013, 22:31

Доброго всем времени суток!
Попалась как-то (на хакер.ру что-ли) статейка как продвинуть собственный сайт, т. е.: при гуглении "футбол" первым из "примерно 30 500 результов" браузеру подсовывается "... наши футболисты ...." ну и соответсвенно ссылочка на www.ufo_007.com(например). С обработкой текста проблем нет, а вот с перехватом трафика... В статье воспевается advAPIHook но тут я чо-то слегонца недопонял - вернее не стал разбираться т. к. подвернулось следующее:

Код

library AppSniffDll;

uses
  // madshi components
  madRemote,
  madCodeHook,
  madStrings,

  // windows units
  Windows, Winsock, SysUtils, Messages;

{$I defs.inc}

{$R *.RES}

var
  sendNextHook            : function(s: TSocket; Buf : Pointer; Len, Flags: Integer): Integer; stdcall;
  recvNextHook            : function(s: TSocket; Buf : Pointer; Len, Flags: Integer): Integer; stdcall;
  sendtoNextHook          : function(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr;  tolen: Integer): Integer; stdcall;
  recvfromNextHook        : function(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
  wsasendNextHook         : function(s: TSocket; lpBuffers : LPWSABUF; dwBufferCount : DWORD; var lpNumberOfBytesSent : DWORD; dwFlags : DWORD; lpOverlapped : LPWSAOVERLAPPED; lpCompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE ): Integer; stdcall;
  wsarecvNextHook         : function(s: TSocket; lpBuffers : LPWSABUF; dwBufferCount : DWORD; var lpNumberOfBytesRecvd : DWORD; var lpFlags : DWORD; lpOverlapped : LPWSAOVERLAPPED; lpCompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE ): Integer; stdcall;
  closesocketNextHook     : function(s: TSocket): Integer; stdcall;
  listenNextHook          : function(s : TSocket; backlog : integer): integer; stdcall;
  gethostbynameNextHook   : function(name : PChar): PHostEnt; stdcall;

  ClientWindow : integer;
  showmsgbox : boolean = false;

procedure SendMsg(msg : TIPCMessage);
begin
  msg.Pid  := GetCurrentProcessID;
  SendIpcMessage('AppSniff', @msg, sizeOf(msg));
end;
...
function recvHookProc(s: TSocket; Buf : Pointer; Len, Flags: Integer): Integer; stdcall;
var      msg    : TIPCMessage;
         size   : Integer;
         saddr  : TSockAddrIn;
         slen   : Integer;
begin
  if showmsgbox then MessageBox(0, 'recv', 'info', 0);
  //call the real winsock function
  Size := recvNextHook(s, Buf, Len, Flags);
  if Size > 0 then // send message to user interface
   begin
     msg.Operation := OT_Recv;
     msg.Sock      := s;
     msg.Size      := Size;
     msg.Address   := Cardinal(Buf);
     msg.IP        := 0;
     msg.Port      := 0;
     msg.HostName  := '';
     sLen := sizeof(TSockaddrIn); // figure out the ip and port for the communication
     if GetPeerName(s, saddr, sLen) = 0 then
      begin
        move(saddr.sin_addr, msg.IP, sizeof(Cardinal));
        msg.Port := ntohs(saddr.sin_port);
      end;
     SendMsg(msg);
   end;
  Result := Size;
end;

function sendHookProc(s: TSocket; Buf : Pointer; Len, Flags: Integer): Integer; stdcall;
var      msg    : TIPCMessage;
         saddr  : TSockAddrIn;
         slen   : Integer;
begin
  if showmsgbox then MessageBox(0, 'send', 'info', 0);
  if Len > 0 then // send message to user interface
   begin
     msg.Operation := OT_Send;
     msg.Sock      := s;
     msg.Size      := Len;
     msg.Address   := Cardinal(Buf);
     msg.IP        := 0;
     msg.Port      := 0;
     msg.HostName  := '';// figure out the ip and port for the communication
     sLen := sizeof(TSockaddrIn); 
     if GetPeerName(s, saddr, sLen) = 0 then
      begin
        move(saddr.sin_addr, msg.IP, sizeof(Cardinal));
        msg.Port := ntohs(saddr.sin_port);
      end;
     SendMsg(msg);
   end;
  Result := sendNextHook(s, Buf, Len, Flags);//call the real winsock function
end;
...
procedure InitDll(_ClientWindow : integer); stdcall;
begin
  ClientWindow := _ClientWindow;
  OutputDebugString(PChar('ClientWindow is ' + IntToStr(ClientWindow)));
end;

exports
  InitDll;

begin
  showmsgbox := PosText('Mailtest.exe', ParamStr(0)) > 0;
  if showmsgbox then
   MessageBox(0, 'am in mailtest.exe', 'info', 0);
  ClientWindow := 0;
  CollectHooks;
  hookapi('ws2_32.dll',  'listen', @listenHookProc, @listenNextHook);
  hookapi('ws2_32.dll',  'gethostbyname', @gethostbynameHookProc, @gethostbynameNextHook);
  hookapi('ws2_32.dll',  'closesocket', @closesocketHookProc, @closesocketNextHook);
  hookapi('ws2_32.dll',  'send', @sendHookProc, @sendNextHook);
  hookapi('ws2_32.dll',  'recv', @recvHookProc, @recvNextHook);
  hookapi('ws2_32.dll',  'WSASend', @WSASendHookProc, @WSASendNextHook);
  hookapi('ws2_32.dll',  'WSARecv', @WSARecvHookProc, @WSARecvNextHook);
  hookapi('ws2_32.dll',  'sendto', @sendtoHookProc, @sendtoNextHook);
  hookapi('ws2_32.dll',  'recvfrom', @recvfromHookProc, @recvfromNextHook);
  FlushHooks;
end.

и в самом AppSniff - Main.pas такая процедурка:

Код

procedure TMainForm.HandleMessage(var Message: TMessage);
var  msg        : TIPCMessage;
     Buffer     : array[0..MAX_PATH] of Char;
     Proc, i    : Cardinal;
     BytesRead  : Cardinal;
     DataBytes  : PByteArray;
     inaddr     : in_addr;
     AppName    : string;
     Proto      : string;
     FullPath   : string;
     RemoteIP   : string;
     RemotePort : string;
     DataStr    : string;
     Oper       : string;
     DbgMsg     : string;
     Color      : TColor;
     ConnIndex  : integer;
     StatIndex  : integer;
begin
  if Message.wParam <> 777 then
   begin
     Message.Result := 0;
     Exit;
   end;
  // process data
  Move(pointer(Message.lParam)^, msg, sizeOf(Msg));
  ReplyMessage(1);
  // not interested in 1 byte messages
  if msg.Size = 1 then
   Exit;
  // prepare processname
  ProcessIdToFilename(msg.Pid, Buffer);
  AppName  := ExtractFileName(Buffer);
  FullPath := Process(AppName).ExeFile;
  DbgMsg   := AppName;
  // extract data from message
  DataStr := '';
  if (msg.Operation = OT_Send) or (msg.Operation = OT_WSASend) or (msg.Operation = OT_Recv) or (msg.Operation = OT_WSARecv) or (msg.Operation = OT_SendTo) or (msg.Operation = OT_RecvFrom) then
   begin
     if msg.Size > 0 then
      begin
        GetMem(DataBytes, msg.Size);
        // open remote process
        Proc := OpenProcess(PROCESS_VM_READ, False, msg.Pid);
        // check result
        if Proc > 0 then
         begin
           if ReadProcessMemory(Proc, Pointer(msg.Address), DataBytes, msg.Size, BytesRead) then
            begin
              msg.Size := BytesRead;
              for i:=0 to msg.Size - 1 do
              DataStr := DataStr + Chr(DataBytes[i]);
            end;
            // close handle to process
            CloseHandle(Proc);
         end;
         FreeMem(DataBytes);
      end;
   end;
  DbgMsg := DbgMsg + ', size=' + IntToStr(msg.size);
  DbgMsg := DbgMsg + ', sock=' + IntToStr(msg.sock);
  RemoteIP := ''; - далее идёт добыча txt.данных для ВиртуалТриВью и 3-х РичЕдитов

Так вот - по поводу вышеизложенного вопрос: можно ли отправить ДЛЛке ответ? Что-то в роде:

Код

procedure TMainForm.HandleMessage(var Message: TMessage);
...
SendIpcMessage('AppSniffDll', @msg, sizeOf(msg));
...
а в ДЛЛке:
procedure HandleMessage(var Message: TMessage);

Ведь она ( ДЛЛка) при отправке заложила msg.Pid Оперы или она перехватит сообщение? Если "Да", то как порвать "мосты" (параллелного прослушивания): убрать recvNextHook и Опера оглохнет - вот тут как я соображаю и нужно ответное сообщение с полученными и обработанными данными ну и убрав sendNextHook проверить ответ оперы и отослать его получателю (за ислючением - если юзер тыкнет на www.ufo_007.com которого не существует). Или я заблуждаюсь? - Дык поправьте, наставьте на путь истинный. И заранее - спасибо за любую инфу вплоть до банального перечня процедур и функций из которых можно вылепить нечто подобное необходимому.