⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 undo.pas

📁 源代码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
                them. }
            end;
          utDeleteDirOrFiles:
            if (CallFromUninstaller or (CurRec^.ExtraData and utDeleteDirOrFiles_Extra = 0)) then begin
              if DelTree(CurRecData[0], CurRec^.ExtraData and utDeleteDirOrFiles_IsDir <> 0,
                 CurRec^.ExtraData and utDeleteDirOrFiles_DeleteFiles <> 0,
                 CurRec^.ExtraData and utDeleteDirOrFiles_DeleteSubdirsAlso <> 0,
                 DeleteDirProc, DeleteFileProc, @DeleteDirData) then begin
                if (CurRec^.ExtraData and utDeleteDirOrFiles_IsDir <> 0) and
                   (CurRec^.ExtraData and utDeleteDirOrFiles_CallChangeNotify <> 0) then begin
                  SHChangeNotify(SHCNE_RMDIR, SHCNF_PATH, CurRecDataPChar[0], nil);
                  ChangeNotifyList.AddIfDoesntExist(PathExtractDir(CurRecData[0]));
                end;
              end;
            end;
          utDeleteFile: begin
              { Note: Some of this code is duplicated in Step 2 }
              FN := CurRecData[1];
              if CallFromUninstaller or (FN = '') then
                FN := CurRecData[0];
              if CallFromUninstaller or (CurRec^.ExtraData and utDeleteFile_ExistedBeforeInstall = 0) then begin
                { Note: We handled utDeleteFile_SharedFile already }
                if CallFromUninstaller or (CurRec^.ExtraData and utDeleteFile_Extra = 0) then
                  if not FileDelete(FN, CurRec^.ExtraData and utDeleteFile_CallChangeNotify <> 0,
                     CurRec^.ExtraData and utDeleteFile_RestartDelete <> 0,
                     CurRec^.ExtraData and utDeleteFile_RemoveReadOnly <> 0) then
                    Result := False;
              end
              else begin
                { We're running from Setup, and the file existed before
                  installation... }
                if CurRec^.ExtraData and utDeleteFile_SharedFile <> 0 then
                  DecrementSharedCount(CurRecData[0]);
                { Delete file only if it's a temp file }
                if FN <> CurRecData[0] then
                  if not FileDelete(FN, CurRec^.ExtraData and utDeleteFile_CallChangeNotify <> 0,
                     CurRec^.ExtraData and utDeleteFile_RestartDelete <> 0,
                     CurRec^.ExtraData and utDeleteFile_RemoveReadOnly <> 0) then
                    Result := False;
              end;
            end;
          utDeleteGroupOrItem: ;   { dummy - no longer supported }
          utIniDeleteEntry: begin
              if CurRecDataPChar[0] <> #0 then
                WritePrivateProfileString(CurRecDataPChar[1], CurRecDataPChar[2],
                  nil, CurRecDataPChar[0])
              else
                WriteProfileString(CurRecDataPChar[1], CurRecDataPChar[2], nil);
            end;
          utIniDeleteSection: begin
              if (CurRec^.ExtraData and utIniDeleteSection_OnlyIfEmpty = 0) or
                 IsSectionEmpty(CurRecDataPChar[1], CurRecDataPChar[0]) then begin
                if CurRecDataPChar[0] <> #0 then
                  WritePrivateProfileString(CurRecDataPChar[1], nil, nil,
                    CurRecDataPChar[0])
                else
                  WriteProfileString(CurRecDataPChar[1], nil, nil);
              end;
            end;
          utRegDeleteEntireKey: begin
              if not (RegDeleteKeyIncludingSubkeys(CurRec^.ExtraData, CurRecDataPChar[0]) in
                 [ERROR_SUCCESS, ERROR_FILE_NOT_FOUND]) then
                Result := False;
            end;
          utRegClearValue:
            if RegOpenKeyEx(CurRec^.ExtraData, CurRecDataPChar[0], 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
              if RegSetValueEx(K, CurRecDataPChar[1], 0, REG_SZ, @NullChar,
                 SizeOf(NullChar)) <> ERROR_SUCCESS then
                Result := False;
              RegCloseKey(K);
            end;
          utRegDeleteKeyIfEmpty: begin
              if not (RegDeleteKeyIfEmpty(CurRec^.ExtraData, CurRecDataPChar[0]) in
                 [ERROR_SUCCESS, ERROR_FILE_NOT_FOUND, ERROR_DIR_NOT_EMPTY]) then
                Result := False;
            end;
          utRegDeleteValue: begin
              if RegOpenKeyEx(CurRec^.ExtraData, CurRecDataPChar[0], 0,
                 KEY_QUERY_VALUE or KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
                if RegValueExists(K, CurRecDataPChar[1]) and
                   (RegDeleteValue(K, CurRecDataPChar[1]) <> ERROR_SUCCESS) then
                  Result := False;
              end;
            end;
          utDecrementSharedCount: begin
              LogFmt('Decrementing shared count: %s', [CurRecData[0]]);
              DecrementSharedCount(CurRecData[0]);
            end;
          utRefreshFileAssoc:
            RefreshFileAssoc := True;
          utMutexCheck: ;    { do nothing; utMutexChecks aren't processed here }
        else
          raise Exception.Create(FmtSetupMessage1(msgUninstallUnknownEntry,
            Format('$%x', [CurRec^.Typ])));
        end;
      except
        Result := False;
        if not(ExceptObject is EAbort) then
          HandleException;
      end;
      CurRec := Delete(CurRec);
      StatusUpdate(StartCount, FCount);
    end;

    if RefreshFileAssoc then
      SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
    if ufChangesEnvironment in Flags then
      RefreshEnvironment;
    if Assigned(DeleteUninstallDataFilesProc) then begin
      DeleteUninstallDataFilesProc;
      { Now that uninstall data is deleted, try removing the directories it
        was in that couldn't be deleted before. }
      for P := 0 to DeleteDirData.DirsNotRemoved.Count-1 do
        DeleteDir(DeleteDirData.DirsNotRemoved[P], nil, RestartDeleteDirList);
    end;
  finally
    DeleteDirData.DirsNotRemoved.Free;
    RestartDeleteDirList.Free;
    for P := 0 to ChangeNotifyList.Count-1 do
      if DirExists(ChangeNotifyList[P]) then
        SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_PATH or SHCNF_FLUSH,
          PChar(ChangeNotifyList[P]), nil);
    RunOnceList.Free;
    ChangeNotifyList.Free;
  end;
  Log('Uninstallation process succeeded.');
end;

function TUninstallLog.ShouldRemoveSharedFile(const Filename: String): Boolean;
begin
  Result := True;
end;

procedure TUninstallLog.StatusUpdate(StartingCount, CurCount: Integer);
begin
end;

procedure TUninstallLog.Save(const Filename: String;
  const Append, UpdateUninstallLogAppName: Boolean);
{ Saves all undo data to Filename. If Append is True, it appends the current
  undo data to the end of the existing file. When Append is True, it assumes
  compatibility has already been verified with the Test method. }
var
  F: TFile;
  Buffer: array[0..4095] of Byte;
  BufCount: Cardinal;

  procedure Flush;
  var
    CrcHeader: TUninstallCrcHeader;
  begin
    if BufCount <> 0 then begin
      CrcHeader.Size := BufCount;
      CrcHeader.NotSize := not CrcHeader.Size;
      CrcHeader.CRC := GetCRC32(Buffer, BufCount);
      F.WriteBuffer(CrcHeader, SizeOf(CrcHeader));
      F.WriteBuffer(Buffer, BufCount);
      BufCount := 0;
    end;
  end;

  procedure WriteBuf(const Buf; Size: Cardinal);
  var
    P: Pointer;
    S: Cardinal;
  begin
    P := @Buf;
    while Size <> 0 do begin
      S := Size;
      if S > SizeOf(Buffer) - BufCount then
        S := SizeOf(Buffer) - BufCount;
      Move(P^, Buffer[BufCount], S);
      Inc(BufCount, S);
      if BufCount = SizeOf(Buffer) then
        Flush;
      Inc(Cardinal(P), S);
      Dec(Size, S);
    end;
  end;

var
  Header: TUninstallLogHeader;
  FileRec: TUninstallFileRec;
  CurRec: PUninstallRec;
begin
  BufCount := 0;
  if not Append then
    F := TFile.Create(Filename, fdCreateAlways, faReadWrite, fsNone)
  else
    F := TFile.Create(Filename, fdOpenExisting, faReadWrite, fsNone);
  try
    if not Append then begin
      FillChar(Header, SizeOf(Header), 0);
      F.WriteBuffer(Header, SizeOf(Header));
      {goes back and fills in correct values later}
    end
    else begin
      F.ReadBuffer(Header, SizeOf(Header));
      F.Seek(Header.EndOffset);
    end;

    CurRec := List;
    while CurRec <> nil do begin
      FileRec.Typ := Ord(CurRec^.Typ);
      FileRec.ExtraData := CurRec^.ExtraData;
      FileRec.DataSize := CurRec^.DataSize;
      WriteBuf(FileRec, SizeOf(FileRec));
      WriteBuf(CurRec^.Data, CurRec^.DataSize);
      Inc(Header.NumRecs);

      CurRec := CurRec^.Next;
    end;
    Flush;

    Header.EndOffset := F.Position.Lo;
    F.Seek(0);
    Header.ID := UninstallLogID;
    StrPLCopy(Header.AppId, AppId, SizeOf(Header.AppId)-1);
    if not Append or UpdateUninstallLogAppName then
      StrPLCopy(Header.AppName, AppName, SizeOf(Header.AppName)-1);
    if Version > Header.Version then
      Header.Version := Version;
    TUninstallLogFlags((@Header.Flags)^) := TUninstallLogFlags((@Header.Flags)^) + Flags;
    Header.CRC := GetCRC32(Header, SizeOf(Header)-SizeOf(Longint));
    { Prior to rewriting the header with the new EndOffset value, ensure the
      records we wrote earlier are flushed to disk. This should prevent the
      file from ever becoming corrupted/unreadable in the event the system
      crashes a split second from now. At worst, EndOffset will have the old
      value and any extra bytes past EndOffset will be ignored/discarded when
      the file is read at uninstall time, or appended to the next time Setup
      is run. }
    FlushFileBuffers(F.Handle);
    F.WriteBuffer(Header, SizeOf(Header));
  finally
    F.Free;
  end;
end;

procedure TUninstallLog.Load(const F: TFile; const Filename: String);
{ Loads all undo data from F (an open File variable with a record size of 1).
  The Filename parameter is just used when generating exception error messages.
  Note: The position of the file pointer after calling this function is
  undefined. }
var
  Buffer: array[0..4095] of Byte;
  BufPos, BufLeft: Cardinal;
  Header: TUninstallLogHeader;

  procedure Corrupt;
  begin
    raise Exception.Create(FmtSetupMessage1(msgUninstallDataCorrupted, Filename));
  end;

  procedure FillBuffer;
  var
    CrcHeader: TUninstallCrcHeader;
  begin
    while BufLeft = 0 do begin
      if Cardinal(F.Position.Lo + SizeOf(CrcHeader)) > Cardinal(Header.EndOffset) then
        Corrupt;
      F.ReadBuffer(CrcHeader, SizeOf(CrcHeader));
      if (CrcHeader.Size <> not CrcHeader.NotSize) or
         (Cardinal(CrcHeader.Size) > Cardinal(SizeOf(Buffer))) or
         (Cardinal(F.Position.Lo + CrcHeader.Size) > Cardinal(Header.EndOffset)) then
        Corrupt;
      F.ReadBuffer(Buffer, CrcHeader.Size);
      if not(ufDontCheckRecCRCs in Flags) and
        (CrcHeader.CRC <> GetCRC32(Buffer, CrcHeader.Size)) then
        Corrupt;
      BufPos := 0;
      BufLeft := CrcHeader.Size;
    end;
  end;

  procedure ReadBuf(var Buf; Size: Cardinal);
  var
    P: Pointer;
    S: Cardinal;
  begin
    P := @Buf;
    while Size <> 0 do begin
      if BufLeft = 0 then
        FillBuffer;
      S := Size;
      if S > BufLeft then
        S := BufLeft;
      Move(Buffer[BufPos], P^, S);
      Inc(BufPos, S);
      Dec(BufLeft, S);
      Inc(Cardinal(P), S);
      Dec(Size, S);
    end;
  end;

var
  FileRec: TUninstallFileRec;
  I: Integer;
  P, P2: Pointer;
begin
  BufPos := 0;
  BufLeft := 0;
  P := nil;

  try
    F.Seek(0);
    if F.Read(Header, SizeOf(Header)) <> SizeOf(Header) then
      Corrupt;
    if ((Header.CRC <> $11111111) and
        { ^ for debugging purposes, you can change the CRC field in the file to
          $11111111 to disable CRC checking on the header}
        (Header.CRC <> GetCRC32(Header, SizeOf(Header)-SizeOf(Longint)))) or
       (Header.ID <> UninstallLogID) then
      Corrupt;
    if Header.Version > HighestSupportedVersion then
      raise Exception.Create(FmtSetupMessage1(msgUninstallUnsupportedVer, Filename));
    AppId := StrPas(Header.AppId);
    AppName := StrPas(Header.AppName);
    Flags := TUninstallLogFlags((@Header.Flags)^);

    for I := 1 to Header.NumRecs do begin
      ReadBuf(FileRec, SizeOf(FileRec));
      GetMem(P, FileRec.DataSize);
      { if ReadBuf raises an exception, P will be freed in the 'finally' section }
      ReadBuf(P^, FileRec.DataSize);
      P2 := P;
      P := nil;  { clear P so the 'finally' section won't free it }
      InternalAdd(TUninstallRecTyp(FileRec.Typ), P2, FileRec.DataSize, FileRec.ExtraData);
    end;
  finally
    FreeMem(P);
  end;
end;

function TUninstallLog.Test(const Filename, AAppId: String): Boolean;
{ Returns True if Filename is a recognized uninstall log format, and its
  AppId header field matches the AppId parameter }
var
  F: TFile;
  Header: TUninstallLogHeader;
begin
  Result := False;
  try
    F := TFile.Create(Filename, fdOpenExisting, faRead, fsRead);
    try
      if F.Read(Header, SizeOf(Header)) <> SizeOf(Header) then
        Exit;
      if ((Header.CRC <> $11111111) and
          { ^ for debugging purposes, you can change the CRC field in the file to
            $11111111 to disable CRC checking on the header}
          (Header.CRC <> GetCRC32(Header, SizeOf(Header)-SizeOf(Longint)))) or
         (Header.ID <> UninstallLogID) or
         (Header.AppId <> AAppId) then
        Exit;
      Result := True;
    finally
      F.Free;
    end;
  except
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -