RealICQClient/Client/FileTransimt/UploaderTask.pas

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;


  inherited Create(AYarn);
end;

destructor TFacesUploaderTask.Destroy;
begin
  FFiles.Free;

  inherited;
end;

procedure TFacesUploaderTask.DoCompleted;
begin
  if Assigned(FOnCompleted) then
    FOnCompleted(Self);
end;

function TFacesUploaderTask.Run: Boolean;
var
  FileStream: TIdMultiPartFormDataStream;
  i: Integer;
begin
  if FFiles.Count = 0 then
  begin
    Result := False;
    Exit;
  end;
  try
    FIdHTTP := TIdHTTP.Create(nil);
    FileStream := TIdMultiPartFormDataStream.Create;
    FIdHTTP.Request.ContentType := 'multipart/form-data';
    Result := True;       
    for I := 0 to FFiles.Count - 1 do
      if FileExists(FFiles[i]) then
      begin
        if FThread.Terminated then
          Exit;                     

        FileStream.AddFile('file1', FFiles[i], '');
        FIdHTTP.Post(FRemote, FileStream);
        FreeAndNil(FileStream);
      end;
    Result := False;
    FSuccess := True;
  except
    on E: Exception do
    begin
      if (FTime <= 0) and (not FThread.Terminated) then
        Result := False;
      Dec(FTime);
      FileStream.Free;
      FIdHTTP.Free;
      Error(E.Message, 'TUploaderTask.Run');
    end;
  end;
  FileStream.Free;
  FIdHTTP.Free;
end;

procedure TFacesUploaderTask.SetDate(const Value: TObject);
begin
  FData := Value;
end;

procedure TFacesUploaderTask.SetOnCompleted(const Value: TNotifyEvent);
begin
  FOnCompleted := Value;
end;

end.