Delphi Resumable Upload (Stream Override)

unit Unit1;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, Math, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
    IdMultipartFormData, IdCoderMIME, IdGlobal, IdCustomHTTPServer;

type
  TIdEventStream2 = class(TIdEventStream)
  protected
        FPosition      : Int64;
        FInitialOffset : Int64;
  private
        procedure SeekTheStream(const AOffset : Int64; AOrigin : TSeekOrigin; var VPosition : Int64);
        procedure ReadTheStream(var VBuffer : TIdBytes; AOffset, ACount : Longint; var VResult : Longint);
  public
        constructor Create(InitialPosition : Int64);
        function    AddFormField(AFieldName, AFileName : String; AContentType : String = '') : TIdFormDataField;
  end;

  TForm1 = class(TForm)
    UploadBtn: TButton;
    procedure UploadFile(FileName : String);
    procedure UploadBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
   Form1 : TForm1;

implementation

{$R *.dfm}

// ------------------------------------------------------------------------------ //
procedure TIdEventStream2.ReadTheStream(var VBuffer : TIdBytes; AOffset, ACount : Longint; var VResult : Longint);
begin
     // Implement custom read stream...
     if (FPosition >= 0) And (ACount >= 0) then
     begin
          VResult := (Size - FPosition - FInitialOffset);
          if (VResult > 0) then
          begin
               if (VResult > ACount) then VResult := ACount;

               // ******** CUSTOM READ IN PROGRESS (START) ********
               // Read(VBuffer, VResult);
               {ACount  := Longint(IndyMin(Int64(ACount), Size - StartPos));
               VResult := TIdStreamHelper.ReadBytes(FSourceStream, VBuffer, ACount, AOffset + StartPos);  // }

               // Move(Pointer(Longint(Memory) + FPosition)^, VBuffer, VResult);
               // ******** CUSTOM READ IN PROGRESS (END) ********

               Inc(FPosition, VResult);

               Exit;
          end;
     end;

     VResult      := 0;
end;
// ------------------------------------------------------------------------------ //
procedure TIdEventStream2.SeekTheStream(const AOffset : Int64; AOrigin : TSeekOrigin; var VPosition : Int64);
begin
     // Implement custom seek...
     VPosition := 0;

     case AOrigin of
        soBeginning :
        begin
             if (AOffset = 0) then
                VPosition       := FInitialOffset;
             else
                 VPosition      := FPosition;
        end;

        soCurrent   : VPosition := FPosition;

        soEnd       :
        begin
             if (AOffset = 0) then
             begin
                  // CalculateSize;
                  VPosition     := (Size - FInitialOffset);
             end
             else
                 VPosition      := FPosition;
        end;
     end;    // case

end;
// ------------------------------------------------------------------------------ //
function TIdEventStream2.AddFormField(AFieldName, AFileName : String; AContentType : String = '') : TIdFormDataField;
var
   TheItem : TIdFormDataField;
begin
     TheItem              := FFields.Add;  // <-- Should I copy all the FFields code???

     with TheItem do
     begin
          FieldName       := AFieldName;
          FileName        := ExtractFileName(AFileName);
          // FieldStream     := AFieldValue;  // FieldValue      := AFieldValue;
          if AContentType <> '' then
             ContentType  := AContentType
          else
              ContentType := sContentTypeTextPlain;

          ContentTransfer := sContentTransferQuotedPrintable;
     end;    // with

     Result               := TheItem;
end;
// ------------------------------------------------------------------------------ //
constructor TIdEventStream2.Create(InitialPosition : Int64);
begin
     FPosition      := InitialPosition;
     FInitialOffset := InitialPosition;
end;
// ------------------------------------------------------------------------------ //
procedure TForm1.UploadFile(FileName : String);
var
   IdHTTP   : TIdHTTP;
   Stream   : TIdEventStream2{TIdMultipartFormDataStream};
   StartPos : Int64;
begin
     // Upload File

     IdHTTP                  := TIdHTTP.Create(nil);
     try
        with IdHTTP do
        begin
             HTTPOptions     := [hoForceEncodeParams];
             AllowCookies    := True;
             HandleRedirects := True;
             ProtocolVersion := pv1_1;
        end;    // with

        // Get resume offset/point
        IdHttp.Head('http://localhost/_tests/resume/large-file.bin');
        StartPos            := IdHttp.Response.ContentLength;
        Caption             := Format('Upload starting/resuming from byte %d', [StartPos]);

        // =========== //
        // Upload File //
        // =========== //
        Stream              := TIdEventStream2.Create(StartPos);
        try
           with Stream do
           begin
                OnRead      := ReadTheStream;
                OnSeek      := SeekTheStream;

                with AddFormField('upload_file', FileName, 'application/octet-stream') do
                begin
                     HeaderCharset  := 'utf-8';
                     HeaderEncoding := '8';
                end;    // with
           end;    // with

           with IdHTTP do
           begin
                IOHandler.LargeStream := True;
                Post('http://localhost/_tests/resume/t1.php', Stream);
           end;    // with
        finally
               FreeAndNil(Stream);
        end;    // try/finally
     finally
            FreeAndNil(IdHTTP);
     end;    // try/finally
end;
// ------------------------------------------------------------------------------ //
procedure TForm1.UploadBtnClick(Sender: TObject);
begin
     UploadFile('B:\_Test\large-file.bin');
end;
// ------------------------------------------------------------------------------ //
end.