帶進度條複製檔案代替copyfile

Tomato131發表於2024-08-05

代替copyfile,效率會低,少用,並且不適合大檔案。
unit UnitCopy;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons,
ActiveX,
Comobj,
ShlObj,
TlHelp32,
Winapi.ShellAPI, Vcl.ComCtrls;

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
ProgressBar1: TProgressBar;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Procedure myFileCopy(const SourceFile, TargetFile: string);
var
SourceF, TargetF: file;
iRead, iWrite: integer;
Buf: array[1..2048] of char;
FS: TFileStream;
isize:Integer;
begin
FS := TFileStream.Create(SourceFile, fmShareDenyNone);
isize:=FS.Size;
FS.Free;
//用ProgressBar控制元件
Form1.ProgressBar1.Position:=0;
Form1.ProgressBar1.Max:=isize;
Application.ProcessMessages;

AssignFile(SourceF, SourceFile);
reset(SourceF,1);
AssignFile(TargetF, TargetFile);
Rewrite(TargetF,1);
repeat
BlockRead(SourceF, Buf, sizeof(Buf), iRead);
BlockWrite(TargetF, Buf, iRead, iWrite);
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+iWrite;
Application.ProcessMessages;
until (iRead = 0) or (iWrite <> iRead);
closefile(SourceF);
closefile(TargetF);
end;

procedure myFileCopy2(const SourceFile, TargetFile: string);
var
SourceF,TargetF: TFileStream;
num, n: Integer;
buf: PByte;
block: Integer;
begin
if FileExists(TargetFile) then
DeleteFile(TargetFile);
SourceF := TFileStream.Create(SourceFile, fmOpenRead or fmShareExclusive);
TargetF := TFileStream.Create(TargetFile, fmCreate);
num := SourceF.Size;
//TargetF.Size := num;
SourceF.Position := 0;
//TargetF.Position := 0;
block := num div 100;
GetMem(buf, block);
Form1.ProgressBar1.Max := 100;
Form1.ProgressBar1.Min := 0;
Form1.ProgressBar1.Position := 0;
while num <> 0 do
begin
Application.ProcessMessages;
n := block;
if n > num then n := num;
SourceF.ReadBuffer(buf^, n);
TargetF.WriteBuffer(buf^, n);
Form1.ProgressBar1.Position := Trunc((1 - num / SourceF.Size) * 100);
Dec(num, n);
end;
SourceF.Free;
TargetF.Free;
Form1.ProgressBar1.Position := 100;
end;

procedure CloseThread(exename:string);
var
lppe: TProcessEntry32;
snapshothandle:THandle;
f:boolean;
pid:DWord;
ProcessName:string;
begin
ProcessName:=exename;
snapshothandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
lppe.dwSize:=Sizeof(lppe);
f:=Process32First(snapshothandle,lppe);
While f do
begin
if UpperCase( ChangeFileExt(ProcessName,'') )=UpperCase( ChangeFileExt(StrPas(lppe.szExeFile),'') ) then
begin
pid:=lppe.th32ProcessID;
TerminateProcess(OpenProcess(Process_Terminate,false,pid),0);
end;
f:=Process32Next(snapshothandle,lppe);
end;
CloseHandle(snapshothandle);
end;

procedure myyanshi(haomiao: Cardinal);
var t:Int64;
begin
t:=GetTickCount64();
while GetTickCount64()-t<haomiao do
begin
Sleep(5);
application.ProcessMessages;
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
//關閉主程式,引數名程序的顯示名稱即exe的名稱
CloseThread('資料上傳.exe');
myyanshi(1000);
//複製文字並替換
DeleteFile('D:\AD未備份20230619\資料上傳.exe');
CopyFile( '\192.168.0.241\ljk\資料上傳.exe','D:\AD未備份20230619\資料上傳.exe',False);
myyanshi(1000);
//開啟
ShellExecute(self.Handle,'open',PChar('D:\AD未備份20230619\資料上傳.exe'),'','',SW_SHOWNORMAL );
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
myFileCopy('C:\晶片\kang.rar','c:\kang.mp4');
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
myFileCopy2('c:\ljk.mp4','c:\kang.mp4');
end;

end.

相關文章