unit UploaderTask; interface uses Windows, IdHTTP, SysUtils, Classes, IdSchedulerOfThreadPool, IdTask, IdThread, IdYarn, IdMultipartFormData; type TUploaderTask = class(TIdTask) private FThread: TIdThread; FRemote, FLocal: string; FIdHTTP: TIdHTTP; FTime: Integer; FSuccess: Boolean; public constructor Create(ARemote, ALocal: string; AYarn: TIdYarn); destructor Destroy; override; procedure AfterRun; override; // procedure BeforeRun; override; function Run: Boolean; override; end; TFacesUploaderTask = class(TIdTask) private FThread: TIdThread; FRemote: string; FFiles: TStrings; FIdHTTP: TIdHTTP; FTime: Integer; FSuccess: Boolean; FOnCompleted: TNotifyEvent; FData: TObject; procedure SetOnCompleted(const Value: TNotifyEvent); procedure SetDate(const Value: TObject); protected procedure DoCompleted; public constructor Create(ARemote: string; const AFiles: TStrings; AYarn: TIdYarn); destructor Destroy; override; procedure AfterRun; override; procedure BeforeRun; override; function Run: Boolean; override; property OnCompleted: TNotifyEvent read FOnCompleted write SetOnCompleted; property Success: Boolean read FSuccess; property Data: TObject read FData write SetDate; end; implementation uses ShareUtils, LoggerImport, IdURI, Forms, MainFrm, IdSchedulerOfThread; { TUploaderTask } procedure TUploaderTask.AfterRun; begin FreeAndNil(Self); end; constructor TUploaderTask.Create(ARemote, ALocal: string; AYarn: TIdYarn); begin FRemote := ARemote; FLocal := ALocal; FThread := TIdYarnOfThread(AYarn).Thread; inherited Create(AYarn); end; destructor TUploaderTask.Destroy; begin inherited; end; function TUploaderTask.Run: Boolean; var FileStream: TIdMultiPartFormDataStream; begin try Result := False; FileStream := TIdMultiPartFormDataStream.Create; FileStream.AddFile('file1', FLocal, ''); FIdHTTP := TIdHTTP.Create(nil); FIdHTTP.Request.ContentType := 'multipart/form-data'; FIdHTTP.Post(FRemote, FileStream); Result := True; FSuccess := True; except on E: Exception do begin if (FTime <= 0) and (not FThread.Terminated) then Result := True; Dec(FTime); FileStream.Free; FreeAndNil(FIdHTTP); Error(E.Message, 'TUploaderTask.Run'); end; end; FileStream.Free; FreeAndNil(FIdHTTP); end; { TFacesUploaderTask } procedure TFacesUploaderTask.AfterRun; begin if not FThread.Terminated then FThread.Synchronize(DoCompleted); Free; end; procedure TFacesUploaderTask.BeforeRun; begin inherited; end; constructor TFacesUploaderTask.Create(ARemote: string; const AFiles: TStrings; AYarn: TIdYarn); begin FRemote := ARemote; FFiles := TStringList.Create; if Assigned(AFiles) then FFiles.AddStrings(AFiles); FThread := TIdYarnOfThread(AYarn).Thread; FIdHTTP := TIdHTTP.Create(nil); FIdHTTP.Request.ContentType := 'multipart/form-data'; inherited Create(AYarn); end; destructor TFacesUploaderTask.Destroy; begin FFiles.Free; FIdHTTP.Free; inherited; end; procedure TFacesUploaderTask.DoCompleted; begin if Assigned(FOnCompleted) then FOnCompleted(Self); end; function TFacesUploaderTask.Run: Boolean; var FileStream: TIdMultiPartFormDataStream; i: Integer; begin try Result := False; for I := 0 to FFiles.Count - 1 do if FileExists(FFiles[i]) then begin if FThread.Terminated then Exit; FileStream := TIdMultiPartFormDataStream.Create; FileStream.AddFile('file1', FFiles[i], ''); FIdHTTP.Post(FRemote, FileStream); FreeAndNil(FileStream); end; Result := True; FSuccess := True; except on E: Exception do begin if (FTime <= 0) and (not FThread.Terminated) then Result := True; Dec(FTime); FileStream.Free; Error(E.Message, 'TUploaderTask.Run'); end; end; if Assigned(FileStream) then FileStream.Free; end; procedure TFacesUploaderTask.SetDate(const Value: TObject); begin FData := Value; end; procedure TFacesUploaderTask.SetOnCompleted(const Value: TNotifyEvent); begin FOnCompleted := Value; end; end.