Created
March 10, 2020 09:33
-
-
Save HemulGM/7aaa6f740e613b1f1f1880360caa182e to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit uDownload; | |
interface | |
uses | |
Winapi.Windows, | |
System.SysUtils, | |
System.Classes, | |
IdComponent, | |
IdHTTP; | |
type | |
TDownThread = class; | |
TOnWorkBeginEvent = procedure(Sender: TDownThread; AWorkCountMax: Int64) of object; | |
TOnWorkEvent = procedure(Sender: TDownThread; AWorkCount: Int64) of object; | |
TOnWorkFinish = procedure(Sender: TDownThread; ResponseCode: Integer) of object; | |
TDownThread = class(TThread) | |
private | |
HTTP: TIdHTTP; | |
FOnWorkBeginEvent: TOnWorkBeginEvent; | |
FOnWorkEvent: TOnWorkEvent; | |
FOnWorkFinish: TOnWorkFinish; | |
FResponseCode: Integer; | |
FURL: string; | |
FFileName: string; | |
FWorkCountMax: Integer; | |
FWorkCount: Integer; | |
FID: Integer; | |
procedure InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); | |
procedure InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); | |
procedure DoNotifyFinish; | |
procedure DoNotifyWorkBegin; | |
procedure DoNotifyWork; | |
procedure SetID(const Value: Integer); | |
protected | |
procedure Execute; override; | |
public | |
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 OnWorkFinish: TOnWorkFinish read FOnWorkFinish write FOnWorkFinish; | |
property ID: Integer read FID write SetID; | |
end; | |
implementation | |
constructor TDownThread.Create; | |
begin | |
inherited Create(True); | |
HTTP := TIdHTTP.Create(nil); | |
with HTTP do | |
begin | |
OnWorkBegin := InternalOnWorkBegin; | |
OnWork := InternalOnWork; | |
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 | |
lStream.Free; | |
end; | |
Synchronize(DoNotifyFinish); | |
end; | |
procedure TDownThread.DoNotifyFinish; | |
begin | |
if Assigned(OnWorkFinish) then | |
OnWorkFinish(Self, FResponseCode); | |
end; | |
procedure TDownThread.DoNotifyWorkBegin; | |
begin | |
if Assigned(OnWorkBegin) then | |
OnWorkBegin(Self, FWorkCountMax); | |
end; | |
procedure TDownThread.DoNotifyWork; | |
begin | |
if Assigned(OnWork) then | |
OnWork(Self, FWorkCount); | |
end; | |
procedure TDownThread.InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); | |
begin | |
FWorkCountMax := AWorkCountMax; | |
Synchronize(DoNotifyWorkBegin); | |
end; | |
procedure TDownThread.SetID(const Value: Integer); | |
begin | |
FID := Value; | |
end; | |
procedure TDownThread.InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); | |
begin | |
FWorkCount := AWorkCount; | |
Synchronize(DoNotifyWork); | |
end; | |
end. | |
// --- Использование | |
with TDownThread.Create(True) do | |
begin | |
FreeOnTerminate := True; | |
OnWork := OnThreadWork; | |
OnWorkBegin := OnThreadWorkBegin; | |
OnWorkFinish := OnThreadWorkFinish; | |
URL := Item.URL; | |
FileName := Item.FileName; | |
ID := Item.ID_DOWNLOAD; | |
Start; | |
end; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment