unit MainUnit;

interface

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

type
  TTCPClientForm = class(TForm)
    btSend: TButton;
    edURL: TEdit;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    edExtProxyAddr: TEdit;
    Label3: TLabel;
    cbUseProxyServer: TCheckBox;
    edExtProxyPort: TEdit;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btSendClick(Sender: TObject);
  private
    { Private declarations }
    function GetWEBPage(addr: String; Method:Integer):TStringList;
  public
    { Public declarations }
  end;

var
  TCPClientForm: TTCPClientForm;

implementation

{$R *.dfm}

function LookupName(name:String): TInAddr;
var
 HostEnt: PHostEnt;
 InAddr: TInAddr;
begin
 HostEnt := gethostbyname(PChar(name));
 FillChar(InAddr, SizeOf(InAddr), 0);
 if HostEnt <> nil then
  begin
   with InAddr, HostEnt^ do
    begin
     S_un_b.s_b1 := Byte(h_addr^[0]);
     S_un_b.s_b2 := Byte(h_addr^[1]);
     S_un_b.s_b3 := Byte(h_addr^[2]);
     S_un_b.s_b4 := Byte(h_addr^[3]);
    end;
  end;
 Result := InAddr;
end;

procedure SendStr(s:TSocket; str:String);
var
 sRecvBuff : array [0..1024] of char;
 TempStr : AnsiString;
begin
 TempStr:=str+#13+#10;
 CopyMemory(@sRecvBuff, PChar(TempStr), Length(TempStr));
 send(s, sRecvBuff, Length(TempStr), 0);
end;

function TTCPClientForm.GetWEBPage(addr: String; Method:Integer):TStringList;
var
 localaddr : sockaddr_in;
 iMode, iSize:Integer;
 rfds : TFDSET;
 Buff: array [0..1024] of char;
 stClient:TSocket;
 testingserver, servername, portname:String;
 timeout:TTimeVal;
begin
 Result:=TStringList.Create;
 // create socket
 stClient := socket(AF_INET, SOCK_STREAM, 0);
 if stClient = INVALID_SOCKET then
  begin
   MessageBox(0, 'Winsock initialize error', 'Error', MB_OK+MB_ICONERROR);
   exit;
  end;

 // search host name
 testingserver:=addr;
 if pos('//', testingserver)>0 then
  delete(testingserver, 1, pos('//', testingserver)+1);
 if pos('/', testingserver)>0 then
  delete(testingserver, pos('/', testingserver), 255);

 // check connection
 if cbUseProxyServer.Checked then
  begin
   servername:=edExtProxyAddr.Text;
   portname:=edExtProxyPort.Text;
  end
 else
  begin
   servername:=testingserver;
   portname:='80';
  end;


 // fill address
 localaddr.sin_addr := LookupName(servername);
 localaddr.sin_family := AF_INET;
 localaddr.sin_port := htons(StrToIntDef(portname, 80));
 if connect(stClient, @localaddr, sizeof(localaddr))<>0 then
  begin
   MessageBox(0, 'Can''t connect to server', 'Error', MB_OK+MB_ICONERROR);
   exit;
  end;

 // send request
 if Method=1 then
  SendStr(stClient, 'GET '+addr+' HTTP/1.0'+#13+#10+'Content-Type: text/html'+#13+#10+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322; .NET CLR 2.0.50727)'+#13+#10+'Host: '+testingserver+#13+#10+'Content-Length: '+'0'+#13+#10+'Proxy-Connection: Keep-Alive'+#13+#10+#13+#10);
 if Method=2 then
  SendStr(stClient, 'POST '+addr+' HTTP/1.0'+#13+#10+'Content-Type: text/html'+#13+#10+'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322; .NET CLR 2.0.50727)'+#13+#10+'Host: '+testingserver+#13+#10+'Content-Length: '+'0'+#13+#10+'Proxy-Connection: Keep-Alive'+#13+#10+#13+#10);

 // change socket options
 iMode:=1;
 setsockopt(stClient, IPPROTO_TCP, TCP_NODELAY, @iMode, sizeof(integer));

 // get file loop
 while true do
  begin
   FD_ZERO(rfds);
   FD_SET(stClient, rfds);


   timeout.tv_sec:=10;
   if (select(0, @rfds, nil, nil, @timeout) <= 0) then
    exit;

   if(FD_ISSET(stClient, rfds)) then
		begin
			iSize := recv(stClient, buff, sizeof(buff), 0);

      if (iSize<1) then
       break;

      Result.Add(String(buff));
    end;
  end;
 CloseSocket(stClient);
end;

procedure TTCPClientForm.btSendClick(Sender: TObject);
begin
 Memo1.Lines.Assign(GetWEBPage(edURL.Text, 2));
end;

procedure TTCPClientForm.FormCreate(Sender: TObject);
var
 wData : TWSADATA;
begin
 if WSAStartup(MAKEWORD(1,1), wData) <> 0 then
	begin
   MessageBox(0, 'Не могу загрузить WinSock', 'Ошибка', 0);
   exit;
	end;
end;

end.