复制文件 - 保存而不覆盖现有文件

Question

我在做什么：

• 用户单击一个按钮，一个FileUpload组件(对话框)启动，他可以 从他的 PC 浏览并加载文件。
• 当他单击确定时，文件将保存到磁盘中，在特定 位置。
• 在保存之前，我使用一些包含以下内容的字符串重命名(或者更确切地说，使用特定名称保存)他的文件 我之前从一些数据库字段中提取的数据。

因此，无论用户加载文件时文件的名称如何，它都会与他的Firstname和LastName一起保存到磁盘中，这是我从一些字符串变量中获得的。

UniMainModule.foldername= 包含保存文件的文件夹的路径。

UniMainModule.FirstName= 包含用户的名字

UniMainModule.LastName= 包含用户的姓氏

因此，该文件将作为FirstName_LastName.pdf保存在磁盘上foldername字符串提供的位置。

这是我正在使用的代码：

procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
begin
DestFolder:=UniServerModule.StartPath+'files'+UniMainModule.foldername+'';
DestName:=DestFolder+UniMainModule.FirstName+'_'+UniMainModule.LastName+'.pdf';
CopyFile(PChar(AStream.FileName), PChar(DestName), False);
ModalResult:= mrOk;
end;

据我了解，在阅读了一些关于CopyFilemsdn传递False意味着它应该并且将覆盖现有文件。

如果该文件在该位置中尚不存在该名称，则没关系，它会保存。

但是，如果用户决定再次使用文件上传并上传新文件，则新文件将覆盖前一个文件。因为它们是用相同的名称保存的。

那么，您如何确保如果文件已经存在(该位置中存在具有该确切名称的文件)，它不会被覆盖，但我不知道，在名称或其他名称中分配了 (1)，保留两个文件？

Answer 1

循环调用CopyFile()，将其bFailIfExists参数设置为TRUE，以便在CopyFile()失败并出现ERROR_FILE_EXISTS错误代码时可以使用新文件名重试。

例如：

procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
n : integer;
begin
DestFolder := UniServerModule.StartPath + 'files' + UniMainModule.foldername + '';
DestName := UniMainModule.FirstName + '_' + UniMainModule.LastName + '.pdf';
n := 0;
while not CopyFile(PChar(AStream.FileName), PChar(DestFolder + DestName), True) do
begin
if GetLastError() <> ERROR_FILE_EXISTS then
begin
// error handling...
Break;
end;
Inc(n);
DestName := UniMainModule.FirstName + '_' + UniMainModule.LastName + ' (' + IntToStr(n) + ').pdf';
end;
ModalResult := mrOk;
end;

但是，您应该让操作系统为您完成工作，而不是手动处理此问题。特别是因为操作系统有自己的方法来重命名复制的文件，并且该命名方案可以从一个操作系统版本更改为另一个操作系统版本。

不要使用CopyFile()，而是使用SHFileOperation()，它有一个FOF_RENAMEONCOLLISION标志：

如果目标中已存在具有目标名称的文件，则在移动、复制或重命名操作中为正在操作的文件指定新名称。

例如：

uses
..., Winapi.ShellAPI;
procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
fo : TSHFileOpStruct;
begin
DestFolder := UniServerModule.StartPath + 'files' + UniMainModule.foldername + '';
DestName := DestFolder + UniMainModule.FirstName + '_' + UniMainModule.LastName + '.pdf';
ZeroMemory(@fo, SizeOf(fo));
fo.Wnd := Handle;
fo.wFunc := FO_COPY;
fo.pFrom := PChar(AStream.FileName+#0);
fo.pTo := PChar(DestName+#0);
fo.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR or FOF_RENAMEONCOLLISION;
if SHFileOperation(fo) <> 0 then
begin
// error handling...
end
else if fo.fAnyOperationsAborted then
begin
// abort handling ...
end;
ModalResult := mrOk;
end;

如果您需要知道操作系统为重命名的文件名选择了什么，还有一个FOF_WANTMAPPINGHANDLE标志：

如果指定了FOF_RENAMEONCOLLISION并且重命名了任何文件，则将包含其旧名称和新名称的名称映射对象分配给hNameMappings成员。当不再需要此对象时，必须使用SHFreeNameMappings将其释放。

例如：

uses
..., Winapi.ShellAPI;
type
PHandleToMappings = ^THandleToMappings;
THandleToMappings = record
uNumberOfMappings: UINT;                          // Number of mappings in the array.
lpSHNameMappings: array[0..0] of PSHNAMEMAPPINGW; // array of pointers to mappings.
end;
procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
fo : TSHFileOpStruct;
pMappings : PHandleToMappings;
pMapping : PSHNAMEMAPPINGW;
begin
DestFolder := UniServerModule.StartPath + 'files' + UniMainModule.foldername + '';
DestName := DestFolder + UniMainModule.FirstName + '_' + UniMainModule.LastName + '.pdf';
ZeroMemory(@fo, SizeOf(fo));
fo.Wnd := Handle;
fo.wFunc := FO_COPY;
fo.pFrom := PChar(AStream.FileName+#0);
fo.pTo := PChar(DestName+#0);
fo.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_NOCONFIRMMKDIR or FOF_RENAMEONCOLLISION or FOF_WANTMAPPINGHANDLE;
if SHFileOperation(fo) <> 0 then
begin
// error handling...
end else
begin
if fo.fAnyOperationsAborted then
begin
// abort handling...
end;
if fo.hNameMappings <> nil then
begin
try
pMappings := PHandleToMappings(fo.hNameMappings);
pMapping := pMappings^.lpSHNameMappings[0];
SetString(DestName, pMapping^.pszNewPath, pMapping^.cchNewPath);
finally
SHFreeNameMappings(THandle(fo.hNameMappings));
end;
// use DestName as needed...
end;
end;
ModalResult := mrOk;
end;

在 Vista 及更高版本上，您也可以改用IFileOperation.CopyItem()，这也支持在冲突时重命名项目。如果发生重命名冲突，可以使用IFileOperationProgressSink回调来发现新文件名。

例如：

uses
..., Winapi.ActiveX, Winapi.ShlObj, System.Win.Comobj;
type
TMyCopyProgressSink = class(TInterfacedObject, IFileOperationProgressSink)
public
CopiedName: string;
function StartOperations: HResult; stdcall;
function FinishOperations(hrResult: HResult): HResult; stdcall;
function PreRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
pszNewName: LPCWSTR): HResult; stdcall;
function PostRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
pszNewName: LPCWSTR; hrRename: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
function PreMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
hrMove: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
function PreCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
function PostCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
hrCopy: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
function PreDeleteItem(dwFlags: DWORD; const psiItem: IShellItem): HResult; stdcall;
function PostDeleteItem(dwFlags: DWORD; const psiItem: IShellItem; hrDelete: HResult;
const psiNewlyCreated: IShellItem): HResult; stdcall;
function PreNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
pszNewName: LPCWSTR): HResult; stdcall;
function PostNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD;
hrNew: HResult; const psiNewItem: IShellItem): HResult; stdcall;
function UpdateProgress(iWorkTotal: UINT; iWorkSoFar: UINT): HResult; stdcall;
function ResetTimer: HResult; stdcall;
function PauseTimer: HResult; stdcall;
function ResumeTimer: HResult; stdcall;
end;
function TMyCopyProgressSink.StartOperations: HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.FinishOperations(hrResult: HResult): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PreRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
pszNewName: LPCWSTR): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PostRenameItem(dwFlags: DWORD; const psiItem: IShellItem;
pszNewName: LPCWSTR; hrRename: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PreMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PostMoveItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
hrMove: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PreCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PostCopyItem(dwFlags: DWORD; const psiItem: IShellItem;
const psiDestinationFolder: IShellItem; pszNewName: LPCWSTR;
hrCopy: HResult; const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
CopiedName := pszNewName;
Result := S_OK;
end;
function TMyCopyProgressSink.PreDeleteItem(dwFlags: DWORD; const psiItem: IShellItem): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PostDeleteItem(dwFlags: DWORD; const psiItem: IShellItem; hrDelete: HResult;
const psiNewlyCreated: IShellItem): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PreNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
pszNewName: LPCWSTR): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PostNewItem(dwFlags: DWORD; const psiDestinationFolder: IShellItem;
pszNewName: LPCWSTR; pszTemplateName: LPCWSTR; dwFileAttributes: DWORD;
hrNew: HResult; const psiNewItem: IShellItem): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.UpdateProgress(iWorkTotal: UINT; iWorkSoFar: UINT): HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.ResetTimer: HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.PauseTimer: HResult; stdcall;
begin
Result := S_OK;
end;
function TMyCopyProgressSink.ResumeTimer: HResult; stdcall;
begin
Result := S_OK;
end;
procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
pfo : IFileOperation;
psiFrom : IShellItem;
psiTo : IShellItem;
Sink : IFileOperationProgressSink;
bAborted : BOOL;
begin
DestFolder := UniServerModule.StartPath + 'files' + UniMainModule.foldername + '';
DestName := UniMainModule.FirstName + '_' + UniMainModule.LastName + '.pdf';
try
OleCheck(SHCreateItemFromParsingName(PChar(AStream.FileName), nil, IShellItem, psiFrom));
OleCheck(SHCreateItemFromParsingName(PChar(DestFolder), nil, IShellItem, psiTo));
OleCheck(CoCreateInstance(CLSID_FileOperation, nil, CLSCTX_ALL, IFileOperation, pfo));
OleCheck(pfo.SetOperationFlags(FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_NOERRORUI or FOF_RENAMEONCOLLISION or FOFX_PRESERVEFILEEXTENSIONS));
Sink := TMyCopyProgressSink.Create;
OleCheck(pfo.CopyItem(psiFrom, psiTo, PChar(DestName), Sink));
OleCheck(pfo.PerformOperations());
pfo.GetAnyOperationsAborted(bAborted);
if bAborted then
begin
// abort handling...
end;
DestName := TMyCopyProgressSink(Sink).CopiedName;
// use DestName as needed...
except
// error handling...
end;
end;

Answer 2

您有一个文件名，因此请使用 FileExists 检查文件是否存在。如果确实在文件名后附加了 (1)，然后重试。重复上述步骤，增加 N，直到获得不存在的文件名。所以，有点像这样：

procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName : string;
DestFolder : string;
n : integer;
additional : string;
begin
DestFolder:=UniServerModule.StartPath+'files'+UniMainModule.foldername+'';
DestName:=DestFolder+UniMainModule.FirstName+'_'+UniMainModule.LastName;
n := 0;
additional :='.pdf';
while FileExists( DestName + additional ) do
begin
inc(n);
additional := '(' + intToStr(n) + ')'+'.pdf';
end;
CopyFile(PChar(AStream.FileName), PChar(DestName + additional), False);
ModalResult:= mrOk;
end;

Answer 3

这是我对解决方案的看法

procedure TsomeForm.UniFileUpload1Completed(Sender: TObject; AStream: TFileStream);
var
DestName, NewName : string;
DestFolder : string;
Cnt: integer;
begin
DestFolder:=UniServerModule.StartPath+'files'+UniMainModule.foldername+'';
DestName:=DestFolder+UniMainModule.FirstName+'_'+UniMainModule.LastName+'.pdf';
if FileExists(DestName) then begin
Cnt:=0;
repeat
Inc(Cnt);
NewName:=Format(DestFolder+UniMainModule.FirstName+'_'+UniMainModule.LastName+'(%d).pdf',[Cnt]);
until not FileExists(NewName);
DestName:=NewName;
end;
CopyFile(PChar(AStream.FileName), PChar(DestName), False);
ModalResult:= mrOk;
end;