socket数据传输中,如何显示进度条?

Question

在数据传送中如何显示进度条呢

Answer 1

procedure TFrmMain.TransFile(filename: string);
var
  Ftrans: file of Byte;
  Flen: Integer;
  BlockNum, RemainLen: Integer;
  BlockBuf: array[0..BlockLen - 1] of Byte;
  i: Integer;
  SendLen: Integer;
begin
  AssignFile(Ftrans, filename);
  Reset(Ftrans);
  Flen := FileSize(Ftrans);
  BlockNum := Flen div BlockLen;
  ProgressBar.Max := 1 + BlockNum;                //进度条
  RemainLen := Flen mod BlockLen;
  StopTrans := False;
  InTrans := True;
  SendLen := 1;
  for i := 0 to BlockNum - 1 do
  begin
    if (StopTrans) or (SendLen <= 0) then Break;
    BlockRead(Ftrans, BlockBuf[0], BlockLen);
    SendLen := send(Client, BlockBuf, BlockLen, 0);
    ProgressBar.Position := i;
    Application.ProcessMessages;
  end;
  if StopTrans then
  begin
    CloseFile(Ftrans);
    InTrans := False;
    StatusBar.SimpleText := '';
    MessageBox(Handle, '停止传输！', '提示', MB_OK);
    ProgressBar.Position := 0;
    Exit;
  end;
  if (SendLen <= 0) then
  begin
    CloseFile(Ftrans);
    InTrans := False;
    StatusBar.SimpleText := '';
    MessageBox(Handle, '传输异常终止！', '提示', MB_OK);
    ProgressBar.Position := 0;
    Exit;
  end;
  if RemainLen > 0 then
  begin
    BlockRead(Ftrans, BlockBuf[0], RemainLen);
    SendLen := send(Client, BlockBuf, RemainLen, 0);
    if (SendLen <= 0) then
    begin
      CloseFile(Ftrans);
      InTrans := False;
      StatusBar.SimpleText := '';
      MessageBox(Handle, '传输异常终止！', '提示', MB_OK);
      ProgressBar.Position := 0;
      Exit;
    end;
  end;
  ProgressBar.Position := ProgressBar.Max;
  CloseFile(Ftrans);
  InTrans := False;
  StatusBar.SimpleText := '';
  MessageBox(Handle, '传输完成！', '提示', MB_OK);
  ProgressBar.Position := 0;
end;

Answer 2

unit MainFrm;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ComCtrls, Gauges;type
  TMainForm = class(TForm)
    prbCopy: TProgressBar;
    btnCopy: TButton;
    procedure btnCopyClick(Sender: TObject);
  end;var
  MainForm: TMainForm;implementation{$R *.DFM}procedure TMainForm.btnCopyClick(Sender: TObject);
var
  SrcFile, DestFile: File;
  BytesRead, BytesWritten, TotalRead: Integer;
  Buffer: array[1..500] of byte;
  FSize: Integer;
begin
  { Assign both the source and destination files to their
    respective file variables }
  AssignFile(SrcFile, 'srcfile.tst');
  AssignFile(DestFile, 'destfile.tst');
  // Open the source file for read access.
  Reset(SrcFile, 1);
  try
    // Open destination file for write access.
    Rewrite(DestFile, 1);
    try
      { Encapsulate this into a try..except so that we can erase the file if
        an error occurs. }
      try
        // Initialize total bytes read to zero.
        TotalRead := 0;
        // Obtain the filesize of the source file
        FSize := FileSize(SrcFile);
        { Read SizeOf(Buffer) bytes from the source file
          and add these bytes to the destination file. Repeat this
          process until all bytes have been read from the source
          file. A progress bar is provided to show the progress of the
          copy operation. }
        repeat
          BlockRead(SrcFile, Buffer, SizeOf(Buffer), BytesRead);
          if BytesRead > 0 then
          begin
            BlockWrite(DestFile, Buffer, BytesRead, BytesWritten);
            if BytesRead <> BytesWritten then
              raise Exception.Create('Error copying file')
            else begin
              TotalRead := TotalRead + BytesRead;
              prbCopy.Position := Trunc(TotalRead / Fsize) * 100;
              prbCopy.Update;
            end;
          end
        until BytesRead = 0;
      except
        { On an exception, erase the destination file as it may be
          corrupt. Then re-raise the exception. }
        Erase(DestFile);
        raise;
      end;
    finally
      CloseFile(DestFile); // Close the destination file.
    end;
  finally
    CloseFile(SrcFile);   // Close the source file.
  end;
end;end.