formupload.pas

利用winhttp post 上传文件

unit FormUpload;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinHTTP, ExtCtrls, ComCtrls, Buttons, Math;

type
  TfrmFilesUpload = class(TForm)
    WinHTTP: TWinHTTP;
    btnUpload: TButton;
    prbAllFilesUpload: TProgressBar;
    lvwUploadFiles: TListView;
    prbSingleFileUpload: TProgressBar;
    lblFile: TLabel;
    lblFileName: TLabel;
    lblTotalProgress: TLabel;
    lblAllFilesProgress: TLabel;
    btnCancel: TBitBtn;
    Bevel: TBevel;
    lblUploadSpeed: TLabel;
    lblUploadRate: TLabel;
    lblFileList: TLabel;
    procedure btnUploadClick(Sender: TObject);
    procedure WinHTTPUploadFieldRequest(Sender: TObject; FileIndex: Word;
      UploadStream: TMemoryStream; var FieldName, FileName: string);
    procedure WinHTTPHTTPError(Sender: TObject; ErrorCode: Integer;
      Stream: TStream);
    procedure WinHTTPDone(Sender: TObject; const ContentType: string;
      FileSize: Integer; Stream: TStream);
    procedure WinHTTPUploadProgress(Sender: TObject; DataSize,
      BytesTransferred, ElapsedTime, EstimatedTimeLeft: Integer;
      PercentsDone: Byte; TransferRate: Single);
    procedure FormCreate(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
  private
    FErrorCode : integer;

    FCurrUploadFileSize : integer;
    FUploadedFilesSize  : integer;

    FUploadURL : string;

    procedure DisplayTransferRate(TransferRate: Single);
    procedure SetAllFilesUploadProgress(PercentsDone: Byte);
    procedure SetSingleFileUploadProgress(BytesTransferred: Integer);
  public
    function AddUploadFile(const FileName: string; const VariantName: string =''): integer;
    procedure RemoveUploadFile(const Index : integer);
  end;

var
  frmFilesUpload: TfrmFilesUpload;

implementation

{$R *.dfm}

const
  FILENAME_INDEX = 0;
  FILESIZE_INDEX = 1;
  PROGRESS_INDEX = 2;
  VARNAME_INDEX  = 3;


function GetFileSize(const FileName : string): DWORD;
var
  f : integer;
begin
  f := FileOpen(FileName, fmOpenRead);
  try
    Result := Windows.GetFileSize(f, nil);
  finally
    FileClose(f);
  end;
  if Result = $FFFFFFFF then Result := 0;
end;

function CalcFileSizeStr(const Size : DWORD): string;
const
  GB = 1024*1024*1024;
  MB = 1024*1024;
  KB = 1024;
begin
  if Size > GB then
    Result := Format('%%.2f GB', [Size / GB])
  else if Size > MB then
    Result := Format('%.2f MB', [Size / MB])
  else if Size > KB then
    Result := Format('%.2f KB', [Size / KB])
  else
    Result := Format('%d B', [Size]);
end;

function GetFileSizeStr(const FileName : string): string;
var
  Size: DWORD;
begin
  Size := GetFileSize(FileName);
  Result :=CalcFileSizeStr(Size);
end;

//-----------------------------------------------------------------------------
function TfrmFilesUpload.AddUploadFile(const FileName, VariantName: string): integer;
begin
  Result := -1;
  if Trim(FileName) = '' then Exit;

  with lvwUploadFiles, lvwUploadFiles.Items.Add do begin
    Caption := IntToStr(Items.Count);
    SubItems.Add(FileName);
    SubItems.Add(GetFileSizeStr(FileName));
    SubItems.Add('0%');
    SubItems.Add(VariantName);
    Result := Items.Count - 1;
  end;
end;


procedure TfrmFilesUpload.RemoveUploadFile(const Index: integer);
var
  i : integer;
begin
  if Index < 0 then Exit;

  //删除并重新生成顺序号
  lvwUploadFiles.Items[Index].Delete;
  for I := 0 to lvwUploadFiles.Items.Count - 1 do
    lvwUploadFiles.Items[i].Caption := IntToStr(I + 1);

end;

procedure TfrmFilesUpload.DisplayTransferRate(TransferRate: Single);
begin
  lblUploadRate.Caption := Format('%.1f Kb/s', [TransferRate]);
end;

procedure TfrmFilesUpload.SetAllFilesUploadProgress(PercentsDone: Byte);
begin
  prbAllFilesUpload.Position := PercentsDone;
  lblAllFilesProgress.Caption := Format('%d%%', [PercentsDone]);

end;

procedure TfrmFilesUpload.SetSingleFileUploadProgress(BytesTransferred: Integer);
begin
  prbSingleFileUpload.Position := Round(BytesTransferred / FCurrUploadFileSize * 100);
  with lvwUploadFiles do begin
    Items[ItemIndex].SubItems[PROGRESS_INDEX] := format('%d%%', [prbSingleFileUpload.Position]);
    lblFileName.Caption := Items[ItemIndex].SubItems[FILENAME_INDEX];
  end;
end;

procedure TfrmFilesUpload.btnCancelClick(Sender: TObject);
begin
  if WinHttp.Busy then WinHttp.Abort(FALSE, TRUE);

  Close;
end;

procedure TfrmFilesUpload.btnUploadClick(Sender: TObject);
var
  FileCount : integer;
begin
  with lvwUploadFiles do begin
    if Items.Count < 1 then Exit;

    //初始化上传文件大小，用于计算上传进度
    ItemIndex           := 0;
    FCurrUploadFileSize := GetFileSize(Items[ItemIndex].SubItems[FILENAME_INDEX]);
    FUploadedFilesSize  := 0;

    //上传，并指定上传文件数
    FileCount := Items.Count - ItemIndex;
    WinHttp.Upload(FileCount);
  end;

  //初始化显示
  SetSingleFileUploadProgress(0);
  SetAllFilesUploadProgress(0);
  DisplayTransferRate(0);
end;

procedure TfrmFilesUpload.FormCreate(Sender: TObject);
begin
  WinHttp.URL := 'http://localhost/WebUpload/uploadfile.asp';
  AddUploadFile('D:\Sunny.jpg','aac');
  AddUploadFile('D:\Sunny.bmp','aac');

  
  lblFileName.Caption := '';
end;


procedure TfrmFilesUpload.WinHTTPDone(Sender: TObject; const ContentType: string;
  FileSize: Integer; Stream: TStream);
begin
  FErrorCode := 0;
end;

procedure TfrmFilesUpload.WinHTTPHTTPError(Sender: TObject; ErrorCode: Integer;
  Stream: TStream);
begin
  FErrorCode := ErrorCode
end;

procedure TfrmFilesUpload.WinHTTPUploadFieldRequest(Sender: TObject; FileIndex: Word;
  UploadStream: TMemoryStream; var FieldName, FileName: string);
begin
  FileName  := lvwUploadFiles.Items[FileIndex].SubItems[FILENAME_INDEX];
  FieldName := lvwUploadFiles.Items[FileIndex].SubItems[VARNAME_INDEX];

  // 生成文件数据流
  TMemoryStream(UploadStream).LoadFromFile(FileName);
end;

procedure TfrmFilesUpload.WinHTTPUploadProgress(Sender: TObject; DataSize,
  BytesTransferred, ElapsedTime, EstimatedTimeLeft: Integer; PercentsDone: Byte;
  TransferRate: Single);
begin
  //显示上传总进度及参数
  SetAllFilesUploadProgress(PercentsDone);
  DisplayTransferRate(TransferRate);

  //如果总传输字节数-已完成上传的文件的字节总数>当前文件的字节数，表示
  //当前文件文件已上传结束，因而需要设置进度为100%，接着显示下一个文件
  if  (BytesTransferred - FUploadedFilesSize) > FCurrUploadFileSize then
  begin
    //当前文件进度设为100%
    SetSingleFileUploadProgress(FCurrUploadFileSize);
    //下一个文件
    FUploadedFilesSize := FUploadedFilesSize + FCurrUploadFileSize;
    with lvwUploadFiles do begin
      ItemIndex := ItemIndex + 1;
      FCurrUploadFileSize := GetFileSize(Items[ItemIndex].SubItems[FILENAME_INDEX]);
     end;
  end;

  SetSingleFileUploadProgress(BytesTransferred - FUploadedFilesSize);
end;

end.