Чужой SOCKET

Здравствуйте, возникла необходимость посылать данные из моего приложения в активное соединение другого приложения.

Примерная схема:
Есть три приложения: А - чужое, B - сервер и C - мое. А и B обмениваются данными друг с другом по протоколу TCP.
Приложению С (моему) нужно отправить пакет серверу B от имени A.

Насколько я знаю для этого мне нужно сделать send(sock,buf,buflen,0);
- где sock является дескриптором сокета из приложения A копированного через DuplicateSocket.

Проблема в том, как заполучить этот дескриптор.

Инжектирую DLL в которой HOOKаю send

Код (Text):

1. function SendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
2. var
3.   apph: HWND;
4.   source_handle,newhandle :HWND;
5. begin
6.   if Not Sended then Begin // это флаг который недает более 1 раза передавать S
7.     OpenProcess(PROCESS_ALL_ACCESS, FALSE, GetCurrentProcessId());
8.     apph:=FindWindow('TSimpleKraftForm',nil);
9.     apph:=SendMessage(apph,$04F0,Wparam(S),Lparam(S));
10.     Sended := True;
11.   end;
12.   result:=ConnectNextHook(s, Buf, len, flags);
13. end;

В приложении С получаем дескриптор

Код (Text):

1. ...
2.    procedure ReadMsg(var msg: TMessage); Message $04F0;
3. ...
4.  
5. function GetProcID(Names: String): cardinal;
6. var
7.   PHandle: THandle;
8.   ProcEntry: TProcessEntry32;
9.   lpName, Name: string;
10. begin
11.   Result:=0;
12.   Name:=UpperCase(Names);
13.   PHandle:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
14.   ProcEntry.dwSize:=sizeof(TProcessEntry32);
15.  
16.   if Process32First(PHandle, ProcEntry) then
17.   begin
18.     lpName:=ProcEntry.szExeFile;
19.     lpName:=UpperCase(lpName);
20.     if lpName=Name then
21.     Result:=ProcEntry.th32ProcessID;
22.   end;
23.  
24.   while Process32Next(PHandle,ProcEntry) do
25.   begin
26.     lpName:=ProcEntry.szExeFile;
27.     lpName:=UpperCase(lpName);
28.     if lpName=Name then
29.     Result:=ProcEntry.th32ProcessID;
30.   end;
31.   CloseHandle(PHandle);
32. end;
33.  
34. function GetPidFromHandle(Handle: Word): Dword;
35.   var ProcessInfo: PROCESS_BASIC_INFORMATION;
36. begin
37.    if ZwQueryInformationProcess(Handle, ProcessBasicInformation,
38.                                 @ProcessInfo,
39.                                 SizeOf(PROCESS_BASIC_INFORMATION),
40.                                 nil) = STATUS_SUCCESS
41.    then result := ProcessInfo.uUniqueProcessId else result := 0;
42. end;
43.  
44. function convertprocesssocket(oldsocket:Tsocket; source_pid:dword): HWND;
45. var
46.   source_handle,newhandle :HWND;
47. Begin
48.   source_handle := openprocess(process_all_access,false, source_pid);
49.   duplicatehandle(source_handle, oldsocket, getcurrentprocess(), @newhandle, 0, false,  duplicate_same_access);
50.   closehandle(source_handle);
51.   result := newhandle;
52.  
53. End;
54.  
55. procedure TMyForm.ReadMsg(var msg: TMessage);  // получение данных
56. var
57. apph : Cardinal;
58. begin
59.  
60.   apph:=GetProcID('Жертва.exe');
61.   SocketOfTarget := convertprocesssocket(msg.LParam,GetPidFromHandle(apph));
62. end;

Затем пробуем заслать пакет

Код (Text):

1.   WSAStartup(MAKEWORD(2,2), vwsadata);
2.   str2 := '3A 29 00 00 08 00 01 BD 57 00 00 B6 5C 04 00 ';
3.   Str := StrToBuf(Str2);
4.   send(SocketOfTarget,Str,15,0); // Сниффер даже этого непоказывает

Подскажите почему не могу отправить пакет от лица приложения А ?
Более месяца долюлю эту проблемму и ни на сантиметр на сдвинулся ((

 

Досмерти банальный вопрос: а что показывает отладчик? Ты убежден, что при копировании хендла в свой процесс ты передаешь верное значение? Убежден, что получил правильный PID процесса, что смог открыть процесс для дублирования?
Еще мне непонятно назначение функции GetPidFromHandle(Handle: Word). PID процесса ты получаешь в GetProcID. А что ты хотел добиться этой функцией - непонятно.

 

WSAStartup не нужен. WSA и так уже проинициализирована самой апликухой.

 

maksim_
Ну и причем тут это? Тупо выпендриться? Ты хоть понял, че я написал? Или просто так, набор букаф фставил?

 

Тут ты прав, я перемудрил. GetProcID вполне достаточно.

Если возможно, расскажите правильный механизм получения сокета и использования в моей проге

 

WSADuplicateSocket

 

Для начала, открой файл в отладчике (у делфи удобный встроенный отладчик) и посмотри, какая функция возвращает ошибку.
Кстати, по поводу WSAStartup - попробуй все-таки ее вызвать у себя. Я года 3 назад работал с перехватом чужих сокетов. Банального DuplicateHandle вполне хватало. Но были какие-то терки по поводу WSACleanup и т.д. Попробуй все-токи инициализировать данные

 

MSoft
ошибки нету, просто не работает данные не отсылаются
WSAStartup я вызываю у себя

Код (Text):

1. WSAStartup(MAKEWORD(2,2), vwsadata);
2.   str2 := '3A 29 00 00 08 00 01 BD 57 00 00 B6 5C 04 00 ';
3.   Str := StrToBuf(Str2);
4.   send(SocketOfTarget,Str,15,0); // Сниффер даже этого непоказывает

 

Так не бывает. Ошибка - это не только, когда креш и синий экран. Каждая функция возвращает определенный результат. В т.ч. сообщение об ошибке. Почитай про описание функций, посмотри, что они возращают.

У тебя с виду вполне рабочий код. Чтобы воспользоваться чужим сокетом, твоего кода достаточно. Если верить моим телепатическим способностям, то ты передаешь неверное значение в msg.LParam. Но делать за тебя я ничего не буду. Возьми млять в руки отладчик и посмотри, что происходит. Если ты передаешь неверный сокет в send, то она вернет 0 или -1. Что возвращает эта функция?

 

-1

 

Это кусок из инжектнутой длл

Код (Text):

1. function SendHookProc(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
2. var
3.   apph: HWND;
4.   source_handle,newhandle :HWND;
5. begin
6.   if Not Sended then Begin // это флаг который недает более 1 раза передавать S
7.     OpenProcess(PROCESS_ALL_ACCESS, FALSE, GetCurrentProcessId());
8.     apph:=FindWindow('TSimpleKraftForm',nil);
9.     apph:=SendMessage(apph,$04F0,Wparam(S),Lparam(S));
10.     Sended := True;
11.   end;
12.   result:=ConnectNextHook(s, Buf, len, flags);
13. end;

А от сюда невидно что я передаю

 

ну вот, а говоришь, что нет ошибки. А DuplicateHandle что вернула? А OpenProcess?

назначение этой строки совершенно непонятно... Т.е. процесс открываешь, а хендл даже не сохраняешь. Зачем же ты тогда открывал процесс?

 

да, не обратил внимания на этот код

 

Кстати, не совсем разбираясь в типах делфи, вынужден спросить: а разве lpName, Name: string; не должна быть типа PCHAR вместо стринг? И разве можно сравнивать строки через "=" вместо lstrcmpiA? Может, ты просто неверно получаешь PID (а точнее ааще его не получаешь) и потому не можешь открыть и продублировать хендл сокета?

 

app:=OpenProcess(PROCESS_ALL_ACCESS, FALSE, GetCurrentProcessId());
apph:=FindWindow('TSimpleKraftForm',nil);
Тут путаюсь в ДЛЛ
1. вариант apph:=SendMessage(apph,$04F0,S,GetCurrentProcessId());
2. вариант apph:=SendMessage(apph,$04F0,S,app);

А тут копирую сокет
SocketOfTarget := convertprocesssocket(msg.WParam,msg.LParam);

140 и True соответственно

 

От GetProcID я отказался, я передаю его также в SendMessage

 

зря. В своем процессе, если моя память мне ни с кем не изменяет, это чисто всегда -1. Проверь - если это так, тогда верни GetID свой. И хендл процесса ты тоже должен не передавать, а получать в своем процессе.

Короче, я больше ничем помочь не могу. Когда я кодил на асме - я просто открывал процесс, дублировал хендл (я руками его забивал - т.е. статический один и тот же). И опытный образец всегда работал нормально. Че у тебя не так - понятия не имею

 

Если учесть что в winsock2 это не обычные хендлы, а хендлы в собственной таблице, то да - ищите ошибки в коде дальше.

 

DuplicateHandle что-то копирует, но то что он выдает непохоже на TSoket
Попробую с WSADuplicateSocket

 

Единственный минус, я не умею с ней работать