delphi 同盘移动文件所用时间测试(文件大小约6,083,545,088 字节)
delphi 同盘移动文件所用时间测试(文件大小约6,083,545,088 字节)
由于想做个 "delphi桌面图标清理备份与恢复"
所以有必要测试一下各种方法对文件移动占用时间的影响
unit Unit1;
//桌面图标备份、恢复与清理
{
1 创建3个文件夹
C:\Users\Public\Desktop
D:\Personal\AutoRun\Desktoplnk\DesktopBak
D:\Personal\AutoRun\Desktoplnk\DesktopLnk
2 移动 C:\Users\Public\Desktop 中的文件和文件夹到
D:\Personal\AutoRun\Desktoplnk\DesktopBak
3 移动 D:\Personal\桌面 中的文件和文件夹到
D:\Personal\AutoRun\Desktoplnk\DesktopBak
4 复制 D:\Personal\AutoRun\Desktoplnk\DesktopLnk 到
C:\Users\Public\Desktop 中
}
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ShellAPI,
StdCtrls;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
procedure ShellFileOperation(fromFile: string; toFile: string; Flags: Integer);
//FO_MOVE移动文件夹,FO_Copy复制文件夹(不覆盖)
var
shellinfo : TSHFileOpStructA;
begin
with shellinfo do
begin
wnd := Application.Handle;
wFunc := Flags;
pFrom := PChar(fromFile);
pTo := PChar(toFile);
end;
SHFileOperation(shellinfo);
end;
procedure CopyFileByFolder(Ahandle: THandle; fromDir,
toDir: string);
var
SHFileOpStruct : TSHFileOpStruct;
pFromDir, pToDir : PAnsiChar;
begin
GetMem(pFromDir, Length(fromDir) + 2);
try
GetMem(pToDir, Length(toDir) + 2);
try
FillChar(pFromDir^, Length(fromDir) + 2, 0);
FillChar(pToDir^, Length(toDir) + 2, 0);
StrCopy(pFromDir, PChar(fromDir));
StrCopy(pToDir, PChar(toDir));
with SHFileOpStruct do
begin
Wnd := AHandle; // Assign the window handle
wFunc := FO_COPY; // Specify a file copy
pFrom := pFromDir;
pTo := pToDir;
fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
fAnyOperationsAborted := True;
hNameMappings := nil;
lpszProgressTitle := nil;
if SHFileOperation(SHFileOpStruct) <> 0 then
RaiseLastWin32Error;
end;
finally
FreeMem(pToDir, Length(ToDir) + 2);
end;
finally
FreeMem(pFromDir, Length(FromDir) + 2);
end;
end;
procedure DeleteDirFile(ADir: string);
var
sr : TsearchRec;
begin
if not DirectoryExists(ADir) then Exit;
try
if FindFirst(ADir + '*.*', faAnyFile, sr) = 0 then
begin
repeat
DeleteFile(PAnsiChar(ADir + sr.Name));
until FindNext(sr) <> 0;
end;
finally
FindClose(sr);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Dir : string;
BakDir : string;
begin
// 1 创建3个文件夹
// C: \Users\Public\Desktop
// D: \Personal\AutoRun\Desktoplnk\DesktopBak
// D: \Personal\AutoRun\Desktoplnk\DesktopLnk
Dir := 'C:\Users\Public\Desktop';
if not DirectoryExists(dir) then
ForceDirectories(dir);
BakDir := 'D:\Personal\AutoRun\Desktoplnk\DesktopBak\' +
Formatdatetime('yyyymmddhhnnss', Now());
if not DirectoryExists(BakDir) then
ForceDirectories(BakDir);
Dir := 'D:\Personal\AutoRun\Desktoplnk\DesktopLnk';
if not DirectoryExists(dir) then
ForceDirectories(dir);
//2 移动 C:\Users\Public\Desktop 中的文件和文件夹到
//D:\Personal\AutoRun\Desktoplnk\DesktopBak
ShellFileOperation('C:\Users\Public\Desktop\*.*',
BakDir, FO_move);
CopyFileByFolder(Self.Handle, 'C:\Users\Public\Desktop\*.*',
BakDir);
DeleteDirFile('C:\Users\Public\Desktop');
// 3 移动 D:\Personal\桌面 中的文件和文件夹到
// D: \Personal\AutoRun\Desktoplnk\DesktopBak
ShellFileOperation('D:\Personal\桌面\*.*',
BakDir, FO_move);
// 4 复制 D: \Personal\AutoRun\Desktoplnk\DesktopLnk 到
// C: \Users\Public\Desktop 中
CopyFileByFolder(Self.Handle, 'D:\Personal\AutoRun\Desktoplnk\DesktopLnk\*.*',
'C:\Users\Public\Desktop\');
{如果目标文件存在, True: 失败; False: 覆盖}
Application.Terminate;
end;
end.
///////////////////////////////////////////////////////
BAT批处理版
REM 创建目录
md D:\Personal\桌面bak\
REM 备份桌面文件
start /min xcopy /e /c /i /q /r /y C:\Users\Public\Desktop\*.* D:\Personal\桌面bak\
xcopy /e /c /i /q /r /y C:\Users\Public\Desktop\*.* D:\Personal\桌面bak\
xcopy /e /c /i /q /r /y C:\Users\Public\Desktop\*.* D:\Personal\桌面bak\
start /min xcopy /e /c /i /q /r /y D:\Personal\桌面\*.* D:\Personal\桌面bak\
xcopy /e /c /i /q /r /y D:\Personal\桌面\*.* D:\Personal\桌面bak\
xcopy /e /c /i /q /r /y D:\Personal\桌面\*.* D:\Personal\桌面bak\
REM 清理桌面文件
REM 跳转到D:盘
D:
REM 改变当前目录以便使用deltree.exe
cd D:\Personal\AutoRun\清理桌面图标
start /min deltree /y C:\Users\Public\Desktop\*.*
start /min deltree /y D:\Personal\桌面\*.*
deltree /y C:\Users\Public\Desktop\*.*
deltree /y D:\Personal\桌面\*.*
REM 恢复桌面默认图标
start /min xcopy /e /c /i /q /r /y D:\Personal\AutoRun\清理桌面图标\桌面图标备份\*.* C:\Users\Public\Desktop\
xcopy /e /c /i /q /r /y D:\Personal\AutoRun\清理桌面图标\桌面图标备份\*.* C:\Users\Public\Desktop\
exit
