Add and use reusable PerformFileOperationWithRetries function.

Projects/Src/Setup.DownloadFileFunc.pas

@@ -387,8 +387,6 @@ var
   TempF: TFile;
   TempFileLeftOver: Boolean;
   HTTPDataReceiver: THTTPDataReceiver;
-  RetriesLeft: Integer;
-  LastError: DWORD;
 begin
   if Url = '' then
     InternalError('DownloadTemporaryFile: Invalid Url value');
@@ -481,24 +479,22 @@ begin
     end;
 
     { Rename the temporary file to the new name now, with retries if needed }
-    RetriesLeft := 4;
-    while not MoveFile(PChar(TempFile), PChar(DestFile)) do begin
-      { Couldn't rename the temporary file... }
-      LastError := GetLastError;
-      { Does the error code indicate that it is possibly in use? }
-      if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
-        if RetriesLeft > 0 then begin
-          LogFmt('  The existing file appears to be in use (%d). ' +
-            'Retrying.', [LastError]);
-          Dec(RetriesLeft);
-          Sleep(1000);
-          Continue;
-        end;
-      end;
-      { Some other error occurred, or we ran out of tries }
-      SetLastError(LastError);
-      Win32ErrorMsg('MoveFile'); { Throws an exception }
-    end;
+    const CapturableDestFile = DestFile;
+    PerformFileOperationWithRetries(4, True,
+      function: Boolean
+      begin
+        Result := MoveFile(PChar(TempFile), PChar(CapturableDestFile));
+      end,
+      procedure(const LastError: Cardinal)
+      begin
+        LogFmt('  The existing file appears to be in use (%d). ' +
+          'Retrying.', [LastError]);
+        Sleep(1000);
+      end,
+      procedure(const LastError: Cardinal; var DoExit: Boolean)
+      begin
+        Win32ErrorMsg('MoveFile'); { Throws an exception }
+      end);
     TempFileLeftOver := False;
   finally
     TempF.Free;

Projects/Src/Setup.InstFunc.pas

@@ -44,6 +44,11 @@ type
   { Must keep this in synch with Compiler.ScriptFunc.pas: }
   TExecWait = (ewNoWait, ewWaitUntilTerminated, ewWaitUntilIdle);
 
+  TFileOperation = reference to function: Boolean;
+  TFileOperationFailing = reference to procedure(const LastError: Cardinal);
+  TFileOperationFailingEx = reference to procedure(const LastError: Cardinal; var RetriesLeft: Integer; var DoBreak, DoContinue: Boolean);
+  TFileOperationFailed = reference to procedure(const LastError: Cardinal; var DoExit: Boolean);
+
 function CheckForMutexes(const Mutexes: String): Boolean;
 procedure CreateMutexes(const Mutexes: String);
 function DecrementSharedCount(const RegView: TRegView; const Filename: String): Boolean;
@@ -92,7 +97,10 @@ procedure Win32ErrorMsg(const FunctionName: String);
 procedure Win32ErrorMsgEx(const FunctionName: String; const ErrorCode: DWORD);
 function ForceDirectories(const DisableFsRedir: Boolean; Dir: String): Boolean;
 procedure AddAttributesToFile(const DisableFsRedir: Boolean; const Filename: String; Attribs: Integer);
-function LastErrorIndicatesPossiblyInUse(const LastError: DWORD; const CheckAlreadyExists: Boolean): Boolean;
+function PerformFileOperationWithRetries(const MaxRetries: Integer; const CheckAlreadyExists: Boolean;
+  const Op: TFileOperation; const Failing: TFileOperationFailing; const Failed: TFileOperationFailed): Boolean; overload;
+function PerformFileOperationWithRetries(const MaxRetries: Integer; const CheckAlreadyExists: Boolean;
+  const Op: TFileOperation; const Failing: TFileOperationFailingEx; const Failed: TFileOperationFailed): Boolean; overload;
 
 implementation
 
@@ -1022,6 +1030,54 @@ begin
             (CheckAlreadyExists and (LastError = ERROR_ALREADY_EXISTS));
 end;
 
+function PerformFileOperationWithRetries(const MaxRetries: Integer; const CheckAlreadyExists: Boolean;
+  const Op: TFileOperation; const Failing: TFileOperationFailing; const Failed: TFileOperationFailed): Boolean;
+{ Performs a file operation Op. If it fails then calls Failing up to MaxRetries times. When no
+  retries remain, it calls Failed and returns False. Op should ensure LastError is always set on
+  failure. It is recommended that Failed throws an exception, rather than expecting the caller to
+  inspect the return value. Alternatively, Failed can set DoExit to False to allow an extra retry. }
+begin
+  Result := PerformFileOperationWithRetries(MaxRetries, CheckAlreadyExists,
+    Op,
+    procedure(const LastError: Cardinal; var RetriesLeft: Integer; var DoBreak, DoContinue: Boolean)
+    begin
+      DoContinue := RetriesLeft > 0;
+      if DoContinue then begin
+        Failing(LastError);
+        Dec(RetriesLeft);
+      end;
+    end,
+    Failed);
+end;
+
+function PerformFileOperationWithRetries(const MaxRetries: Integer; const CheckAlreadyExists: Boolean;
+  const Op: TFileOperation; const Failing: TFileOperationFailingEx; const Failed: TFileOperationFailed): Boolean;
+{ Similar to the other PerformFileOperationWithRetries, but provides fine-grained control to Failing,
+  which is now responsible for updating RetriesLeft itself, and can also request an early break. }
+begin
+  var RetriesLeft := MaxRetries;
+  while not Op do begin
+    const LastError = GetLastError;
+    { Does the error code indicate that it is possibly in use? }
+    if LastErrorIndicatesPossiblyInUse(LastError, CheckAlreadyExists) then begin
+      var DoBreak := False;
+      var DoContinue := False;
+      Failing(LastError, RetriesLeft, DoBreak, DoContinue);
+      if DoBreak then
+        Break
+      else if DoContinue then
+        Continue;
+    end;
+    { Some other error occurred, or we ran out of tries }
+    SetLastError(LastError);
+    var DoExit := True;
+    Failed(LastError, DoExit);
+    if DoExit then
+      Exit(False);
+  end;
+  Result := True;
+end;
+
 { TSimpleStringList }
 
 procedure TSimpleStringList.Add(const S: String);

Projects/Src/Setup.Install.pas

@@ -508,6 +508,37 @@ begin
   F.WriteBuffer(UninstallerMsgTail, SizeOf(UninstallerMsgTail));
 end;
 
+procedure DoHandleFailedDeleteOrMoveFileTry(const CurFile: PSetupFileEntry;
+  const DisableFsRedir: Boolean; const Func, TempFile, DestFile: String;
+  const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
+  var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean);
+begin
+  { Automatically retry. Wait with replace on restart until no
+    retries left, unless we already know we're going to restart. }
+  if ((RetriesLeft = 0) or NeedsRestart) and
+     (foRestartReplace in CurFile^.Options) and IsAdmin then begin
+    LogFmt('%s: The existing file appears to be in use (%d). ' +
+      'Will replace on restart.', [Func, LastError]);
+    LastOperation := SetupMessages[msgErrorRestartReplace];
+    NeedsRestart := True;
+    RestartReplace(DisableFsRedir, TempFile, DestFile);
+    ReplaceOnRestart := True;
+    DoBreak := True;
+    DoContinue := False;
+  end else if RetriesLeft > 0 then begin
+    LogFmt('%s: The existing file appears to be in use (%d). ' +
+      'Retrying.', [Func, LastError]);
+    Dec(RetriesLeft);
+    Sleep(1000);
+    ProcessEvents;
+    DoBreak := False;
+    DoContinue := True;
+  end else begin
+    DoBreak := False;
+    DoContinue := False;
+  end;
+end;
+
 type
   TOverwriteAll = (oaUnknown, oaOverwrite, oaKeep);
 
@@ -645,36 +676,6 @@ procedure ProcessFileEntry(const UninstLog: TUninstallLog; const ExpandedAppId:
       LogFmt('Failed to set NTFS compression state (%d).', [GetLastError]);
   end;
 
-  procedure DoHandleFailedDeleteOrMoveFileTry(const Func, TempFile, DestFile: String;
-    const LastError: DWORD; var RetriesLeft: Integer; var LastOperation: String;
-    var NeedsRestart, ReplaceOnRestart, DoBreak, DoContinue: Boolean);
-  begin
-    { Automatically retry. Wait with replace on restart until no
-      retries left, unless we already know we're going to restart. }
-    if ((RetriesLeft = 0) or NeedsRestart) and
-       (foRestartReplace in CurFile^.Options) and IsAdmin then begin
-      LogFmt('%s: The existing file appears to be in use (%d). ' +
-        'Will replace on restart.', [Func, LastError]);
-      LastOperation := SetupMessages[msgErrorRestartReplace];
-      NeedsRestart := True;
-      RestartReplace(DisableFsRedir, TempFile, DestFile);
-      ReplaceOnRestart := True;
-      DoBreak := True;
-      DoContinue := False;
-    end else if RetriesLeft > 0 then begin
-      LogFmt('%s: The existing file appears to be in use (%d). ' +
-        'Retrying.', [Func, LastError]);
-      Dec(RetriesLeft);
-      Sleep(1000);
-      ProcessEvents;
-      DoBreak := False;
-      DoContinue := True;
-    end else begin
-      DoBreak := False;
-      DoContinue := False;
-    end;
-  end;
-
   function AskOverwrite(const DestFile, Instruction, Caption: string; const ButtonLabels: array of String;
     const VerificationText: String; const Typ: TMsgBoxType; const Default, Overwrite: Integer;
     var OverwriteAll: TOverwriteAll): Boolean;
@@ -1179,27 +1180,23 @@ Retry:
         restarted. Do retry deletion before doing this. }
       if DestFileExists and (CurFile^.FileType <> ftUninstExe) then begin
         LastOperation := SetupMessages[msgErrorReplacingExistingFile];
-        RetriesLeft := 4;
-        while not DeleteFileRedir(DisableFsRedir, DestFile) do begin
-          { Couldn't delete the existing file... }
-          LastError := GetLastError;
-          { If the file inexplicably vanished, it's not a problem }
-          if LastError = ERROR_FILE_NOT_FOUND then
-            Break;
-          { Does the error code indicate that it is possibly in use? }
-          if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
-            DoHandleFailedDeleteOrMoveFileTry('DeleteFile', TempFile, DestFile,
+        PerformFileOperationWithRetries(4, False,
+          function: Boolean
+          begin
+            Result := DeleteFileRedir(DisableFsRedir, DestFile);
+            if not Result and (GetLastError = ERROR_FILE_NOT_FOUND) then
+              Result := True; { If the file inexplicably vanished, it's not a problem }
+          end,
+          procedure(const LastError: Cardinal; var RetriesLeft: Integer; var DoBreak, DoContinue: Boolean)
+          begin
+            DoHandleFailedDeleteOrMoveFileTry(CurFile, DisableFsRedir, 'DeleteFile', TempFile, DestFile,
               LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
               DoBreak, DoContinue);
-            if DoBreak then
-              Break
-            else if DoContinue then
-              Continue;
-          end;
-          { Some other error occurred, or we ran out of tries }
-          SetLastError(LastError);
-          Win32ErrorMsg('DeleteFile');
-        end;
+          end,
+          procedure(const LastError: Cardinal; var DoExit: Boolean)
+          begin
+            Win32ErrorMsg('DeleteFile'); { Throws an exception }
+          end);
       end;
 
       { Rename the temporary file to the new name now, unless the file is
@@ -1213,24 +1210,21 @@ Retry:
         LastOperation := SetupMessages[msgErrorRenamingTemp];
         { Since the DeleteFile above succeeded you would expect the rename to
           also always succeed, but if it doesn't retry anyway. }
-        RetriesLeft := 4;
-        while not MoveFileRedir(DisableFsRedir, TempFile, DestFile) do begin
-          { Couldn't rename the temporary file... }
-          LastError := GetLastError;
-          { Does the error code indicate that it is possibly in use? }
-          if LastErrorIndicatesPossiblyInUse(LastError, True) then begin
-            DoHandleFailedDeleteOrMoveFileTry('MoveFile', TempFile, DestFile,
+        PerformFileOperationWithRetries(4, True,
+          function: Boolean
+          begin
+            Result := MoveFileRedir(DisableFsRedir, TempFile, DestFile);
+          end,
+          procedure(const LastError: Cardinal; var RetriesLeft: Integer; var DoBreak, DoContinue: Boolean)
+          begin
+            DoHandleFailedDeleteOrMoveFileTry(CurFile, DisableFsRedir, 'MoveFile', TempFile, DestFile,
               LastError, RetriesLeft, LastOperation, NeedsRestart, ReplaceOnRestart,
               DoBreak, DoContinue);
-            if DoBreak then
-              Break
-            else if DoContinue then
-              Continue;
-          end;
-          { Some other error occurred, or we ran out of tries }
-          SetLastError(LastError);
-          Win32ErrorMsg('MoveFile'); { Throws an exception }
-        end;
+          end,
+          procedure(const LastError: Cardinal; var DoExit: Boolean)
+          begin
+            Win32ErrorMsg('MoveFile'); { Throws an exception }
+          end);
 
         { If ReplaceOnRestart is still False the rename succeeded so handle this.
           Then set any file attributes. }
@@ -2715,38 +2709,36 @@ begin
     Exit;
   Log('Renaming uninstaller.');
   var Timer: TOneShotTimer;
-  var RetriesLeft := 4;
-  while True do begin
-    Timer.Start(1000);
-    if MoveFileReplace(UninstallTempExeFilename, UninstallExeFilename) then
-      Break;
-    var LastError := GetLastError;
-    { Does the error code indicate that the file is possibly in use? }
-    if LastErrorIndicatesPossiblyInUse(LastError, False) then begin
-      if RetriesLeft > 0 then begin
-        LogFmt('The existing file appears to be in use (%d). ' +
-          'Retrying.', [LastError]);
-        Dec(RetriesLeft);
-        Timer.SleepUntilExpired;
-        ProcessEvents;
-        Continue;
+  const CapturableUninstallTempExeFilename = UninstallTempExeFilename;
+  PerformFileOperationWithRetries(4, False,
+    function: Boolean
+    begin
+      Timer.Start(1000);
+      Result := MoveFileReplace(CapturableUninstallTempExeFilename, UninstallExeFilename);
+    end,
+    procedure(const LastError: Cardinal)
+    begin
+      LogFmt('The existing file appears to be in use (%d). ' +
+        'Retrying.', [LastError]);
+      Timer.SleepUntilExpired;
+      ProcessEvents;
+    end,
+    procedure(const LastError: Cardinal; var DoExit: Boolean)
+    begin
+      const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
+      const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
+        ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
+      const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
+      case LoggedTaskDialogMsgBox('',  SetupMessages[msgRetryCancelSelectAction], Text, '',
+         mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
+         0, True, IDCANCEL) of
+        IDRETRY: DoExit := False;
+        IDCANCEL: Abort;
+      else
+        Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
+        Abort;
       end;
-    end;
-
-    const LastOperation = SetupMessages[msgErrorReplacingExistingFile];
-    const Failed = AddPeriod(FmtSetupMessage(msgErrorFunctionFailedWithMessage,
-      ['MoveFileEx', IntToStr(LastError), Win32ErrorString(LastError)]));
-    const Text = UninstallExeFilename + SNewLine2 + LastOperation + SNewLine + Failed;
-    case LoggedTaskDialogMsgBox('',  SetupMessages[msgRetryCancelSelectAction], Text, '',
-       mbError, MB_RETRYCANCEL, [SetupMessages[msgRetryCancelRetry], SetupMessages[msgRetryCancelCancel]],
-       0, True, IDCANCEL) of
-      IDRETRY: ;
-      IDCANCEL: Abort;
-    else
-      Log('LoggedTaskDialogMsgBox returned an unexpected value. Assuming Cancel.');
-      Abort;
-    end;
-  end;
+    end);
   UninstallTempExeFilename := '';
 end;