Events eines IdHttp in einem Thread

pRoTeUs · Beiträge: 47 Windows XP prof Delphi 2005 prof

Hallo,

das Problem hat nur indirekt mit dem Thema Netzwerk zu tun, also falls es hier im falschen Themengebiet ist bitte verschieben.

Folgendes:

- Ich erstelle einen Thread und lade in ihm eine Datei mittels IdHttp runter

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:

unit DownloadThread;

interface

uses
  Classes, IdHttp, IdComponent;

type
  TDownloadThread = class(TThread)
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  end;

implementation

{ TDownloadThread }

procedure TDownloadThread.Execute;
var IdHttp1: TIdHttp; RS: TFileStream;
begin
  { Thread-Code hier einfügen }
  IdHttp1:=TIdHttp.Create;
  RS:=TFileStream.Create('Index.html', fmcreate);
  IdHttp1.Get('http://www.google.de/index.html', RS);
  RS.Free;
end;

end.

und rufe das ganze folgendermaßen auf:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

procedure TForm1.Button1Click(Sender: TObject);
var Thread1: TDownloadThread;
begin
Thread1:=TDownloadThread.Create(false);
end;

Funktioniert auch soweit alles perfekt.

Nur wie kann ich im Thread die Events des IdHttp, zb. OnWork usw. abfangen?

Grüße
pRoTeUs

Sprint · Beiträge: 849

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:

unit DownloadThread;

interface

uses Windows, SysUtils, Classes, IdHTTP, IdComponent, SyncObjs;

type
  TThreadWorkEvent = procedure(Sender: TThread; AWorkMode: TWorkMode; const AWorkCount: Integer)
   of object;
  TWorkBeginEvent = procedure(Sender: TObject; AWorkMode: TWorkMode;
   const AWorkCountMax: Integer) of object;

type
  TDownloadThread = class(TThread)
  private
    FIdHTTP: TIdHTTP;
    FWorkEvent: TThreadWorkEvent;
    FURL: String;
    FFileName: String;
    FWorkCountMax: Integer;
    procedure InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    property URL: String read FURL write FURL;
    property FileName: String read FFileName write FFileName;
    property WorkCountMax: Integer read FWorkCountMax;
    property OnWork: TThreadWorkEvent read FWorkEvent write FWorkEvent;
  end;

implementation

var
  Lock: TCriticalSection;

{--------------------------------------------------------------------------------------------------}

constructor TDownloadThread.Create;
begin

  inherited Create(True);
  FIdHTTP := TIdHTTP.Create(nil);
  FIdHTTP.OnWork := InternalOnWork;
  FIdHTTP.OnWorkBegin := InternalOnWorkBegin;

end;

{--------------------------------------------------------------------------------------------------}

destructor TDownloadThread.Destroy;
begin

  FIdHTTP.Free;
  inherited;

end;

{--------------------------------------------------------------------------------------------------}

procedure TDownloadThread.Execute;
var
  Handle: THandle;
  FS: TFileStream;
begin

  Handle := FileCreate(FileName);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    FS := TFileStream.Create(Handle);
    try
      FIdHTTP.Get(FURL, FS);
    finally
      FS.Free;
    end;
  end;

end;

{--------------------------------------------------------------------------------------------------}

procedure TDownloadThread.InternalOnWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin

  Lock.Acquire;
    if Assigned(FWorkEvent) then
      FWorkEvent(Self, AWorkMode, AWorkCount);
  Lock.Release;
  
end;

{--------------------------------------------------------------------------------------------------}

procedure TDownloadThread.InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin

  FWorkCountMax := AWorkCountMax;

end;

{--------------------------------------------------------------------------------------------------}

initialization
  Lock := TCriticalSection.Create;

finalization
  Lock.Free;

{--------------------------------------------------------------------------------------------------}

end.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DownloadThread, IdComponent;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    Thread1: TDownloadThread;
    Thread2: TDownloadThread;
    Thread3: TDownloadThread;
    procedure OnWork(Sender: TThread; AWorkMode: TWorkMode; const AWorkCount: Integer);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{--------------------------------------------------------------------------------------------------}

procedure TForm1.OnWork(Sender: TThread; AWorkMode: TWorkMode; const AWorkCount: Integer);
const
  S_MSG = '%d Bytes von Insgesamt %d Bytes downgeloadet.';
begin

  if Sender = Thread1 then
    Label1.Caption := Format(S_MSG, [AWorkCount, (Sender as TDownloadThread).WorkCountMax])
  else if Sender = Thread2 then
    Label2.Caption := Format(S_MSG, [AWorkCount, (Sender as TDownloadThread).WorkCountMax])
  else if Sender = Thread3 then
    Label3.Caption := Format(S_MSG, [AWorkCount, (Sender as TDownloadThread).WorkCountMax]);

end;

{--------------------------------------------------------------------------------------------------}

procedure TForm1.Button1Click(Sender: TObject);
const
  S_PATH = 'http://info.borland.com/devsupport/delphi/download_files/german/';
begin

  Thread1 := TDownloadThread.Create;
  with Thread1 do
  begin
    FreeOnTerminate := True;
    OnWork := Self.OnWork;
    URL := S_PATH + 'dstd302.exe';
    FileName := 'C:\TEMP\dstd302.exe';
    Resume;
  end;

  Thread2 := TDownloadThread.Create;
  with Thread2 do
  begin
    FreeOnTerminate := True;
    OnWork := Self.OnWork;
    URL := S_PATH + 'dpro302.exe';
    FileName := 'C:\TEMP\dpro302.exe';
    Resume;
  end;

  Thread3 := TDownloadThread.Create;
  with Thread3 do
  begin
    FreeOnTerminate := True;
    OnWork := Self.OnWork;
    URL := S_PATH + 'dcs302.exe';
    FileName := 'C:\TEMP\dcs302.exe';
    Resume;
  end;

end;

{--------------------------------------------------------------------------------------------------}

end.

Ein Beispiel auf die schnelle... Feinheiten musst du selber anpassen. Hab's auch nicht großartig getestet. Wenn du Fragen hast, dann frag'.

_________________
Ciao, Sprint.

pRoTeUs · Beiträge: 47 Windows XP prof Delphi 2005 prof

Vielen Dank für die schnelle Hilfe. :!:

Ich werds gleich mal ausprobieren.

Udontknow · Beiträge: 2596 Win7 D2006 WIN32, .NET (C#)

Hallo!

Vorsicht! Hier wird NICHT synchronisiert! Das Benutzen einer TCriticalSection-Instanz bringt nichts, wenn sich nicht alle auf die gemeinsamen Elemente zugreifenden Threads daran halten (sprich : Lock und Aquire aufrufen), und der VCL-Hauptthread tut das eben nicht! Daher unbedingt zusätzlich Synchronize einsetzen, um Events an den VCL-Hauptthread zu reichen. Sonst ist der Zugriff auf Steuerelemente im Event ein Russisch-Roulette-Spiel. :wink:

Cu,
Udontknow

pRoTeUs · Beiträge: 47 Windows XP prof Delphi 2005 prof

Dank für den Tip.

Hier ist noch ein Fehler im Quelltext:

markieren

Delphi-Quelltext

1:
2:

  FIdHTTP.OnWork := InternalOnWork;
  FIdHTTP.OnWorkBegin := InternalOnWorkBegin;

Fehlermeldung: [Fehler] DownloadThread.pas(47): E2009 Inkompatible Typen: 'Liste der Parameter ist unterschiedlich'

Master_of_Magic · Beiträge: 56 Win 98, Win XP D6 Pers, D2005 Arch

Ich grab den Thread-Thread (ich weiß, der war schlecht :wink:

) hier mal wieder aus. Da ich selber nach dem Problem gesucht habe, hab ich mal versucht, das obere mit Synchronize umzusetzen. Da ich aber erst Anfänger in Sachen Threads bin, würde ich euch bitten, mir etwas Feedback zum Code zu geben. Kann ich etwas vereinfachen, wo könnten Probleme entstehen oder wo ist mein Stil schlecht ... ich hab das Gefühl, das ich die Synchronizes im Thread etwas umständlich implementiert habe

Thread-Unit:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:

unit UDownThread;

interface

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

type
  //external prototypes
  TOnWorkBeginEvent = procedure(Sender: TThread; AWorkCountMax: Integer) of object;
  TOnWorkEvent = procedure(Sender: TThread; AWorkCount: Integer) of object;
  TOnFinish = procedure(Sender: TObject; ResponseCode: Integer) of object;

  TDownThread = class(TThread)
  private
    { Private declarations }
    HTTP: TIdHTTP;
    //external
    FOnWorkBeginEvent: TOnWorkBeginEvent;
    FOnWorkEvent: TOnWorkEvent;
    FOnFinish: TOnFinish;

    FResponseCode: Integer;
    FURL: string;
    FFileName: String;
    FWorkCountMax: Integer;
    FWorkCount: Integer;
    procedure InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
    procedure InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
    procedure DoNotifyFinish;
    procedure DoNotifyWorkBegin;
    procedure DoNotifyWork;
  protected
    procedure Execute; override;
  public
    { Public declarations }
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property URL: String read FURL write FURL;
    property FileName: String read FFileName write FFileName;
    property WorkCountMax: Integer read FWorkCountMax;
    property OnWork: TOnWorkEvent read FOnWorkEvent write FOnWorkEvent;
    property OnWorkBegin: TOnWorkBeginEvent read FOnWorkBeginEvent write FOnWorkBeginEvent;
    property OnFinish: TOnFinish read FOnFinish write FOnFinish;
  end;

implementation

uses UUpdater;

constructor TDownThread.Create;
begin
  inherited Create(True);
  HTTP := TIdHTTP.Create(nil);   // HTTP-Kompo wird dynamisch erstellt
  with HTTP do
  begin
    OnWorkBegin := InternalOnWorkBegin;
    OnWork := InternalOnWork;
//    HTTP.IOHandler.RecvBufferSize:=4096; //löst AccessViolation aus !?!
  end;
end;

destructor TDownThread.Destroy;
begin
  HTTP.Free;
  inherited Destroy;
end;

procedure TDownThread.Execute;
var
  lStream: TFileStream;
begin
  lStream:=TFileStream.Create(FileName, fmCreate or fmShareDenyNone);
  try
    HTTP.Get(FURL, lStream);
    FResponseCode := HTTP.ResponseCode;
  finally
    if Assigned(lStream) then lStream.Free;
  end;
  Synchronize(DoNotifyFinish);
end;

procedure TDownThread.DoNotifyFinish;
begin
  if Assigned(OnFinish) then OnFinish(Self, FResponseCode);
end;
//##############################################################################
procedure TDownThread.InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
  FWorkCountMax := AWorkCountMax;
  Synchronize(DoNotifyWorkBegin);
end;

procedure TDownThread.DoNotifyWorkBegin;
begin
  if Assigned(OnWorkBegin) then OnWorkBegin(Self, FWorkCountMax);
end;
//##############################################################################
procedure TDownThread.InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  Synchronize(DoNotifyWork);
end;

procedure TDownThread.DoNotifyWork;
begin
  if Assigned(OnWork) then OnWork(Self, FWorkCount);
end;

end.

Aufruf-Unit (Main-Form):

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:

unit UUpdater;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  xpman, Gauges, ComCtrls, UDownThread, zlib;

type
  TForm1 = class(TForm)
    msg: TMemo;
    startdownload: TButton;
    exit: TButton;
    Progress: TProgressBar;
    SpeedLabel: TLabel;
    Status: TLabel;
    procedure startdownloadClick(Sender: TObject);
  private
    { Private declarations }
    StartTime: Cardinal;
    procedure download(wwwurl: string);
    procedure OnThreadWork(Sender: TThread; AWorkCount: Integer);
    procedure OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
    procedure DownResultHandle(Sender: TObject; ResponseCode: Integer);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.OnThreadWork(Sender: TThread; AWorkCount: Integer);
var
  speed: single;
begin
  Progress.Position := AWorkCount;
  speed := AWorkCount/(GetTickCount - StartTime + 1); //+1 um DivbyZero zu verhindern
  Status.caption := Format('%f s|%.2f KB/s', [(((Sender as TDownThread).WorkCountMax-AWorkCount)/1000)/speed, speed]);
end;

procedure TForm1.OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
begin
  Progress.Max := AWorkCountMax;
  msg.Lines.Append(FormatFloat('Dateigröße: 0, Bytes', AWorkCountMax));
  StartTime := GetTickCount;
end;

procedure TForm1.download(wwwurl: string);
var
  path: string;
  Down: TDownThread;
begin
  path := ExtractFilePath(paramstr(0)) + 'Update\file.zip';
  Status.Caption := '';
  Progress.Position := 0;

  msg.Lines.Append('Downloade Datei ' + path);

  Down := TDownThread.Create(true);
  with Down do
  begin
    FreeOnTerminate := true;
    OnWork := OnThreadWork;
    OnWorkBegin := OnThreadWorkBegin;
    OnFinish := DownResultHandle;
    URL := wwwurl;
    FileName := path;
    Resume;
  end;
end;

procedure TForm1.startdownloadClick(Sender: TObject);
begin
  msg.Lines.Append('--------------------------');
  msg.Lines.Append('Starte Download ...');
  download(link);
end;

procedure TForm1.DownResultHandle(Sender: TObject; ResponseCode: Integer);
begin
  msg.Lines.Append('Download abgeschlossen');
  SpeedLabel.Caption := 'Fertig';
  showmessage(IntToStr(ResponseCode));
end;

end.

Ich hab die unwichtigen Dinge rausgeschnitten - der Code sollte hoffentlich trotzdem noch gehen.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme