program head;
{$APPTYPE CONSOLE}
uses windows, winsock;

var s:TSocket;
    initExit:BOOL=false;
    httpQuery:array[0..20]of char='HEAD / HTTP/1.0'#13#10#13#10#13#10;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//вывод текста описания ошибки и выход
procedure error(const ansiStr:string;ErrorCode:integer;bQuit:BOOL);
var Buffer: array[0..1023] of Char;
begin
 FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
  FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
  SizeOf(Buffer), nil);

 CharToOem(@Buffer, @Buffer);
 write(ansiStr,'(',ErrorCode,') ',pChar(@Buffer));
 if bQuit then halt(1);
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Вызывается при закрытии консоли клиента
function ClientConsoleEvent(dwCtrlType:cardinal):BOOL;stdcall;
begin
 initExit:=true;
 shutdown(s,SD_SEND OR SD_RECEIVE);
 closesocket(s);
 ClientConsoleEvent:=true;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Узнать IP по имени хоста
function GetIpFromName(szServerName:pChar):TInAddr;
type TaPInAddr = array [0..0] of PinAddr;
     PaPInAddr = ^TaPInAddr;
var phe: PHostEnt;
    pptr: PaPInAddr;
begin
 GetIpFromName.S_addr:=0;
 phe := GetHostByName(szServerName);
 if phe = nil then exit;
 pptr := PaPInAddr(phe^.h_addr_list);
 GetIpFromName:=pptr^[0]^;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
//Основная процедура клиента
procedure NetClient(const DestAddr:string;wPort:word);
var RemoteAddr:TSockAddr;
    buf:array[0..1023]of char;
    dwLen,hOut,beWritten:cardinal;
    ip:TInAddr;
    sPort:string;
begin
 ip:=GetIpFromName(pChar(DestAddr));
 if ip.S_addr=0 then
  error('# error at gethostbyname: ',WSAGetLastError,TRUE);

 fillchar(RemoteAddr, sizeof(RemoteAddr), 0);
 RemoteAddr.sin_family:=AF_INET;
 RemoteAddr.sin_port:=htons(wPort);
 RemoteAddr.sin_addr:=ip;
 str(wPort,sPort);

 writeln('# host: ',DestAddr);
 writeln('# ip  : ',inet_ntoa(ip));
 writeln('# port: ',wPort);

 s:=socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
 if s=INVALID_SOCKET then
  error('# error at socket: ',WSAGetLastError,true);

 SetConsoleCtrlHandler(@ClientConsoleEvent, TRUE);
 writeln('# connect...');
 if connect(s,RemoteAddr,sizeof(TSockAddr))<>0 then begin
  if not initExit then
   error('# error at connect: ',WSAGetLastError,false);
  closesocket(s);
  exit; 
 end;
 writeln('# success');
 send(s,httpQuery,sizeof(httpQuery),0);
 hOut:=GetStdHandle(STD_OUTPUT_HANDLE);
 while true do begin
  dwLen:=recv(s,buf,sizeof(buf),0);
  if (dwLen=cardinal(-1)) OR (dwLen=0) then begin
   if (not initExit)AND(dwLen=cardinal(-1)) then
    error('# error at recv: ',WSAGetLastError,false);
   if not initExit then closesocket(s);
   exit;
  end;
  WriteFile(hOut,buf,dwLen,beWritten,nil);
 end;
end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
var code:integer;
    wPort:word;
    InitData:TWSAData;
BEGIN
 if (ParamCount=0)OR(ParamCount>2) then begin
  writeln('Usage: head.exe host [port]');
  halt(0);
 end;
 if ParamCount=1 then wPort:=80
 else val(ParamStr(2),wPort,code);

 if WSAStartup(MakeWord(2,2),InitData)<>0 then
  error('# error at WSAStartup: ',WSAGetLastError,true);

 NetClient(ParamStr(1),wPort);
 WSACleanup;
END.