Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 01.06.2017, 15:45   #1
ram555x
Пользователь
 
Регистрация: 08.02.2009
Сообщений: 16
По умолчанию Перехват WinSock Send и отмена отправки пакета

Добрый день, внедрил 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.
ram555x вне форума Ответить с цитированием
Старый 01.06.2017, 20:35   #2
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуйте закрывать сокет 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;

Последний раз редактировалось Aliens_wolfs; 01.06.2017 в 21:04.
Aliens_wolfs вне форума Ответить с цитированием
Старый 02.06.2017, 00:55   #3
ram555x
Пользователь
 
Регистрация: 08.02.2009
Сообщений: 16
По умолчанию

При закрытии сокета и очистки 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; то после первого пакета сразу вылет процесса.

Последний раз редактировалось ram555x; 02.06.2017 в 01:23.
ram555x вне форума Ответить с цитированием
Старый 02.06.2017, 17:04   #4
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

Попробуйте другим символом заполнять пакет
Код:
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;

Последний раз редактировалось Aliens_wolfs; 02.06.2017 в 17:15.
Aliens_wolfs вне форума Ответить с цитированием
Старый 02.06.2017, 19:46   #5
ram555x
Пользователь
 
Регистрация: 08.02.2009
Сообщений: 16
По умолчанию

Нет, не получается таким способом очищать/отклонять пакеты, а не знаешь есть такой сниффер в котором можно было б поставить временный запрет передачи пакетов указанного процесса, может такое никто и не реализовывал, типа только файерволы могут блокировать.
ram555x вне форума Ответить с цитированием
Старый 03.06.2017, 09:28   #6
Aliens_wolfs
Форумчанин
 
Регистрация: 16.12.2009
Сообщений: 902
По умолчанию

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

Можно сделать снифер DelphiPcap на WinPCap в нем вроде можно полностью управлять сетевыми пакетами
В интернете почитайте на эту тему.
Вложения
Тип файла: rar DelphiPcap 25-05-2005.rar (547.7 Кб, 30 просмотров)

Последний раз редактировалось Aliens_wolfs; 03.06.2017 в 18:20.
Aliens_wolfs вне форума Ответить с цитированием
Старый 04.06.2017, 02:10   #7
ram555x
Пользователь
 
Регистрация: 08.02.2009
Сообщений: 16
По умолчанию

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Отмена повторной отправки формы Tyoma5891 PHP 6 27.09.2013 18:19
[WinSock] Отправка пакета (#400 Bad request) zotox Работа с сетью в Delphi 0 15.07.2009 10:40
WinSock (send, recv) AidarBik Работа с сетью в Delphi 1 27.07.2008 15:22
Microsoft Office Outlook : Перехват письма при отправки с определенного ящика Talia Софт 0 11.12.2007 14:28
перехват отправления чужими программами отправки на печать документов Nat Win Api 7 20.04.2007 16:07