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