program srv;

uses
       Windows, Winsock;
var
       WDATA: WsaData;
       SOCKS_port: integer;
       h: cardinal;

const buffer_size = 32768;

Function StrToInt(Const S:String):longint;
Var
C:Integer;
begin
val(S,Result,C);
end;

Function IntToStr(n:Integer):String;
Begin
str(n,Result);
End;

function HostToIp(const host: String): string;
var
 he: PHostEnt;
begin
 he:= gethostbyname(PChar(host));
 if Assigned(he) then
   Result:= inet_ntoa(PInAddr(he.h_addr_list^)^)
 else
   Result:= PChar(host);
end;

{function SafeRecv(s: integer; var stbuf: string; size: integer; timeout: integer): integer;
var
rset: TFDSet;
offset, rb, s_rslt: integer;
rbuf: string;
t, tt: TTimeVal;
bDataPresent: boolean;
       block: u_long;
begin
       block:=1;
       IOCtlSocket(s,FIONBIO,block);

offset:= 0;
rb:=0;

t.tv_sec:=timeout;
t.tv_usec:=0;

       tt.tv_sec:=1;
tt.tv_usec:=0;

       FD_Zero(rset);
       FD_Set(s,rset);
s_rslt := select(-1, @rset, nil, nil, @t);
if (FD_ISSET(s, rset)=true) then
begin
 stbuf:='';
 rbuf:='';

 bDataPresent:=true;
 repeat
               begin
  FD_Zero(rset);
  FD_Set(s,rset);
  s_rslt := select(-1, @rset, nil, nil, @tt);
  if (s_rslt > 0) then
  begin
   Zero(rbuf, size);
   rb := recv(s, rbuf[1], size, 0);
   if (rb = SOCKET_ERROR) then
   begin
    offset := -1;
    break;
   end
   else if (rb = 0) then
   begin
    bDataPresent := false;
    break;
   end
   else
   begin
                                       SetLength(rbuf, rb);
    stbuf:=stbuf+rbuf;
    offset:=offset + rb;
   end;    
  end;
 end;
 until (bDataPresent = false) or (FD_ISSET(s, rset)=false);
end;

       block:=0;
       IOCtlSocket(s,FIONBIO,block);

SafeRecv:=offset;
end;     }

function cli_thread(param: pointer): integer;
var
cli_sock: integer;
dest_sock: integer;
dest_addr: TSockAddr;
dest_ip: string;
dest_port: integer;
n: integer;
buf: String;

rset: TFDSet;
t: TTimeVal;
block: u_long;
bDataPresent: boolean;
rslt: integer;
begin
cli_sock:=integer(param);

SetLength(buf,2);
n:=recv(cli_sock, buf[1], 2, 0);

if (n=2) and (buf[1]=char($05)) then
 begin
  SetLength(buf,byte(buf[2]));
  n:=recv(cli_sock, buf[1], length(buf), 0);
  if pos(char($00), buf)<>0 then
   begin
    buf:=chr($05)+chr($00);
    send(cli_sock, buf[1], 2, 0);
    SetLength(buf,4);
    n:=recv(cli_sock, buf[1], 4, 0);
    if (n=4) and (buf[2]=chr($01)) then
     begin
      if (buf[4]=chr($01)) or (buf[4]=chr($03)) then
       begin
        Case buf[4] Of
         char($01) : Begin
                      //connect IP
                      SetLength(buf, 6);
                      n:=recv(cli_sock, buf[1], 6, 0);
                      dest_ip:=IntToStr(ord(buf[1]))+'.'+IntToStr(ord(buf[2]))+'.'+IntToStr(ord(buf[3]))+'.'+IntToStr(ord(buf[4]));
                      dest_port:=byte(buf[5]) shl 8+byte(buf[6]);
                     end;
         char($03) : begin
                      //connect by url
                      SetLength(buf, 1);
                      n:=recv(cli_sock, buf[1], 1, 0);
                      SetLength(buf, byte(buf[1]));
                      n:=recv(cli_sock, buf[1], length(buf), 0);
                      dest_ip:=HostToIp(buf);
                      SetLength(buf, 2);
                      n:=recv(cli_sock, buf[1], 2, 0);
                      dest_port:=byte(buf[1]) shl 8+byte(buf[2]);
                     end;
        End;
        SetLength(buf,10);
        ZeroMemory(@buf[1],Length(buf));
        buf[1]:=#5; buf[4]:=#1;
        send(cli_sock, buf[1], length(buf), 0);

        //IOOEI CAI?IN E OAEE!!!!
        dest_sock:=Socket(AF_INET, SOCK_STREAM, 0);
        if dest_sock<>INVALID_SOCKET then
         begin
          dest_addr.sin_family:=AF_INET;
          dest_addr.sin_port:=HtoNS(dest_port);
          dest_addr.sin_addr.S_addr:=inet_Addr(pchar(dest_ip));
          FillChar(dest_addr.Sin_Zero,SizeOf(dest_addr.Sin_Zero),0);

          n:=Connect(dest_sock, dest_addr, sizeof(dest_addr));
          if n=0 then
           begin
            t.tv_sec:=5;
            t.tv_usec:=0;
            bDataPresent:=true;
            repeat
             FD_Zero(rset);
             FD_Set(cli_sock,rset);
             FD_Set(dest_sock,rset);

             rslt := select(-1, @rset, nil, nil, @t);
             if (rslt>0) then
              begin
               if (FD_ISSET(cli_sock, rset)=true) then
                begin
                 SetLength(buf, buffer_size);
                 n := recv(cli_sock, buf[1], buffer_size, 0);

                 if n=SOCKET_ERROR then
                  begin
                   n:=WSAGetLastError();
                   if (n=WSAENOTCONN) or (n=WSAENETRESET) or (n=WSAECONNABORTED) or (n=WSAETIMEDOUT) or (n=WSAECONNRESET) then
                    begin
                     bDataPresent:= False;
                     break;
                    end;
                  end;
                 if n=0 then
                  begin
                   bDataPresent:= False;
                   break;
                  end;

                 SetLength(buf, n);
                 send(dest_sock, buf[1], length(buf), 0);
                end;
               if FD_ISSET(dest_sock, rset) then
                begin
                 SetLength(buf, buffer_size);
                 n := recv(dest_sock, buf[1], buffer_size, 0);
                 if n=SOCKET_ERROR then
                  begin
                   n:=WSAGetLastError();
                   if (n=WSAENOTCONN) or (n=WSAENETRESET) or (n=WSAECONNABORTED) or (n=WSAETIMEDOUT) or (n=WSAECONNRESET) then
                    begin
                     bDataPresent:= False;
                     break;
                    end;
                  end;
                 if n=0 then
                  begin
                   bDataPresent:= False;
                   break;
                  end;
                 SetLength(buf, n);
                 send(cli_sock, buf[1], length(buf), 0);
                end;
              end;
             //bDataPresent:=False;
            until bDataPresent= False;
           end;
         end;
       end;
     end;
   end;
 end;

CloseSocket(dest_sock);
CloseSocket(cli_sock);

cli_thread:=0;
end;

function srv_daemon(srv_port: integer): integer;
var
srv_sock, accepted_sock: integer;
addr: TSockAddr;
addr_size: integer;
FDSet: TFDSet;
timeout: TtimeVal;
h: cardinal;
begin
srv_sock:=socket(AF_INET, SOCK_STREAM, 0);
addr.sin_family:=PF_Inet;
srv_port:=33333;
addr.sin_port:=HToNS(srv_port);
addr.sin_addr.S_addr:=InAddr_Any;
FillChar(addr.Sin_Zero,SizeOf(addr.Sin_Zero),0);

Bind(srv_sock, addr, SizeOf(TSockAddr));
Listen(srv_sock,SoMaxConn);

addr_size:=SizeOf(TSockAddr);

timeout.tv_sec:=0;
timeout.tv_usec:=100;

while True do
 begin
  FD_Zero(FDSet);
  FD_Set(srv_sock,FDSet);

  //anee anou eeeaio, oi ia?aaaai nieao a eeeaioneee iioie
  Select(0,@FDSet,nil,nil,@timeout);
  if FD_IsSet(srv_sock,FDSet) then
   begin
    accepted_sock:=Accept(srv_sock,@Addr,@addr_size);
    BeginThread(nil, 0, @cli_thread, pointer(accepted_sock), 0, h);
   end;
 end;

CloseSocket(srv_sock);

srv_daemon:=0;
end;

Var
hThrd:Integer;
begin
WSAStartup($101,WDATA);
Randomize;

//Caioneaai iioie nien
SOCKS_port:=10000+random(55000);
hThrd:=BeginThread(nil, 0, @srv_daemon, pointer(SOCKS_port), 0, h);

While WaitForSingleObject(hThrd,100) Do
 Begin
//   ченить работающее параллельно
 End;

WSACleanup();
end.