type
  PCheckProxy = ^TCheckProxy;
  TCheckProxy = record
    ProxyHost : PChar;
    ProxyPort : Word;
    Timeout   : Byte; // в секундах
    ConnectTo : PChar;
    ControlStr: PChar;
  end;

function CheckProxy(lpCheckProxy: PCheckProxy) : Boolean;

function GetIpByName : Boolean;
var
  HostEnt: PHostEnt;
begin
  HostEnt := gethostbyname(lpCheckProxy^.ProxyHost);
  Result := HostEnt <> nil;

  if Result then
    lpCheckProxy^.ProxyHost := inet_ntoa(PInAddr(HostEnt.h_addr_list^)^);
end;

var
  Arg: Integer;
  Query: String;
  TV: TTimeVal;
  FSet: TFDSet;
  Socket: TSocket;
  addr: sockaddr_in;
  WSAData: TWSAData;

procedure IoCtl(cmd: DWord);
begin
  ioctlsocket(Socket, cmd, Arg);
end;

begin
  Result := False;
  if WSAStartup($0101, WSAData) = 0 then
    try
      Socket := WinSock.socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
      if Socket <> INVALID_SOCKET then
        try
          if inet_addr(lpCheckProxy^.ProxyHost) = INADDR_NONE then
            if not GetIpByName then
              Exit;

          ZeroMemory(@addr, SizeOf(sockaddr_in));
          with addr, lpCheckProxy^ do
          begin
            sin_family      := AF_INET;
            sin_port        := htons(ProxyPort);
            sin_addr.S_addr := inet_addr(ProxyHost);
          end;

          Arg := 1;
          IoCtl(FIONBIO);
          FD_ZERO(FSet);
          FD_SET(Socket, FSet);
          TV.tv_sec := lpCheckProxy^.Timeout; TV.tv_usec := 0;
          connect(Socket, addr, SizeOf(sockaddr_in));
          if WSAGetLastError <> WSAEWOULDBLOCK then
            Exit;
          if select(0, nil, @FSet, nil, @TV) <> 1 then
            Exit;

          Arg := 0;
          IoCtl(FIONBIO);

          Query := 'GET ' + lpCheckProxy^.ConnectTo + ' HTTP/1.1'#13#10'User-Agent: Mozilla/4.0'#13#10#13#10;
          if send(Socket, PChar(Query)^, Length(Query), 0) = SOCKET_ERROR then
            Exit;

          with lpCheckProxy^ do
            ControlStr := PChar(LowerCase(ControlStr));

          while not Result do
          begin
            if select(0, @FSet, nil, nil, @TV) <> 1 then
               Break;
            IoCtl(FIONREAD);
            if Arg = 0 then
              Exit;

            SetLength(Query, Arg);
            recv(Socket, PChar(Query)^, Arg, 0);
            Result := Pos(lpCheckProxy^.ControlStr, LowerCase(Query)) <> 0;
          end;
          shutdown(Socket, SD_BOTH);
        finally
          closesocket(Socket);
        end;
    finally
      WSACleanup;
    end;
end;