Проблемма с HTTP (Delphi 7)
Пишу HTTP Client, но проблемма в том, что он не полностью загружает текст страницы.
Пишу на Delphi 7 через WinSock2.
Исходники и заголовочные файлы тут.
Пароль: antichat
Вот код:
Код:
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.
|
