Problem mit IdHTTP.get mit Fortschrittsanzeige

[arbu man]

Es geht doch wunderbar in der Konsole, sogar mit Progressbar:

Delphi-Quellcode:

program ConsoleWithHTTP;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows,
  IdHTTP,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient;

const
  PROGRESSBARLENGHT = 50;

type
  TConsoleApplication = class
  private
    { Private-Deklarationen }
    FHTTP: TIdHTTP;
    FWorkMax: integer;
    FCon: TextFile;
    function ProgressBar(APos, AMax: integer): string;
    procedure WriteBack(AStr: string);
    procedure WriteLine(AStr: string);
    procedure NewLine;
  public
    { Public-Deklarationen }
    procedure Execute;
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Integer);
    procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    constructor Create;
    destructor Destroy; override;
  end;

{ TConsoleApplication }

constructor TConsoleApplication.Create;
begin
  AssignFile(FCon, 'CON:');
  Rewrite(FCon);
end;

destructor TConsoleApplication.Destroy;
begin
  FHTTP.Free;
  inherited Destroy;
end;

procedure TConsoleApplication.Execute;
var
  s: string;
begin
  FHTTP := TIdHTTP.Create(nil);
  FHTTP.OnWork := HTTPWork;
  FHTTP.OnWorkBegin := HTTPWorkBegin;
  FHTTP.OnWorkEnd := HTTPWorkEnd;

  WriteLine('Get http://www.bsnx.net/');
  s := FHTTP.Get('http://www.bsnx.net/');

  WriteLine(inttostr(Length(s))+' Bytes uebertragen.');

  readln;
end;

procedure TConsoleApplication.HTTPWork(ASender: TObject;
  AWorkMode: TWorkMode; AWorkCount: Integer);
begin
  WriteBack(ProgressBar(AWorkCount, FWorkMax));
end;

procedure TConsoleApplication.HTTPWorkBegin(ASender: TObject;
  AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
  FWorkMax := AWorkCountMax;
  NewLine;
end;

procedure TConsoleApplication.HTTPWorkEnd(ASender: TObject;
  AWorkMode: TWorkMode);
begin
  NewLine;
end;

procedure TConsoleApplication.NewLine;
begin
  writeln(FCon);
end;

function TConsoleApplication.ProgressBar(APos, AMax: integer): string;
var
  i, c, m: integer;
begin
  m := PROGRESSBARLENGHT;
  result := '';
  c := round((APos / AMax)*100);
  c := c div (100 div m);
  for i := 0 to m-1 do begin
    if i<c then begin
      result := result + '#';
    end else begin
      result := result + '_';
    end;
  end;
  result := '['+result+']';
end;

procedure TConsoleApplication.WriteBack(AStr: string);
begin
  Write(FCon, #13, AStr);
end;

procedure TConsoleApplication.WriteLine(AStr: string);
begin
  Write(FCon, AStr);
end;

var
  App: TConsoleApplication;

begin
  App:= TConsoleApplication.Create;
  try
    App.Execute;
  finally
    App.Free;
  end;
end.

Du wirst bei der Deklaration der Events feststellen dass hinten noch ein 'of object' daranhängt. Das bedeutet es wird noch ein weiterer Parameter übergeben, die Instanz der Klasse. Sonst weiss das Programm nicht welche Instanz gemeint ist... Das bedeutet natürlich du musst eine Klasse anlegen...

mfg, Björn