Копируем файл с индикатором процесса

Советы » Файлы » Копируем файл с индикатором процесса

{ 1. } 

{ 
 You need a TProgressBar on your form for this tip. 
 Fьr diesen Tip wird eine TProgressBar benцtigt. 
} 


procedure

TForm1.CopyFileWithProgressBar1(Source, Destination: string

); var

FromF, ToF: file

of

byte; Buffer: array

[0..4096] of

char; NumRead: integer; FileLength: longint; begin

AssignFile(FromF, Source); reset(FromF); AssignFile(ToF, Destination); rewrite(ToF); FileLength := FileSize(FromF); with

Progressbar1 do

begin

Min := 0; Max := FileLength; while

FileLength > 0 do

begin

BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead); FileLength := FileLength - NumRead; BlockWrite(ToF, Buffer[0], NumRead); Position := Position + NumRead; end

; CloseFile(FromF); CloseFile(ToF); end

; end

; procedure

TForm1.Button1Click(Sender: TObject); begin

CopyFileWithProgressBar1('c:WindowsWelcome.exe', 'c: empWelcome.exe'); end

; { 2. } {***************************************} // To show the estimated time to copy a file: procedure

TForm1.CopyFileWithProgressBar1(Source, Destination: string

); var

FromF, ToF: file

of

byte; Buffer: array

[0..4096] of

char; NumRead: integer; FileLength: longint; t1, t2: DWORD; maxi: integer; begin

AssignFile(FromF, Source); reset(FromF); AssignFile(ToF, Destination); rewrite(ToF); FileLength := FileSize(FromF); with

Progressbar1 do

begin

Min := 0; Max := FileLength; t1 := TimeGetTime; maxi := Max div

4096; while

FileLength > 0 do

begin

BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead); FileLength := FileLength - NumRead; BlockWrite(ToF, Buffer[0], NumRead); t2 := TimeGetTime; Min := Min + 1; // Show the time in Label1 label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100); Application.ProcessMessages; Position := Position + NumRead; end

; CloseFile(FromF); CloseFile(ToF); end

; end

; { 3. } {***************************************} // To show the estimated time to copy a file, using a callback function: type

TCallBack = procedure

(Position, Size: Longint); { export; } procedure

FastFileCopy(const

InFileName, OutFileName: string

; CallBack: TCallBack); implementation

procedure

FastFileCopyCallBack(Position, Size: Longint); begin

Form1.ProgressBar1.Max := Size; Form1.ProgressBar1.Position := Position; end

; procedure

FastFileCopy(const

InFileName, OutFileName: string

; CallBack: TCallBack); const

BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results } type

PBuffer = ^TBuffer; TBuffer = array

[1..BufSize] of

Byte; var

Size: DWORD; Buffer: PBuffer; infile, outfile: file

; SizeDone, SizeFile: LongInt; begin

if

(InFileName <> OutFileName) then

begin

buffer := nil

; Assign(infile, InFileName); Reset(infile, 1); try

SizeFile := FileSize(infile); Assign(outfile, OutFileName); Rewrite(outfile, 1); try

SizeDone := 0; New(Buffer); repeat

BlockRead(infile, Buffer^, BufSize, Size); Inc(SizeDone, Size); CallBack(SizeDone, SizeFile); BlockWrite(outfile, Buffer^, Size) until

Size < BufSize; FileSetDate(TFileRec(outfile).Handle, FileGetDate(TFileRec(infile).Handle)); finally

if

Buffer <> nil

then

Dispose(Buffer); CloseFile(outfile) end

; finally

CloseFile(infile); end

; end

else

raise

EInOutError.Create('File cannot be copied onto itself') end

; {FastFileCopy} procedure

TForm1.Button1Click(Sender: TObject); begin

FastFileCopy('c:daten.txt', 'c: estdaten2.txt', @FastFileCopyCallBack); end

; { 4. } {***************************************} function

CopyFileWithProgressBar2(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason: DWORD; hSourceFile, hDestinationFile: THandle; lpData: Pointer): DWORD; stdcall

; begin

// just set size at the beginning if

dwCallbackReason = CALLBACK_STREAM_SWITCH then

TProgressBar(lpData).Max := TotalFileSize.QuadPart; TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart; Application.ProcessMessages; Result := PROGRESS_CONTINUE; end

; function

TForm1.CopyWithProgress(sSource, sDest: string

): Boolean; begin

// set this FCancelled to true, if you want to cancel the copy operation FCancelled := False

; Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2, ProgressBar1, @FCancelled, 0); end

; end

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com