Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Samples/Extended File Transfer/ExtendedFileTransferClientUploadThread.pas

unit ExtendedFileTransferClientUploadThread;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  uROClient, uROClientIntf, uRORemoteService, uROBinMessage,
   uROIndyTCPChannel, uROIndyHTTPChannel,
  ExtendedFileTransferLibrary_Intf, uROTypes;

type

  { TROThread }
  TUploadThread = class(TThread)
  private
    fROMessage: TROBinMessage;
    fROChannel: TROIndyHTTPChannel;
    fRORemoteService: TRORemoteService;
    fOnAbort: TNotifyEvent;
    fOnFinished: TNotifyEvent;
    fOnProgress: TNotifyEvent;
    fOnStartUpload: TNotifyEvent;
    fOnError: TNotifyEvent;
    fFileName: string;
    fUploadOK: Boolean;
    fFileSize: Int64;
    fCurrentBytePos: Int64;
    fTimeStarted: TDateTime;
    fFileService: IExtendedFileTransferService;
    fErrorText: string;
    fInfoStr: string;
    fMaxConnectionErrors, fChannelErrorscount: Integer;
    procedure Runupload;
    function GetUploadChunk(FileMemStream: TMemoryStream; aSize: Int64;
      const Sequence: Integer): Binary;
    procedure ROIndyChannelFailure(Sender: TROTransportChannel;
      anException: Exception; var Retry: Boolean);
    procedure Run;

  protected
  public
    property UploadOK: Boolean read fUploadOK;
    property FileSize: Int64 read fFileSize;
    property CurrentBytePos: Int64 read fCurrentBytePos;
    property TimeStarted: TDateTime read fTimeStarted;
    property ErrorText: string read fErrortext;
    property Filename: string read fFilename;
    property InfoStr: string read fInfoStr;
    constructor Create(aFileName: string; aOnStartUpload, aOnProgress,
      aOnFinished, aOnAbort, aOnError: TNotifyEvent);
    destructor Destroy; override;

    procedure Execute; override;
  end;

implementation
uses ExtendedFileTransferClientMain;

{ TROThread }

constructor TUploadThread.Create(aFileName: string; aOnStartUpload, aOnProgress,
  aOnFinished, aOnAbort, aOnError: TNotifyEvent);
begin
  inherited Create(TRUE);
  fFilename := aFilename;
  fmaxconnectionerrors := 5; //try 5 times on channel-error

  fROMessage := TROBinMessage.Create(nil);
  fROChannel := TROIndyHTTPChannel.Create(nil);
  fROChannel.OnFailure := ROIndyChannelFailure;
  fROChannel.TargetURL :=ExtendedFileTransferClientMainForm.ROChannel.TargetURL;

  fRORemoteService := TRORemoteService.Create(nil);
  fRORemoteService.Channel := fROChannel;
  fRORemoteService.Message := fROMessage;
  fRORemoteService.ServiceName := 'ExtendedFileTransferService';
  fFileService := fRORemoteService as IExtendedFileTransferService;

  if assigned(aOnAbort) then fOnAbort := aOnAbort;
  if assigned(aOnFinished) then fOnFinished := aOnFinished;
  if assigned(aOnProgress) then fOnProgress := aOnProgress;
  if assigned(aOnStartUpload) then fOnStartUpload := aOnStartUpload;
  if assigned(aOnError) then fOnError := aOnError;
  FreeOnTerminate:=True;
  Resume;
end;

destructor TUploadThread.Destroy;
begin
  fFileService := nil;
  FreeAndNil(fROMessage);
  FreeAndNil(fROChannel);
  FreeAndNil(fRORemoteService);
  inherited;
end;

procedure TUploadThread.Run;
begin
  try
    RunUpload;
  finally
    if assigned(fOnFinished) then fOnFinished(Self);
  end;
end;

procedure TUploadThread.Execute;
begin
  Run;
end;

function TUploadThread.GetUploadChunk(FileMemStream: TMemoryStream; aSize:
  Int64; const Sequence: Integer): Binary;
const
  Block: Integer = 65536;
var
  Position: Int64;
begin
  Result := Binary.Create;
  Position := Block * (Sequence - 1);
  if Position <= aSize then begin
    FileMemStream.Position := Position;
    if Position + Block > aSize then
      Result.CopyFrom(FileMemStream, aSize - Position)
    else
      Result.CopyFrom(FileMemStream, Block);
  end;
end;

procedure TUploadThread.Runupload;
var
  FileMemStream: TMemoryStream;
  Chunk: Binary;
  Sequence: Int64;
  isfirst: Boolean;
begin
  fErrorText := '';
  fUploadOK := false;
  fChannelErrorscount := 0;
  fCurrentBytePos := 0;
  Sequence := 1;
  fTimeStarted := Now;
  FileMemStream := nil;
  isfirst := true;
  try

    if FileExists(fFilename) then try
      FileMemStream := TMemoryStream.Create;

      FileMemStream.LoadFromFile(fFileName);
      fFileName := ExtractFileName(fFileName);

      fFileSize := FileMemStream.Size;

      fInfoStr := DateTimetoStr(fTimeStarted) + ' ' +
        fFileName + ' ' +
        FloatToStrF(Filesize / 1024, fffixed, 15, 1) + ' KB';

      if assigned(fOnStartUpload) then fOnStartUpload(Self);
      Chunk := GetUploadChunk(FileMemStream, fFileSize, Sequence);
      Inc(fCurrentBytePos, Chunk.Size);
      Inc(Sequence);
      try
        fFileService.uploadChunk(isfirst, fFileName, Chunk);
        FreeAndNil(Chunk);
        isfirst := false;
        Chunk := GetUploadChunk(FileMemStream, fFileSize, Sequence);
        while Chunk.Size > 0 do begin

          if Terminated then begin
            if assigned(fOnAbort) then fOnAbort(Self);
            exit;
          end;

          fFileService.uploadChunk(isfirst, fFileName, Chunk);

          Inc(fCurrentBytePos, Chunk.Size);
          FreeAndNil(Chunk);

          Inc(Sequence);
          if assigned(fOnProgress) then fOnProgress(Self);
          Chunk := GetUploadChunk(FileMemStream, fFileSize, Sequence);
        end;

        fUploadOK := (FileSize = 0) or (FileSize = CurrentBytePos);
      finally
        FreeAndNil(Chunk);
      end;
    finally
      FileMemStream.Free;
    end;

  except
    on e: Exception do begin
      fErrorText := e.Message;
      if assigned(fOnError) then fOnError(Self);
    end;
  end;
end;

procedure TUploadThread.ROIndyChannelFailure(Sender: TROTransportChannel;
  anException: Exception; var Retry: Boolean);
begin
  if fChannelErrorscount > fMaxConnectionerrors then begin
    fErrorText := anException.Message;
    Self.terminate;
  end
  else begin
    inc(fChannelErrorscount);
    sleep(1000);
    Retry := true;
  end;
end;

end.