interface
uses
- Classes, IdHttp, IdException, SysUtils, Dialogs;
+ Classes, IdHttp, IdException, SysUtils, Dialogs, IdComponent;
type
+ THttpWorkEvent = procedure(Sender: TObject; LoadBytes: integer) of object;
+
THTTPDownloadThread = class(TThread)
private
{ Private \90é\8c¾ }
FOnSuccess: TNotifyEvent;
FOnConnectionFailed: TNotifyEvent;
FLastErrorMessage: String;
+ FOnHttpWork: THttpWorkEvent;
+ FLoadBytes: integer;
+ FLastTriggeredLoadBytes: integer;
+ FTriggerWorkEventBy: integer;
procedure SetProxyPort(const Value: integer);
procedure SetProxyServer(const Value: String);
procedure SetOnConnectionFailed(const Value: TNotifyEvent);
procedure SetOnSuccess(const Value: TNotifyEvent);
+ procedure SetOnHttpWork(const Value: THttpWorkEvent);
+ procedure WorkHandler(Sender: TObject; AWorkMode: TWorkMode;
+ const AWorkCount: Integer);
+ procedure SetTriggerWorkEventBy(const Value: integer);
protected
procedure Execute; override;
procedure DoSuccess;
procedure DoConnectionFailed;
+ procedure DoHttpWork;
public
constructor Create(const Host, URL, Post: String); reintroduce;
property RecvString: String read FRecvString;
property ProxyPort: integer read FProxyPort write SetProxyPort;
property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write SetOnConnectionFailed;
property OnSuccess: TNotifyEvent read FOnSuccess write SetOnSuccess;
+ property OnHttpWork: THttpWorkEvent read FOnHttpWork write SetOnHttpWork;
property LastErrorMessage: String read FLastErrorMessage;
+ property TriggerWorkEventBy: integer read FTriggerWorkEventBy write SetTriggerWorkEventBy;
end;
implementation
FHost := Host;
FURL := URL;
FPost := Post;
+ FTriggerWorkEventBy := 1024; // KB\92P\88Ê\82ÅOnHttpWork\83C\83x\83\93\83g\94\90¶
end;
procedure THTTPDownloadThread.DoConnectionFailed;
FOnConnectionFailed(self);
end;
+procedure THTTPDownloadThread.DoHttpWork;
+begin
+ FOnHttpWork(self, FLoadBytes);
+end;
+
procedure THTTPDownloadThread.DoSuccess;
begin
FOnSuccess(self);
begin
Http := nil;
TmpStr := nil;
+ FLoadBytes := 0;
+ FLastTriggeredLoadBytes := 0;
try
try
Http := TIdHTTP.Create(nil);
Http.Host := FHost;
Http.ProxyParams.ProxyServer := ProxyServer;
Http.ProxyParams.ProxyPort := ProxyPort;
+ Http.OnWork := WorkHandler;
if FPost = '' then begin
FRecvString := Http.Get(FURL);
end else begin
FOnConnectionFailed := Value;
end;
+procedure THTTPDownloadThread.SetOnHttpWork(const Value: THttpWorkEvent);
+begin
+ FOnHttpWork := Value;
+end;
+
procedure THTTPDownloadThread.SetOnSuccess(const Value: TNotifyEvent);
begin
FOnSuccess := Value;
raise EIdException.Create('Tried to change proxy without suspending');
end;
+procedure THTTPDownloadThread.SetTriggerWorkEventBy(const Value: integer);
+begin
+ FTriggerWorkEventBy := Value;
+end;
+
+procedure THTTPDownloadThread.WorkHandler(Sender: TObject;
+ AWorkMode: TWorkMode; const AWorkCount: Integer);
+begin
+ if AWorkMode = wmRead then
+ //Inc(FLoadBytes, AWorkCount);
+ FLoadBytes := AWorkCount;
+ if (FLastTriggeredLoadBytes div FTriggerWorkEventBy) <>
+ (FLoadBytes div FTriggerWorkEventBy) then begin
+ if Assigned(FOnHttpWork) then Synchronize(DoHttpWork);
+ FLastTriggeredLoadBytes := FLoadBytes;
+ end;
+end;
+
end.