Перехват WinSock Send и отмена отправки пакета

[ram555x]

Добрый день, внедрил dll в нужный процесс для анализа трафика, установил хук на функцию Send чтобы контролировать передающиеся пакеты,

var
 TwsSend: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
 
HookProc('WS2_32.dll', 'send', @NewSend, @TwsSend);
 
function NewSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
   if blockpacket
     then result:=-1
   else
     Result := TwsSend(s, Buf, len, flags);
end;

Вот если я задам blockpacket:=true и процесс выполнит передачу пакетов то они блокируются и не передаются на сервер как нужно, но после этого если установлю blockpacket:=false то все эти блокированные пакеты разом передаются на сервер, получается блокированные пакеты накапливались и потом отправились одним пакетом, каким образом можно очистить эту очередь или правильно отменять их, чтобы запретить так запретить отправку пакетов когда blockpacket=true.

[Aliens_wolfs]

Попробуйте закрывать сокет closesocket(S);
если закрывать не нужно то можно попробовать подмену Buf сделать, тогда принимающая сторона непоймет
Из вашего кода

function NewSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
   if blockpacket then
   FillChar(Buf^, Len, 0);//Заполняем buf
   Result := TwsSend(s, Buf, len, flags);
end;

Ну или Buf правильно уничтожать в памяти, что бы не накапливались пакеты примерно так

function NewSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
   if blockpacket then 
begin
Buf:= GlobalAllocPtr(GMEM_MOVEABLE, 0);// меняем размер Buf глобально
result:=-1;
end
   else
     Result := TwsSend(s, Buf, len, flags);
end;

[ram555x]

При закрытии сокета и очистки buf вашим способом сразу соединение рвется когда убираю блокировку пакетов, скорее всего сервер из за неверных пакетов сразу отключает клиента, а если попробовать не обнулять пакет, а сделать его таким который по умолчанию отправляется раз в 1-2минуты, я его заранее сохранил в файл как массив байт, считываю так

var
  h: THandle;
  realSize: DWORD;
  Size: cardinal;
  mybuf: array of byte;
begin
h := CreateFile('buf', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (INVALID_HANDLE_VALUE <> h) then
    try
      Size := GetFileSize('buf');
      SetLength(mybuf, Size);
      ReadFile(h, mybuf[0], Size, realSize, nil);
    finally
      CloseHandle(h);
    end;
end;

Вот в mybuf хранится этот пакет, и как правильно будет точную копию его занести в адрес buf?
Чтобы в mybuf занести я делаю так

SetLength(mybuf, len);
Move(addr(Buf)^, mybuf[0], len);
Result := TwsSend(s, myBuf, len, flags)

Отправляю и всё хорошо, а вот как обратно потом не въеду, по разному пробовал связь обрывалась, во первых нужно изменить размер buf, а он не меняется, выдает
ошибку Incompatible types если SetLength(buf, 18);
Если сам buf объявить как Buf:array of byte; то после первого пакета сразу вылет процесса.

[Aliens_wolfs]

Попробуйте другим символом заполнять пакет

function NewSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
begin
   if blockpacket then
   FillChar(Buf^, Len, '$');//Заполняем buf
   Result := TwsSend(s, Buf, len, flags);
end;

во первых нужно изменить размер buf, а он не меняется, выдает
ошибку Incompatible types если SetLength(buf, 18);
Если сам buf объявить как Buf:array of byte; то после первого пакета сразу вылет процесса.

Все верно что ошибка вы так размер не измените.

Можно еще попробовать так размер поменять

function NewSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
var
  h: THandle;
  realSize: DWORD;
  Size: cardinal;
begin
   if blockpacket then
begin
h := CreateFile('buf', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (INVALID_HANDLE_VALUE <> h) then
    try
      Size := GetFileSize('buf');

     //Меняем размер Buf ===========================
      Buf:= GlobalAllocPtr(GMEM_MOVEABLE and GMEM_ZEROINIT, Size);
    либо
      Buf:= AllocMem(Size);
    //=========================================

      ReadFile(h, Buf^, Size, realSize, nil);
    finally
      CloseHandle(h);
    end;
end;
      Result := TwsSend(s, Buf, len, flags);
end;

[ram555x]

Нет, не получается таким способом очищать/отклонять пакеты, а не знаешь есть такой сниффер в котором можно было б поставить временный запрет передачи пакетов указанного процесса, может такое никто и не реализовывал, типа только файерволы могут блокировать.

[Aliens_wolfs]

Какие запреты пытаетесь сделать, случайно не для HTTP?

Можно сделать снифер DelphiPcap на WinPCap в нем вроде можно полностью управлять сетевыми пакетами
В интернете почитайте на эту тему.

[ram555x]

Запреты хочу реализовать пакетов проходящих через socket tcp send, чтоб в нужный момент они не доходили до сервера.
Я кучу библиотек и демок перелопатил по снифферству, по инету для делфи в основном старые исходники попадаются толком уже не работающие для нынешних систем, или для новых редакций делфи, единственно что путного находил тут
http://www.overbyte.eu
http://www.magsys.co.uk/delphi/magmonsock.asp
связанного с драйвером что советуешь WinPCap
Но исходник компилируется с ошибкой получения списка доступных сетевых адаптеров, 12лет таки прошло)
Aliens_wolfs благодарю за оказанную помощь, наверно откажусь от этой затеи с перехватом, думал что обойдусь внедрением dll`ки а не всё так просто, вникать в WinPCap не стану, просто это ж придется драйвер ставить пользователям, скорее еще права админа потребуются для корректной работы, да и я тем более не системный программист чтобы во все эти тонкости вникать.