unit Unit1;

interface

uses
         Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
         Dialogs, StdCtrls,winsock;

type
         TForm1 = class(TForm)
           Button1: TButton;
           Memo1: TMemo;
           Button2: TButton;
           procedure Button1Click(Sender: TObject);
           procedure Button2Click(Sender: TObject);
         private
           { Private declarations }
         public
           { Public declarations }
         end;

var
         Form1: TForm1;

implementation

{$R *.dfm}

function HostToIP(host: string):string;
var
         IP:string;
         hostEnt : PHostEnt;
         hostName : array [0..255] of char;
         addr : PChar;
begin
         result:=host;
         try
           strpcopy(hostname, host);
           hostEnt := gethostbyname(hostName);
           if Assigned(hostEnt) and Assigned(hostEnt^.h_addr_list) then
             begin
             addr:=hostEnt^.h_addr_list^;
             IP:=Format('%d.%d.%d.%d', [byte(addr[0]), byte(addr[1]), byte(addr[2]), byte(addr[3])]);
             end;
           result:=ip;
         except
        end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var sock: WSAData;
           socket1: TSocket;
           addr: TSockAddr;
           buff1: string;
           buff2: array[1..1024] of char;
           i,d: integer;
begin
if WSAStartup(MAKEWORD(2,2),sock)<>0 then
begin
         ShowMessage('Error inicialization');
         Exit;
end;
         socket1:=Socket(AF_INET,SOCK_STREAM,0);
if socket1 = INVALID_SOCKET then
begin
         ShowMessage('Error');
         Exit;
end;
         addr.sa_family:=AF_INET;
         addr.sin_addr.S_addr:=inet_addr(PChar(HostToIp('www.newprogrammers.ru')));
         addr.sin_port:=htons(80);
if connect(socket1,addr,SizeOf(addr))<>0 then
begin
         ShowMessage('Error connect');
         Exit;
end;
         {Buff1:='GET / HTTP/1.1'#13#10+
                 'host: parsers.info'#13#10+
                 'Connection: close'#13#10+#13#10; }

                 Buff1:='GET / HTTP/1.1'#13#10+
                 'host: newprogrammers.ru'#13#10+
                 'Accept-Encoding: gzip, deflate'+#13#10+
                 'Connection: keep-alive'#13#10+#13#10;
if send(socket1,buff1[1],length(buff1),0)=SOCKET_ERROR then
begin
         ShowMessage('Error sender');
         Exit;
end;

         FillChar(buff2,SizeOf(buff2),0);
         d:=Recv(socket1,buff2,SizeOf(buff2),0);
         for i:=1 to d do
           memo1.Text:=memo1.Text+Utf8ToAnsi(buff2[i]);
         if CloseSocket(Socket1)<>0 then
           ShowMessage('Error closing');
end;

function down:string;//получаем html код ya.ru
var info:TWSADATA;//библиотека сокетов
          sock:TSocket;//сокет
          addr,addr_local:TSockAddr;//адреса для connect и bind
          zapros:string;//посылаемый запрос
          otvet:string;//получаемый ответ
          k:integer;//счетчик отправленных, принятых байт
          i:integer;
          buf:string;// html код получаемой страницы
begin
         if WSAStartup($101,info)<>0 then
           exit;
         sock:=Socket(AF_INET,SOCK_STREAM,0);
         if sock=INVALID_SOCKET then
           exit;

         addr_local.sin_family:=AF_INET;
         addr_local.sin_addr.S_addr:=INADDR_ANY;
         addr_local.sin_port:=0;
         if bind(sock,addr_local,SizeOf(addr_local))=SOCKET_ERROR then
           exit;
         addr.sin_family:=AF_INET;
         addr.sin_addr.S_addr:=inet_addr(pchar(HostToIP('ya.ru')));
         addr.sin_port:=htons(80);
         if Connect(sock,addr,SizeOf(addr))<>0 then
           exit;
         zapros:='GET / HTTP/1.1'+#13#10+'Host:ya.ru'+#13#10#13#10;
         //посылаем в цикле по 10 байт
         i:=1;
         k:=0;
         repeat
           if length(zapros)-i+1<10 then
             k:=send(sock,zapros[i],length(zapros)-i+1,0) else
             k:=send(sock,zapros[i],10,0);
           i:=i+k;
         until i=length(zapros)+1;

         SetLength(otvet,2000);
         buf:='';
         repeat
           k:=Recv(sock,otvet[1],2000,0);
           buf:=buf+copy(otvet,1,k);
         until k<=0;
         result:=buf;
end;

function GetHtml:string;//получаем html код ya.ru
var info:TWSADATA;//библиотека сокетов
          sock:TSocket;//сокет
          addr,addr_local:TSockAddr;//адреса для connect и bind
          zapros:string;//посылаемый запрос
          otvet:string;//получаемый ответ
          k:integer;//счетчик отправленных, принятых байт
          i:integer;
          buf:string;// html код получаемой страницы
begin
         if WSAStartup($101,info)<>0 then
           exit;
         sock:=Socket(AF_INET,SOCK_STREAM,0);
         if sock=INVALID_SOCKET then
           exit;

         addr_local.sin_family:=AF_INET;
         addr_local.sin_addr.S_addr:=INADDR_ANY;
         addr_local.sin_port:=0;
         if bind(sock,addr_local,SizeOf(addr_local))=SOCKET_ERROR then
           exit;
         addr.sin_family:=AF_INET;
         addr.sin_addr.S_addr:=inet_addr(pchar(HostToIP('newprogrammers.ru')));
         addr.sin_port:=htons(80);
         if Connect(sock,addr,SizeOf(addr))<>0 then
           exit;
         zapros:='GET / HTTP/1.1'#13#10+
                 'host: newprogrammers.ru'#13#10+
                 'Accept-Encoding: none, deflate'+#13#10+
                 'Connection: keep-alive'#13#10+#13#10;
         //посылаем в цикле по 10 байт
         i:=1;
         k:=0;
         repeat
           if length(zapros)-i+1<10 then
             k:=send(sock,zapros[i],length(zapros)-i+1,0) else
             k:=send(sock,zapros[i],10,0);
           i:=i+k;
         until i=length(zapros)+1;

         SetLength(otvet,2000);
         buf:='';
         repeat
           k:=Recv(sock,otvet[1],2000,0);
           buf:=buf+copy(otvet,1,k);
         until k<=0;
         result:=buf;
end;

function SendHTTP(host, action, method, otherHeaders,
         request_data: string): string;
var
         WSAData: TWSAData;
         ErrorCode: Integer;
         FSocket: TSocket;
         HostEnt: PHostEnt;
         InAddr: TInAddr;
         FAddr: TSockAddrIn;
         ServResp: string;
         request: String;
         savetickcount: Cardinal;
         c: Char;
         d: Integer;
         response: String;
begin
         { Initialize }
         ErrorCode := WSAStartup($0101, WSAData);
         if ErrorCode <> 0 then
           exit//Writeln('WSAStartup Error #' + IntToStr(WSAGetLastError))
         else
           { Socket Operation }
           try
             FSocket := socket(PF_INET, SOCK_STREAM, 0);
             if FSocket = INVALID_SOCKET then
               exit;//Writeln('SocketError #' + IntToStr(WSAGetLastError));
             HostEnt := gethostbyname(PAnsiChar(host));
             FillChar(InAddr, SizeOf(InAddr), 0);
             if HostEnt <> nil then
             begin
               InAddr.S_un_b.s_b1 := HostEnt^.h_addr^[0];
               InAddr.S_un_b.s_b2 := HostEnt^.h_addr^[1];
               InAddr.S_un_b.s_b3 := HostEnt^.h_addr^[2];
               InAddr.S_un_b.s_b4 := HostEnt^.h_addr^[3];
             end
             else
               Writeln('Error Getting Host by name');
             FAddr.sin_family := PF_INET;
             FAddr.sin_addr := InAddr;
             FAddr.sin_port := htons(80);

             ErrorCode := connect(FSocket, FAddr, SizeOf(FAddr));
             if ErrorCode <> 0 then
               Writeln('Connection error #' + IntToStr(WSAGetLastError));
             request := '';
             request := request + method + ' ' + action + ' HTTP/1.1' + #13#10;
             request := request + 'Host: ' + host + #13#10;
             request := request + 'Connection: close' + #13#10;
             request := request + 'User-Agent: Mozilla/4.0' + #13#10;
             request := request +'Content-Type: application/x-www-form-urlencoded' + #13#10;
             request := request + 'Content-Length: ' + IntToStr(Length(request_data)) + #13#10;
             if Trim(otherHeaders) <> '' then
               request := request + otherHeaders + #13#10;
             request := request + #13#10;

             if send(FSocket, Pointer(request + request_data)^,
               Length(request + request_data), 0) = SOCKET_ERROR then
             begin
               Writeln('Socket error #', WSAGetLastError);
             end; { отправка заголовков }

             repeat
               FillChar(c, SizeOf(c), 0);
               d := recv(FSocket, c, SizeOf(c), 0);
               response := response + c;
             until d <= 0;

             result := response;
             ServResp := Copy(response, Pos(' ', response) + 1, 1);
           finally
             { End of working }
             ErrorCode := WSACleanup;
             if ErrorCode <> 0 then
               Writeln('WSACleanup Error #' + IntToStr(WSAGetLastError));
           end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var s:String;
begin
          S:=SendHttp('newprogrammers.ru','/Hellow.htm','GET','','');
          Memo1.Text:=S;
end;

end.