https（SSL）にも対応した，httpクライアントのコンポ．
IEが入っている環境で使えます．
（ 01085のぶんぶん鈴木さんのサンプルに Request Headerをつけて
　コンポに仕立てた例です）

Delphi4 Pro(Updatepack3) + Windows NT4.0 SP5 + IE5.01(5.00.2919.6307)で動作



＜使い方＞
procedure TForm1.Button4Click(Sender: TObject);
begin
  HttpEx1.URL := Edit1.Text;
  HttpEx1.Get;
  Memo1.Text := HttpEx1.Body;
end;

---------------------------------------------------------------------
unit HttpEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WinInet;

type
  THttpEx = class(TComponent)
  private
    FHeader: string;
    FURL: string;
    FBody: string;
    FStream: TStream;
    function GetFileFromInternet: boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Get: boolean;
    property Stream: TStream read FStream;
    property Body: string read FBody;
  published
    property URL: string
             read FURL write FURL;
    property Header: string
             read FHeader write FHeader;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Internet', [THttpEx]);
end;

constructor THttpEx.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStream := TMemoryStream.Create;
end;

destructor THttpEx.Destroy;
begin
  FStream.Free;
  inherited Destroy;
end;

function THttpEx.Get: boolean;
begin
  TMemoryStream(FStream).Clear;
  Result := GetFileFromInternet;
  SetLength(FBody, FStream.Size);
  FStream.Seek(0,0);
  FStream.ReadBuffer(FBody[1], FStream.Size);
end;

function THttpEx.GetFileFromInternet: boolean;
var
  hSession, hConnect: hInternet;
  Buf: array[0..1023] of Char;
  ReadCount: Cardinal;
  pHeader: PChar;
begin
  Result := False;
  hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if FHeader <> '' then begin
      pHeader := @FHeader[1];
    end else begin
      pHeader := nil;
    end;
    hConnect := InternetOpenUrl( hSession, PChar(FUrl),
                                 pHeader, ULONG(-1), 0, 0);
    try
      while True do begin
        if not InternetReadFile(hConnect, @Buf, SizeOf(Buf), ReadCount)
          or
          (ReadCount = 0)
        then begin
          Break
        end else begin
          FStream.Write(Buf, ReadCount);
          Result := True;
        end;
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

end.

                                                  ＴＮ(CQJ01721)

Original document by ＴＮ            氏 ID:(CQJ01721)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。