¿Nadie se anima a "meter el dedo" en el código?
Bueno, yo sigo dándole un lavado de cara, quitando algunas cosas que sobraban y añadiendo algunas otras.
Ahora el objetivo es el FileZilla, es interesante ver como en una conexión FTP todo, incluso las contraseñas, se envían sin cifrar, mientras que usando FTPS todo se vuelve un revoltijo de bytes sin sentido.
El código de la dll:
Código Delphi
[-]
library HookIt;
uses
Windows,
Sysutils,
Messages,
Psapi,
ImageHlp,
winsock;
type
IMAGE_IMPORT_DESCRIPTOR = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
ForwarderChain: DWORD;
Name: DWORD;
FirstThunk: DWORD;
end;
PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
TWSABUF = record
len: u_long;
buf: PChar;
end;
PWSABUF = ^TWSABUF;
TSendFunc = function (s: TSocket; Buf: Pchar; len, flags: Integer): Integer; stdcall;
TRecvFunc = function (s: TSocket; Buf: Pchar; len, flags: Integer): Integer; stdcall;
TWSASendFunc = function(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
lpCompletionRoutine: Pointer): Integer; stdcall;
TWSARecvFunc = function(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
lpCompletionRoutine: Pointer): Integer; stdcall;
TBufType = (btSend, btRecv);
const
strTarget = 'C:\Archivos de programa\FileZilla\FileZilla.exe';
var
OldSend: TSendFunc;
OldRecv: TRecvFunc;
OldWSASend: TWSASendFunc;
OldWSARecv: TWSARecvFunc;
function BufToString(Buf: PChar; Len: Integer): String;
var
i: Integer;
begin
Result:= EmptyStr;
for i:= 1 to Len do
begin
if (Buf^ in [#32..#126]) then
Result:= Result + Buf^
else
Result:= Result + '.';
inc(Buf);
end;
end;
procedure SaveBuf(S: TSocket; Buf: PChar; Len: Integer; Tipo: TBufType);
var
Str: String;
begin
Str:= BufToString(Buf,len);
if Tipo = btSend then
Str:= Format('Send(%d): %s',[S,Str])
else if Tipo = btRecv then
Str:= Format('Recv(%d): %s',[S,Str]);
OutputDebugString(PChar(Str));
end;
function NewSend(s: TSocket; Buf: PChar; len, flags: Integer): Integer; stdcall;
begin
SaveBuf(s,Buf,len,btSend);
if @OldSend <> nil then
Result:= OldSend(s,Buf,len,flags)
else
Result:= SOCKET_ERROR;
end;
function NewRecv(s: TSocket; Buf: PChar; len, flags: Integer): Integer; stdcall;
begin
if @OldRecv <> nil then
Result:= OldRecv(s,Buf,len,flags)
else
Result:= SOCKET_ERROR;
if Result > 0 then
SaveBuf(s,Buf,Result,btRecv);
end;
function NewWSASend(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
lpCompletionRoutine: Pointer): Integer; stdcall;
var
i: DWORD;
P: PWSABUF;
begin
i:= dwBufferCount;
P:= lpBuffers;
while i > 0 do
begin
SaveBuf(s,P.Buf,P.len,btSend);
dec(i);
inc(P);
end;
if @OldWSASend <> nil then
Result:= OldWSASend(s,lpBuffers,dwBufferCount,lpNumberOfBytesSent,dwFlags,
lpOverlapped,lpCompletionRoutine)
else
Result:= SOCKET_ERROR;
end;
function newWSARecv(s: TSocket; lpBuffers: PWSABUF; dwBufferCount: DWORD;
lpNumberOfBytesSent: Pointer; dwFlags: DWORD; lpOverlapped: Pointer;
lpCompletionRoutine: Pointer): Integer; stdcall;
var
i: DWORD;
P: PWSABUF;
begin
if @OldWSARecv <> nil then
Result:= OldWSARecv(s,lpBuffers,dwBufferCount,lpNumberOfBytesSent,dwFlags,
lpOverlapped,lpCompletionRoutine)
else
Result:= SOCKET_ERROR;
if Result <> SOCKET_ERROR then
begin
i:= dwBufferCount;
P:= lpBuffers;
while i > 0 do
begin
SaveBuf(s,P.Buf,P.len,btRecv);
dec(i);
inc(P);
end;
end;
end;
function HookFunction(ModName, ProcName: PChar; Nuevo: Pointer): Pointer;
var
i: Integer;
hProcess: THandle;
hModules: array[0..1024] of HMODULE;
cbNeeded: DWORD;
hMod: HMODULE;
ImportDesc: PIMAGE_IMPORT_DESCRIPTOR;
Size: Cardinal;
szModName: PChar;
Thunk: PPointer;
MBI: MEMORY_BASIC_INFORMATION;
begin
Result:= nil;
hMod:= GetModuleHandle(ModName);
if hMod <> 0 then
begin
Result:= GetProcAddress(hMod, ProcName);
if Result <> nil then
begin
hProcess:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
FALSE, GetCurrentProcessId);
if hProcess <> 0 then
begin
if EnumProcessModules(hProcess, @hModules, Sizeof(hModules), cbNeeded) then
for i:= 0 to (cbNeeded div Sizeof(HMODULE)) - 1 do
begin
ImportDesc:= ImageDirectoryEntryToData(Pointer(hModules[i]),
TRUE, IMAGE_DIRECTORY_ENTRY_IMPORT, Size);
if ImportDesc <> nil then
begin
while ImportDesc.Name > 0 do
begin
szModName:= PChar(hModules[i] + ImportDesc.Name);
if StrIComp(szModName,ModName) = 0 then
begin
Thunk:= Pointer(hModules[i] + ImportDesc.FirstThunk);
while Thunk^ <> nil do
begin
if Thunk^ = Result then
begin
OutputDebugString(PChar(String(ProcName) + ': ' + 'Hookeado'));
VirtualQuery(Thunk,MBI,Sizeof(MEMORY_BASIC_INFORMATION));
VirtualProtect(MBI.BaseAddress,MBI.RegionSize,PAGE_READWRITE,
MBI.Protect);
Thunk^:= Nuevo;
VirtualProtect(mbi.BaseAddress,mbi.RegionSize,mbi.Protect,
MBI.Protect);
end;
inc(Thunk);
end;
end;
inc(ImportDesc);
end;
end;
end;
end;
end;
end;
end;
procedure Inject(LibPath: PChar); stdcall;
var
Procesos: array[1..1024] of DWORD;
Needed, i: DWORD;
Process, Thread: THandle;
ModName, Target: array[0..MAX_PATH] of Char;
RemLibPath: PChar;
ExitCode: Cardinal;
begin
FillChar(Target,Sizeof(Target),#0);
StrLCopy(Target,strTarget,Sizeof(Target)-1);
if EnumProcesses(@Procesos, SizeOf(Procesos), Needed ) then
begin
for i:= 1 to (Needed div Sizeof(DWORD)) do
begin
Process := OpenProcess(PROCESS_ALL_ACCESS, FALSE,Procesos[i]);
if Process <> 0 then
begin
if GetModuleFileNameEx(Process,0,ModName,SizeOf(ModName)-1) > 0 then
begin
if AnsiStrPos(ModName,Target) <> nil then
begin
RemLibPath:= VirtualAllocEx(Process, nil,StrLen(LibPath)+1,
MEM_COMMIT, PAGE_READWRITE);
if RemLibPath <> nil then
begin
if WriteProcessMemory(Process, RemLibPath, LibPath,
StrLen(LibPath),PDWORD(nil)^) then
begin
Thread:= CreateRemoteThread(Process, nil, 0,
GetProcAddress(GetModuleHandle('Kernel32'),'LoadLibraryA'),
RemLibPath, 0, PDWORD(nil)^);
if Thread <> 0 then
begin
WaitForSingleObject(Thread,INFINITE );
GetExitCodeThread(Thread,ExitCode);
CloseHandle(Thread);
end;
end;
VirtualFreeEx(Process,RemLibPath,StrLen(LibPath)+1,MEM_RELEASE);
end;
end;
end;
CloseHandle(Process);
end;
end;
end;
end;
procedure ProcessAttach; stdcall;
var
Process: THandle;
ModName: array[0..MAX_PATH] of Char;
Target: array[0..MAX_PATH] of Char;
begin
Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE,
GetCurrentProcessId);
if Process <> 0 then
begin
if GetModuleFileNameEx(Process, 0, ModName,SizeOf(ModName)-1) > 0 then
begin
FillChar(Target,Sizeof(Target),#0);
StrLCopy(Target,strTarget,Sizeof(Target)-1);
if AnsiStrPos(ModName,Target) <> nil then
begin
OldSend:= HookFunction('Ws2_32.dll','send',@NewSend);
OldRecv:= HookFunction('Ws2_32.dll','recv',@newRecv);
OldWSASend:= HookFunction('Ws2_32.dll','WSASend',@NewWSASend);
OldWSARecv:= HookFunction('Ws2_32.dll','WSARecv',@NewWSARecv);
end;
end;
CloseHandle(Process);
end;
end;
procedure ProcessDetach; stdcall;
begin
end;
procedure DLLEntryPoint(Reason: integer);
begin
case Reason of
Dll_Process_Detach: ProcessDetach;
Dll_Process_Attach: ProcessAttach;
end;
end;
exports
Inject;
begin
ProcessAttach;
DLLProc:= @DLLEntryPoint;
end.
Y por si alguien tiene curiosidad sobre lo que comentaba del ftp:
FTP normal:
Código:
00000000 0.00000000 [3420] send: Hookeado
00000001 0.00014471 [3420] send: Hookeado
00000002 0.00025730 [3420] recv: Hookeado
00000003 0.00033300 [3420] recv: Hookeado
00000004 0.00044000 [3420] WSASend: Hookeado
00000005 0.00054169 [3420] WSARecv: Hookeado
00000006 0.01691332 [3420] WSARecv: Hookeado
00000007 6.09645510 [3420] Recv(472): 220---------- Welcome to Pure-FTPd [TLS] ----------..220-You are user number 10 of 100 allowed...220-Local time is now 11:57. Server port: 21...220-This is a private system - No anonymous login..220 You will be disconnected after 15 minutes of inactivity...
00000008 6.10500622 [3420] Send(472): USER usuario..
00000009 6.20800686 [3420] Recv(472): 331 User usuario OK. Password required..
00000010 6.21136618 [3420] Send(472): PASS password..
00000011 7.68974400 [3420] Recv(472): 230-User usuario has group access to: usuario ..230 OK. Current restricted directory is /..
00000012 7.69142294 [3420] Send(472): SYST..
00000013 7.79814720 [3420] Recv(472): 215 UNIX Type: L8..
00000014 7.79918385 [3420] Send(472): FEAT..
00000015 7.90416002 [3420] Recv(472): 211-Extensions supported:.. EPRT.. IDLE.. MDTM.. SIZE.. REST STREAM.. MLST type*;size*;sizd*;modify*;UNIX.mode*;UNIX.uid*;UNIX.gid*;unique*;.. MLSD.. ESTP.. PASV.. EPSV.. SPSV.. ESTA.. AUTH TLS.. PBSZ.. PROT..211 End...
00000016 7.92951632 [3420] Send(472): PWD..
00000017 8.03565025 [3420] Recv(472): 257 "/" is your current location..
00000018 8.03662586 [3420] Send(472): TYPE A..
00000019 8.14296532 [3420] Recv(472): 200 TYPE is now ASCII..
00000020 8.14391899 [3420] Send(472): PASV..
00000021 8.25138378 [3420] Recv(472): 227 Entering Passive Mode (86,109,99,252,148,1)..
00000022 8.25234795 [3420] Send(472): LIST..
Y esto es FTPS:
Código:
00000000 0.00000000 [3444] send: Hookeado
00000001 0.00014499 [3444] send: Hookeado
00000002 0.00025925 [3444] recv: Hookeado
00000003 0.00033663 [3444] recv: Hookeado
00000004 0.00044447 [3444] WSASend: Hookeado
00000005 0.00057186 [3444] WSARecv: Hookeado
00000006 0.01196353 [3444] WSARecv: Hookeado
00000007 8.25035477 [3444] Recv(472): 220 Indy FTP Server ready...
00000008 8.25047493 [3444] Send(472): AUTH SSL..
00000009 8.27392101 [3444] Recv(472): 234 AUTH Command OK. Initializing SSL..
00000010 8.51114845 [3444] Send(472): .j....Q......9..8..5..............3..2../.............................@.....................>^...z....T..).Q
00000011 8.51255322 [3444] Recv(472): ._....../....0..+0...............j...0...*.H........0E1.0...U....AU1.0...U....Some-State1!0...U....Internet Widgits Pty Ltd0...070709185831Z..100708185831Z0E1.0...U....AU1.0...U....Some-State1!0...U....Internet Widgits Pty Ltd0\0...*.H.........K.0H.A...#...-..tyv.o....w....u.BC......:....&....}.P.":....9.2VI.X.s..........0..0...U......$.*$B...4.P.%..[.pHJ0u..U.#.n0l..$.*$B...4.P.%..[.pHJ.I.G0E1.0...U....AU1.0...U....Some-State1!0...U....Internet Widgits Pty Ltd.......j...0...U....0....0...*.H.........A.........'DQ....2..K..<.h|.*.8QT]..x<.... v.?...5d..0B..m.[.4..................@.......-#..UWB..-..0.E
00000012 8.51360226 [3444] Send(472): .R.......@...<.#$./d.!..Ji....C......+{}$....`..~.M.....\(.."...u%J..L...Uh.2N.....O.(........g..diz...?nsN.LgOS...9.B...<Z....
00000013 8.51596642 [3444] Recv(472): .(..R.....B..h+.Cx..(..../....S..V..z#......(.t....l.,....)P.....c.Ky$K.....5.Z.T..K8.