复制文件时,如何显示进度条

简介: procedure mycopyfile(sourcef,targetf:string;i:integer);var       FromF,ToF:file;       NumRead,NumWritten:Integer;       Buf:array[1.

procedure mycopyfile(sourcef,targetf:string;i:integer);
var
       FromF,ToF:file;
       NumRead,NumWritten:Integer;
       Buf:array[1..2048] of Char;
       n:integer;
begin
         AssignFile(FromF,sourcef);
         Reset(FromF,    1); {    Record    size    =    1    }
         AssignFile(ToF,targetf); {    Open    output    file    }
         Rewrite(ToF,    1); {    Record    size    =    1    }
         n:=0;  
         repeat
                   BlockRead(FromF,    Buf,    SizeOf(Buf),    NumRead);
                   form1.ProgressBar1.Position:=sizeof(buf)*n*100    div    FileSize(FromF)*i div 4;
                   application.ProcessMessages;
                   //显示进度
                   BlockWrite(ToF,    Buf,    NumRead,    NumWritten);
                   inc(n);
           until    (NumRead    =    0)    or    (NumWritten    <>    NumRead);
           form1.ProgressBar1.Position:=100;
           CloseFile(FromF);
           CloseFile(ToF);
end;
====================================================================================

以下例子是关于delphi复制文件,加上进度条的方法的例子的关键代码:

procedure TForm1.Button1Click(Sender: TObject);
const
  getPath = 'c:/temp/get.rar';
  setPath = 'c:/temp/set.rar';
var
  getStream,setStream: TFileStream;
  num, n: Integer;
  buf: PByte;
  BufSize,block: Integer;
begin

  if not FileExists(getPath) then
  begin
    ShowMessage('源文件不存在');
    Exit;
  end;

  getStream := TFileStream.Create(getPath, fmOpenRead or fmShareExclusive);
  setStream := TFileStream.Create(setPath, fmCreate);

  num := getStream.Size;
  setStream.Size := num;
  getStream.Position := 0;
  setStream.Position := 0;

  BufSize := num;
  block := BufSize div 100;
  GetMem(buf, BufSize);

  ProgressBar1.Max := 100;
  ProgressBar1.Min := 0;
  ProgressBar1.Position := 0;

  while num <> 0 do
  begin
    Application.ProcessMessages;
    n := block;
    if n > num then n := num;
    getStream.ReadBuffer(buf^, n);
    setStream.WriteBuffer(buf^, n);
    ProgressBar1.Position := Trunc((1 - num / BufSize) * 100);
    Dec(num, n);
  end;

  FreeMem(buf, BufSize);
  getStream.Free;
  setStream.Free;

  ShowMessage('复制完毕');
  ProgressBar1.Position := 0;
end;

end.

 

相关文章
|
SQL 机器学习/深度学习 存储
七大经典技术场景!Apache Flink 在多维领域应用的 40+ 实践案例
随着 Apache Flink 自身的发展,越来越多的企业选择 Apache Flink 应用于自身的业务场景,如底层平台建设、实时数仓、实时推荐、实时分析、实时大屏、风控、数据湖等场景中,解决实时计算的需求。
七大经典技术场景!Apache Flink 在多维领域应用的 40+ 实践案例
将ASD光谱仪的.asd文件转为文本文件
将ASD光谱仪的.asd文件转为文本文件
|
11月前
|
人工智能 搜索推荐 API
Perplexica:开源 AI 搜索引擎,Perplexity AI 的开源替代品,支持多种搜索模式、实时信息更新
Perplexica 是一款开源的 AI 驱动搜索引擎,支持多种搜索模式和实时信息更新,适用于个人、学术和企业等不同场景。
1091 6
Perplexica:开源 AI 搜索引擎,Perplexity AI 的开源替代品,支持多种搜索模式、实时信息更新
|
机器学习/深度学习 分布式计算 PyTorch
构建可扩展的深度学习系统:PyTorch 与分布式计算
【8月更文第29天】随着数据量和模型复杂度的增加,单个GPU或CPU已无法满足大规模深度学习模型的训练需求。分布式计算提供了一种解决方案,能够有效地利用多台机器上的多个GPU进行并行训练,显著加快训练速度。本文将探讨如何使用PyTorch框架实现深度学习模型的分布式训练,并通过一个具体的示例展示整个过程。
510 0
|
运维 Devops 持续交付
现代运维的转型:从传统模式到DevOps的演进
本文将探讨现代IT运维领域正在经历的一场深刻变革:从传统的运维模式向DevOps文化和实践的转型。通过分析传统运维的挑战、新兴技术的推动力以及DevOps的核心理念,本文旨在为读者提供一个全面的视角,理解如何通过这一转型实现效率提升、风险降低和更高的业务价值。
388 33
|
网络协议
TCP连接的关键之谜:揭秘三次握手的必要性
在这篇文章中,我们将深入探讨TCP连接建立过程中的关键步骤——三次握手。三次握手是确保客户端和服务端之间建立可靠连接的重要过程。通过三次握手,双方可以确认彼此的接收和发送能力,并同步双方的初始序列号,从而确保连接的稳定性和可靠性。文章还解释了三次握手的原因,它可以避免历史重复连接的初始化,确保双方都收到可靠的初始序列号,并避免资源浪费和消息滞留的问题。通过三次握手,TCP连接可以保证数据的准确性和完整性,确保通信的可靠性。
326 1
TCP连接的关键之谜:揭秘三次握手的必要性
|
域名解析 网络协议 应用服务中间件
免费试用的服务器无法通过公网IP访问Web网页,怎么配置才能正确呢
免费试用的服务器无法通过公网IP访问Web网页,怎么配置才能正确呢
328 0
|
人工智能 Serverless
构建AI助手:利用阿里云云函数计算FC快速构建“通义千问”
本文介绍了如何利用阿里云云函数计算(FC)快速构建一个强大的通义千问AI助手。通过阅读本文,您将能够利用阿里云云函数计算(FC)快速体验义千问AI助手。
5016 1
|
大数据 数据库连接 DataX
基于mac构建大数据伪分布式学习环境(十二)-部署DataX+DataX Web
本文主要讲解阿里异构多数据源迁移工具DataX与其web管理界面部署
798 0
|
存储 监控 负载均衡
阿里云上云方案:Web与移动App云上部署解决方案及服务指南
对于绝大部分的上云用户来说,部署Web与移动App是最常见的,很多新手用户不知道上云时该如何选择阿里云产品与配置,为此,阿里云专门针对这部分用户的需求推出了Web与移动App云上部署解决方案,下面是方案详情介绍。
1313 0
阿里云上云方案:Web与移动App云上部署解决方案及服务指南