function PingPort(host: string; portnum: word; tim: integer): boolean;
var
  s, opt: Integer;
  FSocket: TSOCKET;
  busy : boolean;
  addr : TSockAddr;
  hEvent : THandle;
  fset : TFDset;
  tv : TTimeval;
  GInitData : TWSADATA;

function LookupName(host: string): TInAddr;
var
  HostEnt: PHostEnt;
  InAddr: TInAddr;
begin
  HostEnt := gethostbyname(PChar(host));
  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;

begin
  result := false;
  WSAStartup(MAKEWORD(2,0), GInitData);
  addr.sin_family := AF_INET;
  addr.sin_addr.s_addr := INADDR_ANY;
  addr.sin_port := htons(portnum);
  hEvent := WSACreateEvent();
  busy:=false;
  FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
  WSAEventSelect(FSocket, hEvent, FD_WRITE + FD_CONNECT);
  addr.sin_addr := LookupName(host);
  connect(FSocket, @addr, sizeof(addr));
  if WSAGetLastError()=WSAEINPROGRESS then
    begin
      closesocket (FSocket);
      busy:=true;
    end;
  FD_Zero(fset);
  if busy <> true then
    FD_SET (FSocket, fset);
  tv.tv_sec := tim;
  tv.tv_usec := 0;
  s:=select (1, nil, @fset, nil, @tv);
  if busy then
    exit;
  if FD_ISSET (FSocket, fset) then
    begin
      s:=Sizeof(Opt);
      opt:=1;
      getsockopt(FSocket, SOL_SOCKET, SO_ERROR, @opt, s);
      if opt=0 then
        result := true;
      closesocket(FSocket);
    end;
  WSACloseEvent(hEvent);
  WSACleanup;
end;

procedure main;
begin
  if PingPort('ya.ru', 80, 2) then
    messagebox(0,'Порт открыт', nil, mb_ok or mb_iconinformation);
end;