文档章节

带进度的文件复制 - 回复 "冷风无泪" 的问题

涂孟超
 涂孟超
发布于 2014/09/26 15:34
字数 267
阅读 8
收藏 0
问题来源: http://www.cnblogs.com/del/archive/2008/12/02/1066817.html#1389078

本例效果图:



代码文件:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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.

 
 
 
 
 

 

 

  
窗体文件:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 104
  ClientWidth = 265
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 96
    Top = 56
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ProgressBar1: TProgressBar
    Left = 8
    Top = 16
    Width = 249
    Height = 17
    TabOrder = 1
  end
end

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2008/12/02/1346281.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
如何用js+html+server端代码实现上传文件并带进度条

查了不少资料,包括oschina上的例子,好像没有什么很好的办法实现文档上传并带进度条。 具体来说,目前我遇到的问题就是在上传时,不知道如何获取上传文档的大小。这样就没法显示比例。是不是...

lns
2012/02/01
4.2K
3
比加班还令程序员厌恶的事情有哪些?

加班,对于程序员来说是家常便饭,更是万分厌恶和时常用来自嘲的事情。但是,你以为加班就是最令程序员讨厌的事情了吗? 以下几件,可是件件都能让程序员欲哭无泪、头皮发麻、咬牙切齿! 产品...

uw63zqpkxwlrl1
03/10
0
0
为开发者和设计者准备的 HTML5 文件上传教程

本文主要是收集了一些使用 HTML5 进行文件上传的教程: 纯 HTML5 文件上传 带进度条的 HTML5 文件上传 HTML5 拖放式文件上传的 API 教程 全新的 HTML5 多文件上传 使用 jQuery 的 HTML5 文件...

红薯
2012/01/18
2.2K
4
仿写映客直播--TJPYingKe

仿映客直播 app,基于 IJKPlayer 的直播 demo。 功能更新: pch文件绝对路径改为相对路径 导航栏标签为接口返回数据,不再为固定数据 添加了轮播图,以及带进度条的webView 细节优化,首页UI更新...

五仁月饼
2017/03/17
1K
0
阿里RDS开发专家解析MySQL各版本并行复制

MySQL并行复制已经是老生常谈,我从2010年开始就着手处理线上这个问题,刚开始两三年也乐此不疲地分享。现在再提这个话题有点“炒冷饭”的感觉。然而,又把它拎出来谈,是因为有些同学觉得“...

林晓斌
2016/01/21
0
0

没有更多内容

加载失败,请刷新页面

加载更多

Mac OS X下Maven的安装与配置

Mac OS X 安装Maven: 下载 Maven, 并解压到某个目录。例如/Users/robbie/apache-maven-3.3.3 打开Terminal,输入以下命令,设置Maven classpath $ vi ~/.bash_profile 添加下列两行代码,之后...

TonyStarkSir
今天
3
0
关于编程,你的练习是不是有效的?

最近由于工作及Solution项目的影响,我在重新学习DDD和领域建模的一些知识。然后,我突然就想到了这个问题,以及我是怎么做的? 对于我来说,提升技能的项目会有四种: 纯兴趣驱动的项目。即...

问题终结者
今天
4
0
打开eclipse出现an error has occurred see the log file

解决方法: 1,打开eclipse安装目录下的eclipse.ini文件; 2,打开的文本文件最后添加一行 --add-modules=ALL-SYSTEM 3,保存重新打开Eclipse。...

任梁荣
昨天
4
0
搞定Northwind示例数据库,无论哪个版本的SQLServer都受用

Northwind数据库 从这里可以找到突破口: http://social.msdn.microsoft.com/Forums/zh-CN/Vsexpressvb/thread/8490a1c6-9018-40c9-aafb-df9f79d29cde 下面是MSDN: http://msdn2.microsoft......

QQZZFT
昨天
1
0
mysql主从同步,安装配置操作

准备 两台mysql服务,我这里准备了如下: 主库:192.168.176.128 从库:192.168.176.131 如何在Linux上安装mysql服务,请看https://blog.csdn.net/qq_18860653/article/details/80250499 操作...

小致dad
昨天
5
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部