Memo1.Text := DownloadWithInet('http://www.delphibbs.com');

or

Memo1.Text := DownloadWithSocket('http://www.delphibbs.com');

兩者各有利弊，自己選擇.

uses WinSock, WinInet;

function DownloadWithInet(const AUrl: string): string;

procedure Add(Buf: PChar; Count: Integer);

var

Len: Integer;

begin

Len := Length(Result);

SetLength(Result, Len + Count);

Move(Buf^, Result[Len + 1], Count);

end;

function PrepareURL: string;

begin

Result := UpperCase(Copy(AUrl, 1, 7));

if Result <> 'HTTP://' then

Result := 'http://' + AUrl

else

Result := AUrl;

end;

var

BytesRead: DWORD;

Session, Connection: HINTERNET;

Buffer: array[1..1024] of Char;

begin

Result := '';

if AUrl = '' then Exit;

Session := InternetOpen(nil, INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0);

if not Assigned(Session) then

raise Exception.Create(SysErrorMessage(GetLastError));

try

Connection := InternetOpenUrl(Session, PChar(PrepareURL), nil, 0,

INTERNET_FLAG_RAW_DATA, {INTERNET_FLAG_RELOAD, }0);

if not Assigned(Connection) then

raise Exception.Create(SysErrorMessage(GetLastError));

try

repeat

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(Connection, @Buffer, SizeOf(Buffer), BytesRead);

if BytesRead > 0 then

Add(@Buffer, BytesRead);

Application.ProcessMessages;

until BytesRead = 0;

finally

InternetCloseHandle(Connection);

end;

finally

InternetCloseHandle(Session);

end;

end;

function DownloadWithSocket(const AUrl: string): string;

const

CRLF = #13#10;

SFileContentLen = 'content-length: ';

SUserAgent =

'User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; .NET CLR 1.0.3705)';

SRequestFileHead =

'HEAD %s HTTP/1.1' + CRLF +

'Pragma: no-cache' + CRLF +

'Cache-Control: no-cache' + CRLF +

SUserAgent + CRLF +

'Host: %s' + CRLF + CRLF;

SRequestDownFile =

'GET %s HTTP/1.1' + CRLF +

'Accept: */*' + CRLF +

SUserAgent + CRLF +

'RANGE: bytes=0-' + CRLF +

'Host: %s' + CRLF + CRLF;

procedure ExtractHostAndFileName(const AURL: string;

var AHost, AFileName: string; APort: PString = nil);

const

HttpHead = 'http://';

HttpHeadLen = Length(HttpHead);

var

I: Integer;

begin

AHost := AURL;

I := Pos(HttpHead, AURL);

if I <> 0 then

AHost := Copy(AHost, I + HttpHeadLen, MaxInt);

I := AnsiPos('/', AHost);

while I <> 0 do

begin

AHost := Copy(AHost, 1, I - 1);

I := AnsiPos('/', AHost);

end;

I := Pos(AHost, AURL) + Length(AHost);

AFileName := Copy(AURL, i, MaxInt);

I := Pos(':', AHost);

if I <> 0 then

begin

if Assigned(APort) then

APort^ := Copy(AHost, I + 1, MaxInt);

AHost := Copy(AHost, 1, I - 1);

end;

end;

var

Socket: TSocket;

function WaitForSocket(Timeout: Integer): Boolean;

var

FDSet: TFDSet;

TimeVal: TTimeVal;

begin

TimeVal.tv_sec := Timeout;

TimeVal.tv_usec := 0;

FD_ZERO(FDSet);

FD_SET(Socket, FDSet);

Result := WinSock.select(0, @FDSet, nil, nil, @TimeVal) > 0;

end;

procedure Add(var S: string; Buf: PChar; Count: Integer);

var

Len: Integer;

begin

Len := Length(S);

SetLength(S, Len + Count);

Move(Buf^, S[Len + 1], Count);

end;

function ReceiveLine: string;

var

C: Char;

RetLen: Integer;

begin

Result := '';

while Socket <> INVALID_SOCKET do

begin

RetLen := recv(Socket, C, 1, 0);

if (RetLen <= 0) or (RetLen = SOCKET_ERROR) then

break;

Add(Result, @C, 1);

if Pos(CRLF, Result) > 0 then break;

end;

end;

function SendCommand(const Command: string): string;

var

P: PChar;

Data: string;

begin

Result := '';

P := PChar(Command);

send(Socket, P^, Length(Command), 0);

while WaitForSocket(5) do

begin

Data := ReceiveLine;

if (Data = '') or (Data = CRLF) then

break else

Add(Result, PChar(Data), Length(Data));

end;

end;

procedure InitSocket(const AHost: string);

var

Addr: TSockAddrIn;

Data: TWSAData;

HostEnt: PHostEnt;

Timeout: Integer;

begin

Winsock.WSAStartup($0101, Data);

Socket := WinSock.socket(PF_INET, SOCK_STREAM, IPPROTO_IP);

if Socket = INVALID_SOCKET then

raise Exception.Create(SysErrorMessage(GetLastError));

Timeout := 1000;

WinSock.setsockopt(Socket, SOL_SOCKET, SO_RCVTIMEO, @Timeout, SizeOf(TimeOut));

HostEnt := gethostbyname(PChar(AHost));

FillChar(Addr.sin_addr, SizeOf(Addr.sin_addr), 0);

Addr.sin_family := PF_INET;

if HostEnt <> nil then

Move(HostEnt^.h_addr^[0], Addr.sin_addr.S_addr, HostEnt^.h_length)

else

raise Exception.CreateFmt('主機(jī)沒找到: %s', [AHost]);

Addr.sin_port := htons(80);

if connect(Socket, Addr, SizeOf(Addr)) <> 0 then

raise Exception.Create(SysErrorMessage(GetLastError));

end;

procedure UnInitSocket;

begin

if Socket <> INVALID_SOCKET then

closesocket(Socket);

WSACleanup;

end;

var

Data, FileName, Host: string;

begin

Socket := INVALID_SOCKET;

ExtractHostAndFileName(AUrl, Host, FileName);

try

InitSocket(Host);

if FileName = '' then

FileName := '/';

Data := SendCommand(Format(SRequestFileHead, [FileName, Host]));

Data := SendCommand(Format(SRequestDownFile, [FileName, Host]));

while True do

begin

Data := ReceiveLine;

if Data = '' then break;

Add(Result, PChar(Data), Length(Data));

Application.ProcessMessages;

end;

finally

UnInitSocket;

end;

end;