unit TProxiUnit;

interface
uses Windows,Winsock;
function GetTextBetweenTags(headers: PChar): string;
function GetIP(Host: String): string;
type
   TPROXI = class
     private
       WS:TwsaData;
     public
       Sock: TSocket;
       hAddr: TSockAddr;
       Host         :PChar;
       Port         :Word;
       Data: Pointer;

       constructor Create(Port_: Word);
       procedure Send_(Date: Pointer);
       Procedure Recv_;
       destructor destroy;
   end;

implementation

function GetIP(Host: String): string;
type
     TaPInAddr = array [0..10] of PInAddr;  
     PaPInAddr = ^TaPInAddr;  
var  
     phe  : PHostEnt;  
     pptr : PaPInAddr;  
     Buffer : array [0..63] of char;  
     I    : Integer;  
     GInitData      : TWSADATA;  
begin  
     WSAStartup(MakeWord(2,0), GInitData);
     Result := '';     //не найден!  
     ZeroMemory(@Buffer, SizeOf(Buffer));  
     lstrcpy(Buffer, PChar(Host));
     phe :=GetHostByName(buffer);  
     if phe = nil then begin  
       WSACleanup;  
       Exit;  
     end;  
     try  
       pptr := PaPInAddr(Phe^.h_addr_list);  
       I := 0;  
       while pptr^[I] <> nil do begin  
         result:=PChar(inet_ntoa(pptr^[I]^));  
         Inc(I);  
       end;  
     finally  
       WSACleanup;  
     end;  
end;

function GetTextBetweenTags(headers: PChar): string;
const ctrf = #13#10;
Var i,j: integer;
begin
   Result:='';
   i:= Pos('Host:',headers)+5;
   if i <6 then
     Exit;
   j:=i;
   repeat
     Result:=Result+Headers[j];
     Inc(j);
   until headers[j] = #13;
end;

Procedure Colors(Red: boolean);
Var hCon: DWORD;
begin
   hCon := GetStdHandle(STD_OUTPUT_HANDLE);
   if Red then
     SetConsoleTextAttribute(hCon, 7)  else
     SetConsoleTextAttribute(hCon, 3);
end;

procedure THREAD(P :Pointer); stdcall;
const PPORT = 80;
       ctrf = #13#10;
Var Ns: TSocket;
     i,j: integer;
     Data,Tmp: array[0..8*MAX_PATH] of char;

     addr: TSockAddr;
     Snd: TSocket;
     host: string;
     Str: string;
     //TimeVal: TTimeVal;
     //FDSet: TFDSet;
begin
   Ns:=TSocket(P);
   WriteLn(Ns);
{  FD_ZERO(FDSet);
   FD_SET(Ns, FDSet);
   TimeVal.tv_sec := 0;
   TimeVal.tv_usec := 500;
   ioctlsocket(Ns,FIONREAD,i);}
   while true do
   begin
     Str:='';
     i:=1;
     while i>0 do
     begin                    //Читаю данные с клиента
       ZeroMemory(@Data,SizeOf(Data));
       i:=recv(Ns,Data,SizeOf(Data),0);
       Str:=Str+Data;
     end;
     WriteLn(Str);
     host:=GetTextBetweenTags(PChar(Str));
     host:=GetIP(host);                          //Определил IP куда хотел подконектиться клиент
                 Addr.sin_family:=PF_INET;
                 Addr.sin_port:=htons(PPORT);
                 Addr.sin_addr.S_addr:=inet_addr(PChar(host));
                 Snd := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
                 if connect(Snd,addr,SizeOf(Addr)) = 0 then
                 begin
                   j:=1;
                   while j>0 do
                     j:=send(Snd,Str[1],Length(Str),0);          //Посылаю вопрос серверу
                   Str:='';
                   j:=1;                    //Читаю ответ с сервера
                   while j>0 do
                   begin
                     ZeroMemory(@Tmp,SizeOf(Tmp));
                     j:=recv(Snd,Tmp,SizeOf(Tmp),0);
                     Str:=Str+Tmp;
                   end;
                 end;
     i:=1;
     while i>0 do
       i:=send(Ns,Str[1],Length(Str),0);                      //Отсылаю ответ от сервера клиенту
   end;
   closesocket(Ns);
end;

constructor TPROXI.Create(Port_: WORD);
Var ThId: DWORD;
     Ns: TSocket;
     Th: Pointer;
begin
   Colors(True);
   WSAStartup($101, ws);
   Sock := Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);

   GetMem(Host,MAX_PATH);
   GetMem(Data,MAX_PATH);
   ZeroMemory(Data,MAX_PATH);

   Port:= Port_;

   hAddr.sin_family:=PF_INET;
   hAddr.sin_port:=htons(PORT);
   hAddr.sin_addr.S_addr:=INADDR_ANY;

   Bind(Sock, hAddr, SizeOf(hAddr));
   Listen(Sock,1);
   repeat
     Ns := accept(Sock, nil, nil);
     CloseHandle(CreateThread(nil,0,@THREAD,Pointer(Ns),0,ThId));
   until False;
end;

destructor TPROXI.destroy;
Var c: Word;
begin
   FreeMem(Host);
   FreeMem(Data);
   inherited;
end;

procedure TPROXI.Recv_;
begin

end;

procedure TPROXI.Send_(Date: Pointer);
begin

end;

end.

Program ultimatum;

{$AppType Console}

uses
   Windows,TProxiUnit;

var
   S: TPROXI;
begin
   S:= TPROXI.Create(8080);
   Readln;
end.