regsvr.pas

源代码

unit RegSvr;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Registers OLE servers & type libraries after a reboot

  $jrsoftware: issrc/Projects/RegSvr.pas,v 1.5 2004/07/11 18:50:54 jr Exp $
}

interface

procedure RunRegSvr;

implementation

uses
  Windows, SysUtils, PathFunc, CmnFunc2, InstFunc, InstFnc2, FileClass;

procedure DeleteOldTempFiles(const Path: String);
{ Removes any old isRS-???.tmp files from Path. Not strictly necessary, but
  in case a prior multi-install run left behind multiple .tmp files now is a
  good time to clean them up. }
var
  H: THandle;
  FindData: TWin32FindData;
  Filename: String;
begin
  H := FindFirstFile(PChar(Path + 'isRS-???.tmp'), FindData);
  if H <> INVALID_HANDLE_VALUE then begin
    try
      repeat
        { Yes, this StrLIComp is superfluous. When deleting files from
          potentionally the Windows directory I can't help but be *extra*
          careful. :) }
        if (StrLIComp(FindData.cFileName, 'isRS-', Length('isRS-')) = 0) and
           (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0) then begin
          Filename := Path + FindData.cFileName;
          { If the file is read-only, try to strip the attribute }
          if FindData.dwFileAttributes and FILE_ATTRIBUTE_READONLY <> 0 then
            SetFileAttributes(PChar(Filename), FindData.dwFileAttributes
              and not FILE_ATTRIBUTE_READONLY);
          DeleteFile(Filename);
        end;
      until not FindNextFile(H, FindData);
    finally
      Windows.FindClose(H);
    end;
  end;
end;

function RenameToNonRandomTempName(const Filename: String): String;
{ Renames Filename to a name in the format: isRS-nnn.tmp. Returns the new
  filename if successful, or '' if not.
  Note: This is an NT-only function, as it calls MoveFileEx. }
var
  Path, NewFilename: String;
  Attribs: DWORD;
  Attempts, I: Integer;
begin
  Result := '';
  Path := PathExtractPath(Filename);
  Attempts := 0;
  for I := 0 to 999 do begin
    NewFilename := Path + Format('isRS-%.3u.tmp', [I]);
    Attribs := GetFileAttributes(PChar(NewFilename));
    if Attribs <> $FFFFFFFF then begin
      { Skip any directories that happen to named NewFilename }
      if Attribs and FILE_ATTRIBUTE_DIRECTORY <> 0 then
        Continue;
      { If the existing file is read-only, try to strip the attribute }
      if Attribs and FILE_ATTRIBUTE_READONLY <> 0 then
        SetFileAttributes(PChar(NewFilename), Attribs and not FILE_ATTRIBUTE_READONLY);
    end;
    if MoveFileEx(PChar(Filename), PChar(NewFilename), MOVEFILE_REPLACE_EXISTING) then begin
      Result := NewFilename;
      Break;
    end;
    Inc(Attempts);
    { Limit MoveFileEx calls to 10 since it can be really slow over network
      connections when a file is in use }
    if Attempts = 10 then
      Break;
  end;
end;

procedure DeleteSelf;
var
  SelfFilename, NewFilename: String;
begin
  SelfFilename := NewParamStr(0);
  if Win32Platform = VER_PLATFORM_WIN32_NT then begin
    { On NT, RestartReplace will fail if the user doesn't have admin
      privileges. We don't want to leak temporary files, so try to rename
      ourself to a non-random name. This way, future runs should just keep
      overwriting the same temp file. }
    DeleteOldTempFiles(PathExtractPath(SelfFilename));
    NewFilename := RenameToNonRandomTempName(SelfFilename);
    if NewFilename <> '' then
      RestartReplace(NewFilename, '')
    else
      RestartReplace(SelfFilename, '');
  end
  else
    RestartReplace(SelfFilename, '');
end;

procedure RunRegSvr;
var
  Mutex: THandle;
  F: TTextFileReader;
  L, ListFilename, RegFilename: String;
begin
  if CompareText(NewParamStr(1), '/REG') <> 0 then
    Exit;

  { Try to create and acquire a mutex.
    In cases where multiple IS installers have each created their own RegSvr
    RunOnce entries in HKCU, Windows Explorer will execute them asynchronously.
    This could have undesirable ramifications -- what might happen if the same
    DLL were registered simultaneously by two RegSvr processes? Could the
    registry entries be in an incomplete/inconsistent state? I'm not sure, so
    a mutex is used here to ensure registrations are serialized. }
  Mutex := CreateMutex(nil, False, 'Inno-Setup-RegSvr-Mutex');
  if Mutex <> 0 then
    WaitForSingleObject(Mutex, INFINITE);
  try
    ListFilename := PathChangeExt(NewParamStr(0), '.lst');
    { The .lst file may not exist at this point, if we were already run
      previously, but the RunOnce entry could not be removed due to lack of
      admin privileges. }
    if NewFileExists(ListFilename) then begin
      F := TTextFileReader.Create(ListFilename, fdOpenExisting, faRead, fsRead);
      try
        while not F.Eof do begin
          L := F.ReadLine;
          if (Length(L) > 3) and (L[1] = '[') and (L[3] = ']') then begin
            RegFilename := Copy(L, 4, Maxint);
            try
              case L[2] of
                's': RegisterServer(RegFilename, True);
                't': RegisterTypeLibrary(RegFilename);
              end;
            except
              { can't show exceptions; SetupMessages haven't been loaded }
            end;
          end;
        end;
      finally
        F.Free;
      end;
    end;

    DeleteFile(ListFilename);

    try
      DeleteSelf;
    except
      { ignore exceptions }
    end;
  finally
    if Mutex <> 0 then begin
      ReleaseMutex(Mutex);
      CloseHandle(Mutex);
    end;
  end;
end;

end.