CopyFile - save without overwriting existing file

What am I doing:

User clicks a button, a FileUpload component (dialog) fires up and he can browse for and load a file from his PC.
When he clicks ok the file gets saved to the disk, in a specific location.
Prior to saving I'm renaming (or rather, saving with a specific name) his file using some string that contain data I previously pulled from some DB fields.

Hence, regardless of the name the file has when the user loads it, it gets saved to the disk with his Firstname and LastName, which I get from some string variables.

UniMainModule.foldername = contains the path to the folder where the file gets saved.

UniMainModule.FirstName = contains the user's FirstName

UniMainModule.LastName = contains the user's LastName

Thus, the file gets saved as FirstName_LastName.pdf on the disk at location provided by foldername string.

This is the code I'm using:

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;

As I understand it, after reading a bit about CopyFile on msdn passing False means that it should and will overwrite the existing file.

If the file isn't already present with that name in that location, it's fine, it gets saved.

But if the user decides to use the fileupload again and upload a new file, the new file will overwrite the previous one. Since they're being saved with the same name.

How then can you ensure that if the file already exists (a file with that exact name is present in the location) it doesn't get overwritten but, I don't know, gets assigned a (1) in the name or something, keeping both files?

Solution

Call CopyFile() in a loop, setting its bFailIfExists parameter to TRUE so you can retry with a new filename if CopyFile() fails with an ERROR_FILE_EXISTS error code.

For example:

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;

However, rather than handling this manually, you should let the OS do the work for you. Especially since the OS has its own way to renaming copied files, and that naming scheme can change (and has) from one OS version to another.

Instead of using CopyFile(), use SHFileOperation() instead, which has a FOF_RENAMEONCOLLISION flag:

Give the file being operated on a new name in a move, copy, or rename operation if a file with the target name already exists at the destination.

For example:

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;

If you need to know what the OS picked for the renamed filename, there is also a FOF_WANTMAPPINGHANDLE flag:

If FOF_RENAMEONCOLLISION is specified and any files were renamed, assign a name mapping object that contains their old and new names to the hNameMappings member. This object must be freed using SHFreeNameMappings when it is no longer needed.

For example:

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;

On Vista and later, you can alternatively use IFileOperation.CopyItem() instead, which also supports renaming an item on collision. An IFileOperationProgressSink callback can be used to discover the new filename if a rename collision occurs.

For example:

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;