gethttps.pas

Delphi实现获取网页源码

//
// GetHTTPS.pas
//
// Author: GilGil([e-mail])
// Last Modified: 2004.07.12
//

unit GetHTTPS;

interface

uses
  Windows, Classes, SysUtils, Math, WinInet, VDTrace;

type
  PPChar = ^PChar;

type
// ----------------------------------------------------------------------------
// TGetHTTP
// ----------------------------------------------------------------------------
  TGetHTTP = class
  protected
	FISession: HINTERNET;
	FBuffer: PChar;
	FBufferSize: Integer;
	procedure Resize(NewBufferSize: Integer);
  public
	constructor Create;
	destructor Destroy; override;
	function Get(const URL: String; Buffer: PPChar): Integer; overload;
	function Get(const URL: String): String; overload;
  end;

// ----------------------------------------------------------------------------
// Function
// ----------------------------------------------------------------------------
function GetHTTP(const URL: String): String; overload;

implementation

// ----------------------------------------------------------------------------
// TGetHTTP
// ----------------------------------------------------------------------------
procedure TGetHTTP.Resize(NewBufferSize: Integer);
var
	NewBuffer: PChar;
begin
	if FBufferSize = NewBufferSize then exit;
	NewBuffer := nil;
	if NewBufferSize > 0 then
	begin
		GetMem(NewBuffer, NewBufferSize);
		if FBuffer <> nil then
			StrMove(NewBuffer, FBuffer, Min(FBufferSize, NewBufferSize));
	end;
	if FBuffer <> nil then
	begin
		FreeMem(FBuffer);
	end;
	FBuffer := NewBuffer;
	FBufferSize := NewBufferSize;
end;

constructor TGetHTTP.Create;
begin
	FISession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
	if FISession = nil then
	begin
		GTrace('[GetHTTP.pas] InternetOpen return nil GetLastError=%d', [GetLastError]);
	end;
	FBuffer := nil;
	FBufferSize := 0;
end;

destructor TGetHTTP.Destroy;
begin
	if FISession <> nil then
	begin
		InternetCloseHandle(FISession);
		FISession := nil;
	end;
	Resize(0);
	inherited;
end;

function TGetHTTP.Get(const URL: String; Buffer: PPChar): Integer;
const
	TEMP_BUFFER_SIZE = 2048;
label
	_error;
var
	HttpFile: HINTERNET;
	TempBuffer: array[0 .. TEMP_BUFFER_SIZE - 1] of Char;
	OldBufferSize, NewBufferSize: Integer;
	ByteRead: DWORD;
begin
	HttpFile := InternetOpenUrl(FISession, PChar(URL), nil, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0);
	if HttpFile = nil then
	begin
		GTrace('[GetHTTP.pas] InternetOpenUrl return nil GetLastError=%d', [GetLastError]);
		goto _error;
	end;
	OldBufferSize := 0;
	NewBufferSize := 0;
	while true do
	begin
		if not InternetReadFile(HttpFile, @TempBuffer[0], TEMP_BUFFER_SIZE, ByteRead) then
		begin
			GTrace('[GetHTTP.pas] InternetReadFile return false GetLastError=%d', [GetLastError]);
			goto _error;
		end;
		if ByteRead = 0 then break;
		NewBufferSize := OldBufferSize + Integer(ByteRead);
		if NewBufferSize > FBufferSize then
			Resize(NewBufferSize);
		StrMove(FBuffer + OldBufferSize, @TempBuffer[0], ByteRead);
		OldBufferSize := NewBufferSize;
	end;
	Buffer^ := FBuffer;
	Result := NewBufferSize;
	InternetCloseHandle(HttpFile);
	exit;
_error:
	if HttpFile <> nil then
		InternetCloseHandle(HttpFile);
	Result := -1;
end;

function TGetHTTP.Get(const URL: String): String;
var
	nRes: Integer;
	Buffer: PChar;
begin
	nRes := Get(URL, @Buffer);
	Result := '';
	if nRes <> -1 then // if succeed
	begin
		SetLength(Result, nRes);
		StrMove(@Result[1], Buffer, nRes);
	end;
end;

// ----------------------------------------------------------------------------
// Function
// ----------------------------------------------------------------------------
function GetHTTP(const URL: String): String;
var
	MyGetHTTP: TGetHTTP;
begin
	MyGetHTTP := TGetHTTP.Create;
	Result := MyGetHTTP.Get(URL);
	MyGetHTTP.Free;
end;

end.