undo.pas

源代码

function DeleteDirProc(const DirName: String; Param: Pointer): Boolean;
begin
  Result := DeleteDir(DirName, PDeleteDirData(Param)^.DirsNotRemoved, nil);
end;

procedure DeleteFileProc(const FileName: String; Param: Pointer);
begin
  if NewFileExists(FileName) then begin
    LogFmt('Deleting file: %s', [FileName]);
    if not Windows.DeleteFile(PChar(FileName)) then
      LogFmt('Failed to delete the file; it may be in use (%d).', [GetLastError]);
  end;
end;

procedure ProcessMessagesProc; far;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

class function TUninstallLog.ExtractRecData(const Rec: PUninstallRec;
  var Data: array of String): Integer;
var
  I, L: Integer;
  X: ^Byte;
begin
  for I := 0 to High(Data) do
    Data[I] := '';
  I := 0;
  L := 0;  { prevent warning }
  X := @Rec^.Data;
  while I <= High(Data) do begin
    case X^ of
      $00..$FC: begin
           L := X^;
           Inc(X);
         end;
      $FD: begin
           Inc(X);
           L := Word(Pointer(X)^);
           Inc(X, SizeOf(Word));
         end;
      $FE: begin
           Inc(X);
           L := Integer(Pointer(X)^);
           Inc(X, SizeOf(Integer));
         end;
      $FF: Break;
    end;
    SetString(Data[I], PChar(X), L);
    Inc(X, L);
    Inc(I);
  end;
  Result := I;
end;

function TUninstallLog.ExtractLatestRecData(const Typ: TUninstallRecTyp;
 const ExtraData: Longint; var Data: array of String): Boolean;
var
  CurRec: PUninstallRec;
begin
  CurRec := LastList;
  while CurRec <> nil do begin
    if (CurRec^.Typ = Typ) and (CurRec^.ExtraData = ExtraData) then begin
      ExtractRecData(CurRec, Data);
      Result := True;
      Exit;
    end;
    CurRec := CurRec^.Prev;
  end;
  Result := False;
end;

function TUninstallLog.CheckMutexes: Boolean;
var
  CurRec: PUninstallRec;
  Data: String;
begin
  Result := False;
  CurRec := LastList;
  while CurRec <> nil do begin
    if CurRec^.Typ = utMutexCheck then
      ExtractRecData(CurRec, Data);
      if CheckForMutexes(Data) then begin
        Result := True;
        Exit;
      end;
    CurRec := CurRec^.Prev;
  end;
end;

function TUninstallLog.PerformUninstall(const CallFromUninstaller: Boolean;
  const DeleteUninstallDataFilesProc: TDeleteUninstallDataFilesProc): Boolean;
{ Undoes all the changes in the uninstall list, in reverse order they were
  added. Deletes entries that were successfully undone.
  Returns True if all elements were successfully removed; False if some
  could not be removed. }

var
  RefreshFileAssoc: Boolean;
  ChangeNotifyList, RunOnceList, RestartDeleteDirList: TSimpleStringList;
  DeleteDirData: TDeleteDirData;

  function FileDelete(const Filename: String; const NotifyChange,
    RestartDelete, RemoveReadOnly: Boolean): Boolean;
  var
    ExistingAttr, LastError: DWORD;
  begin
    Result := True;
    if CompareText(PathExtractExt(Filename), '.HLP') = 0 then begin
      DeleteFile(PathChangeExt(Filename, '.GID'));
      DeleteFile(PathChangeExt(Filename, '.FTS'));
    end;
    if NewFileExists(Filename) then begin
      LogFmt('Deleting file: %s', [FileName]);
      if RemoveReadOnly then begin
        ExistingAttr := GetFileAttributes(PChar(Filename));
        if (ExistingAttr <> $FFFFFFFF) and
           (ExistingAttr and FILE_ATTRIBUTE_READONLY <> 0) then
          if SetFileAttributes(PChar(Filename),
             ExistingAttr and not FILE_ATTRIBUTE_READONLY) then
            Log('Stripped read-only attribute.')
          else
            Log('Failed to strip read-only attribute.');
      end;
      if not DeleteFile(Filename) then begin
        LastError := GetLastError;
        if RestartDelete and CallFromUninstaller and
           ((LastError = ERROR_ACCESS_DENIED) or (LastError = ERROR_SHARING_VIOLATION)) and
           (GetFileAttributes(PChar(Filename)) and FILE_ATTRIBUTE_READONLY = 0) then begin
          LogFmt('The file appears to be in use (%d). Will delete on restart.',
            [LastError]);
          try
            RestartReplace(Filename, '');
            NeedRestart := True;
            { Add the file's directory to the list of directories that should
              be restart-deleted later }
            RestartDeleteDirList.AddIfDoesntExist(PathExtractDir(PathExpand(Filename)));
          except
            Log('Exception message:' + SNewLine + GetExceptMessage);
            Result := False;
          end;
        end
        else begin
          LogFmt('Failed to delete the file; it may be in use (%d).', [LastError]);
          Result := False;
        end;
      end
      else begin
        if NotifyChange then begin
          SHChangeNotify(SHCNE_DELETE, SHCNF_PATH, PChar(Filename), nil);
          ChangeNotifyList.AddIfDoesntExist(PathExtractDir(Filename));
        end;
      end;
    end;
  end;

const
  GroupInfoChars: array[0..3] of Char = ('"', '"', ',', ',');
  NullChar: Char = #0;
var
  StartCount: Integer;
  CurRec: PUninstallRec;
  CurRecDataPChar: array[0..9] of PChar;
  CurRecData: array[0..9] of String;
  ShouldDeleteRec, IsTempFile, IsSharedFile, SharedCountDidReachZero: Boolean;
  FN: String;
  P, ErrorCode: Integer;
  K: HKEY;
  ShowCmd: Integer;

  procedure SplitData(const Rec: PUninstallRec);
  var
    C, I: Integer;
  begin
    C := ExtractRecData(Rec, CurRecData);
    for I := 0 to 9 do begin
      if I < C then
        CurRecDataPChar[I] := PChar(CurRecData[I])
      else
        CurRecDataPChar[I] := nil;
    end;
  end;

begin
  Log('Starting the uninstallation process.');
  SetCurrentDir(GetSystemDir);
  Result := True;
  NeedRestart := False;

  RefreshFileAssoc := False;
  RunOnceList := nil;
  RestartDeleteDirList := nil;
  DeleteDirData.DirsNotRemoved := nil;
  ChangeNotifyList := TSimpleStringList.Create;
  try
    RunOnceList := TSimpleStringList.Create;
    RestartDeleteDirList := TSimpleStringList.Create;
    if Assigned(DeleteUninstallDataFilesProc) then
      DeleteDirData.DirsNotRemoved := TSimpleStringList.Create;

    StartCount := FCount;
    StatusUpdate(StartCount, FCount);

    { Step 1 - Process all utRun entries }
    if CallFromUninstaller then begin
      CurRec := LastList;
      while CurRec <> nil do begin
        if CurRec^.Typ = utRun then begin
          try
            SplitData(CurRec);
            { Verify that a utRun entry with the same RunOnceId has not
              already been executed }
            if (CurRecData[3] = '') or (RunOnceList.IndexOf(CurRecData[3]) = -1) then begin
              ShowCmd := SW_SHOWNORMAL;
              if CurRec^.ExtraData and utRun_RunMinimized <> 0 then
                ShowCmd := SW_SHOWMINNOACTIVE
              else if CurRec^.ExtraData and utRun_RunMaximized <> 0 then
                ShowCmd := SW_SHOWMAXIMIZED
              else if CurRec^.ExtraData and utRun_RunHidden <> 0 then
                ShowCmd := SW_HIDE;
              { Note: This code is similar to code in the ProcessRunEntry
                function of Main.pas }
              if CurRec^.ExtraData and utRun_ShellExec = 0 then begin
                Log('Running Exec filename: ' + CurRecData[0]);
                if (CurRec^.ExtraData and utRun_SkipIfDoesntExist = 0) or
                   NewFileExists(CurRecData[0]) then begin
                  if not InstExec(CurRecData[0], CurRecData[1], CurRecData[2],
                     CurRec^.ExtraData and utRun_NoWait = 0,
                     CurRec^.ExtraData and utRun_WaitUntilIdle <> 0,
                     ShowCmd, ProcessMessagesProc, ErrorCode) then begin
                    LogFmt('CreateProcess failed (%d).', [ErrorCode]);
                    Result := False;
                  end;
                end else
                  Log('File doesn''t exist. Skipping.');
              end
              else begin
                Log('Running ShellExec filename: ' + CurRecData[0]);
                if (CurRec^.ExtraData and utRun_SkipIfDoesntExist = 0) or
                   FileOrDirExists(CurRecData[0]) then begin
                  if not InstShellExec('open', CurRecData[0], CurRecData[1], CurRecData[2],
                     CurRec^.ExtraData and (utRun_ShellExecRespectWaitFlags or utRun_NoWait or utRun_WaitUntilIdle) =
                       utRun_ShellExecRespectWaitFlags,
                     CurRec^.ExtraData and (utRun_ShellExecRespectWaitFlags or utRun_NoWait or utRun_WaitUntilIdle) =
                       utRun_ShellExecRespectWaitFlags or utRun_WaitUntilIdle,
                     ShowCmd, ProcessMessagesProc, ErrorCode) then begin
                    LogFmt('ShellExecuteEx failed (%d).', [ErrorCode]);
                    Result := False;
                  end;
                end else
                  Log('File/directory doesn''t exist. Skipping.');
              end;
              if CurRecData[3] <> '' then
                RunOnceList.Add(CurRecData[3]);
            end else
              LogFmt('Skipping RunOnceId "%s" filename: %s', [CurRecData[3], CurRecData[0]]);
          except
            Result := False;
            if not(ExceptObject is EAbort) then
              HandleException;
          end;
          CurRec := Delete(CurRec);
          StatusUpdate(StartCount, FCount);
        end
        else
          CurRec := CurRec^.Prev;
      end;
    end;

    { Step 2 - Decrement shared file counts, and unregister DLLs/TLBs/fonts }
    CurRec := LastList;
    while CurRec <> nil do begin
      ShouldDeleteRec := False;
      if CurRec^.Typ = utDeleteFile then begin
        { Default to deleting the record in case an exception is raised by
          DecrementSharedCount, the reference count doesn't reach zero, or the
          user opts not to delete the shared file. }
        ShouldDeleteRec := True;
        try
          SplitData(CurRec);
          { Note: Some of this code is duplicated in Step 3 }
          if CallFromUninstaller or (CurRec^.ExtraData and utDeleteFile_ExistedBeforeInstall = 0) then begin
            IsTempFile := not CallFromUninstaller and (CurRecData[1] <> '');

            { Decrement shared file count if necessary }
            IsSharedFile := CurRec^.ExtraData and utDeleteFile_SharedFile <> 0;
            if IsSharedFile then begin
              LogFmt('Decrementing shared count: %s', [CurRecData[0]]);
              SharedCountDidReachZero := DecrementSharedCount(CurRecData[0]);
              if SharedCountDidReachZero then
                Log('Shared count reached zero.');
            end else
              SharedCountDidReachZero := False; //silence compiler

            if not IsSharedFile or
               (SharedCountDidReachZero and
                (IsTempFile or not NewFileExists(CurRecData[0]) or
                 (CurRec^.ExtraData and utDeleteFile_NoSharedFilePrompt <> 0) or
                 ShouldRemoveSharedFile(CurRecData[0]))) then begin
              { The reference count reached zero and the user did not object
                to the file being deleted, so don't delete the record; allow
                the file to be deleted in the next step. }
              ShouldDeleteRec := False;
              { Unregister if necessary }
              if not IsTempFile then begin
                if CurRec^.ExtraData and utDeleteFile_RegisteredServer <> 0 then begin
                  LogFmt('Unregistering server: %s', [CurRecData[0]]);
                  if not UnregisterServer(CurRecData[0], True) then
                    Log('Failed to unregister.');
                end;
                if CurRec^.ExtraData and utDeleteFile_RegisteredTypeLib <> 0 then begin
                  LogFmt('Unregistering type library: %s', [CurRecData[0]]);
                  if not UnregisterTypeLibrary(CurRecData[0]) then
                    Log('Failed to unregister.');
                end;
              end;
              if CurRec^.ExtraData and utDeleteFile_IsFont <> 0 then begin
                LogFmt('Unregistering font: %s', [CurRecData[2]]);
                UnregisterFont(CurRecData[2], CurRecData[3]);
              end;
            end;
          end
          else begin
            { This case is handled entirely in Step 3 }
            ShouldDeleteRec := False;
          end;
        except
          Result := False;
          if not(ExceptObject is EAbort) then
            HandleException;
        end;
      end;
      if ShouldDeleteRec then begin
        CurRec := Delete(CurRec);
        StatusUpdate(StartCount, FCount);
      end
      else
        CurRec := CurRec^.Prev;
    end;

    { Step 3 - Remaining entries }
    CurRec := LastList;
    while CurRec <> nil do begin
      SplitData(CurRec);
      try
        case CurRec^.Typ of
          utUserDefined: begin
              {if CurRecData[0] = 'MyRecordType' then begin
                 ... your code here ...
              end
              else}
                raise Exception.Create(FmtSetupMessage1(msgUninstallUnknownEntry,
                  'utUserDefined:' + CurRecData[0]));
            end;
          utStartInstall,
          utEndInstall,
          utCompiledCode: { do nothing on these };
          utRun: begin
              { Will get here if CallFromUninstaller=False; in that case utRun
                entries will still be in the list, unprocessed. Just ignore