在 Delphi 中使用AmazonAPI获取文件上传的进度

我使用Data.Cloud.AmazonAPI中的DataObject将一些文件上传到AWS S3，它可以工作，但是我如何在上传或下载时获得进度信息？这是我的代码：

function ByteContent(DataStream: TStream): TBytes;
var
  Buffer: TBytes;
begin
  if not Assigned(DataStream) then
    exit(nil);

  SetLength(Buffer, DataStream.Size);
  DataStream.Position := 0;
  
  if DataStream.Size > 0 then
    DataStream.Read(Buffer[0], DataStream.Size);

  Result := Buffer;
end;

function TForm1.UploadFile(LocalFilePath: string; RemoteFileName: string; Bucket: string): Boolean;
var
  Service: TAmazonStorageService;
  ConAmazon: TAmazonConnectionInfo;
  FS: TFileStream;
  Content: TBytes;
begin
  try
    ConAmazon := TAmazonConnectionInfo.Create(nil);
    ConAmazon.AccountKey := 'MtJqIM7WyjJA*********************';
    ConAmazon.AccountName := 'AKIAIXVAH*********';
    ConAmazon.QueueEndpoint := 'queue.amazonaws.com';
    ConAmazon.StorageEndpoint := 's3-eu-west-1.amazonaws.com';
    ConAmazon.TableEndpoint := 'sdb.amazonaws.com';
    ConAmazon.UseDefaultEndpoints := True;
    Service := TAmazonStorageService.Create(ConAmazon);
    if FileExists(LocalFilePath) then
    begin
      FS := TFileStream.Create(LocalFilePath, fmOpenRead);
      Content := ByteContent(FS);
      FS.Free;
      Result := Service.UploadObject(Bucket, RemoteFileName, Content, True, nil, nil, amzbaPrivate, nil, OnProgress);
    end
    else
      Result := False;
  finally
    ConAmazon.Free;
    Service.Free;
  end;
end;

Can I monitor the progress of an S3 download using the Cloud.AmazonAPI?上传的方法与此类似，但你需要创建TAmazonStorageService子类，如下所示

type
  TProgressAmazonStorageService = class(TAmazonStorageService)
     function IssuePutRequest(URL: string; Headers: TStringList;
                             QueryParameters: TStringList; const QueryPrefix: string;
                             ResponseInfo: TCloudResponseInfo;
                             Content: TStream; out ResponseString: string): TCloudHTTP; overload; override;
  end;

function TProgressAmazonStorageService.IssuePutRequest(URL: string; Headers: TStringList;
                             QueryParameters: TStringList; const QueryPrefix: string;
                             ResponseInfo: TCloudResponseInfo;
                             Content: TStream; out ResponseString: string): TCloudHTTP;
var
  ProgressStream: TProgressStream;
begin
  Result := PrepareRequest('PUT', Headers, QueryParameters, QueryPrefix, URL);

  try
    ProgressStream := TProgressStream.Create(Content);
    try
      ProgressStream.OnProgress := Form1.OnProgress;
      Form1.ProgressBar1.Max := Content.Size;
      Form1.ProgressBar1.Value := 0;

      if Content <> nil then
        ResponseString := Result.Put(URL, ProgressStream)
      else
        ResponseString := Result.Put(URL);
    finally
      ProgressStream.Free;
    end;

    PopulateResponseInfo(Result, ResponseInfo);
  except
    on E: Exception do
    begin
      Result.Free;
      Raise;
    end;
  end;
end;

progress函数如下所示

procedure TForm1.OnProgress(const ACount: Int64);
begin
  Form1.ProgressBar1.Value := Form1.ProgressBar1.Value + ACount;
  Application.ProcessMessages;
end;

TProgressStream像这样

type
  TOnProgressEvent = procedure(const ACount: Int64) of object;
  TProgressStream = class(TStream)
  strict private
    FStream: TStream;
  protected
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); overload; override;
    procedure SetSize(const NewSize: Int64); overload; override;
  public
    OnProgress: TOnProgressEvent;
    function Read(var Buffer; Count: Longint): Longint; overload; override;
    function Write(const Buffer; Count: Longint): Longint; overload; override;
    function Read(Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
    function Write(const Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
    function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
    constructor Create(const AStream: TStream);
  end;

constructor TProgressStream.Create(const AStream: TStream);
begin
  FStream := AStream;
end;

function TProgressStream.GetSize: Int64;
begin
  Result := FStream.Size;
end;

procedure TProgressStream.SetSize(NewSize: Longint);
begin
  FStream.Size := NewSize;
end;

procedure TProgressStream.SetSize(const NewSize: Int64);
begin
  FStream.Size := NewSize;
end;

function TProgressStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := FStream.Read(Buffer, Count);
end;

function TProgressStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := FStream.Write(Buffer, Count);
end;

function TProgressStream.Read(Buffer: TBytes; Offset, Count: Longint): Longint;
begin
  if Assigned(OnProgress) then
  begin
    OnProgress(Count);
  end;
  Result := FStream.Read(Buffer, Offset, Count);
end;

function TProgressStream.Write(const Buffer: TBytes; Offset, Count: Longint): Longint;
begin
  Result := FStream.Write(Buffer, Offset, Count);
end;

function TProgressStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  Result := FStream.Seek(Offset, Origin);
end;

function TProgressStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := FStream.Seek(Offset, Origin);
end;

在 Delphi 中使用AmazonAPI获取文件上传的进度

1条答案

相关问题

热门标签

最新问答