main.pas

源代码

function GetRealShellFolder(const Common: Boolean; const ID: TShellFolderID;
  ReadOnly: Boolean): String;

  procedure GetFolder(const Common: Boolean);
  const
    CSIDL_COMMON_STARTMENU = $0016;
    CSIDL_COMMON_PROGRAMS = $0017;
    CSIDL_COMMON_STARTUP = $0018;
    CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
    CSIDL_APPDATA = $001A;
    CSIDL_LOCAL_APPDATA = $001C;
    CSIDL_COMMON_FAVORITES = $001F;
    CSIDL_COMMON_APPDATA = $0023;
    CSIDL_COMMON_TEMPLATES = $002D;
    CSIDL_COMMON_DOCUMENTS = $002E;
    FolderIDs: array[Boolean, TShellFolderID] of Integer = (
      { User }
      (CSIDL_DESKTOPDIRECTORY, CSIDL_STARTMENU, CSIDL_PROGRAMS, CSIDL_STARTUP,
       CSIDL_SENDTO, CSIDL_FONTS, CSIDL_APPDATA, CSIDL_PERSONAL,
       CSIDL_TEMPLATES, CSIDL_FAVORITES, CSIDL_LOCAL_APPDATA),
      { Common }
      (CSIDL_COMMON_DESKTOPDIRECTORY, CSIDL_COMMON_STARTMENU, CSIDL_COMMON_PROGRAMS, CSIDL_COMMON_STARTUP,
       CSIDL_SENDTO, CSIDL_FONTS, CSIDL_COMMON_APPDATA, CSIDL_COMMON_DOCUMENTS,
       CSIDL_COMMON_TEMPLATES, CSIDL_COMMON_FAVORITES, CSIDL_LOCAL_APPDATA));
  var
    Z: String;
  begin
    if not ShellFoldersRead[Common, ID] then begin
      { Note: Must pass Create=True or else SHGetFolderPath fails if the
        specified CSIDL is valid but doesn't currently exist. }
      Z := GetShellFolderByCSIDL(FolderIDs[Common, ID], not ReadOnly);
      ShellFolders[Common, ID] := Z;
      if not ReadOnly or (Z <> '') then
        ShellFoldersRead[Common, ID] := True;
    end;
    Result := ShellFolders[Common, ID];
  end;

begin
  Result := '';
  GetFolder(Common);
  if (Result = '') and Common then
    { If it failed to get the path of a Common CSIDL, try getting the
      User version of the CSIDL instead. (Many of the Common CSIDLS are
      unsupported by Win9x.) }
    GetFolder(False);
end;

function GetShellFolder(Common: Boolean; const ID: TShellFolderID;
  ReadOnly: Boolean): String;
begin
  { If the user isn't an administrator, or is running Windows 9x, always fall
    back to user folders, except in the case of sfAppData (which is writable
    by Users on XP) and sfDocs (which is writable by Users on 2000 & XP) }
  if Common and (not IsAdmin or not IsNT) and
     not(ID in [sfAppData, sfDocs]) then
    Common := False;
  Result := GetRealShellFolder(Common, ID, ReadOnly);
end;

function InstallOnThisVersion(const MinVersion: TSetupVersionData;
  const OnlyBelowVersion: TSetupVersionData): TInstallOnThisVersionResult;
var
  Ver, Ver2, MinVer, OnlyBelowVer: Cardinal;
begin
  Ver := WindowsVersion;
  if IsNT then begin
    MinVer := MinVersion.NTVersion;
    OnlyBelowVer := OnlyBelowVersion.NTVersion;
  end
  else begin
    MinVer := MinVersion.WinVersion;
    OnlyBelowVer := OnlyBelowVersion.WinVersion;
  end;
  Result := irInstall;
  if MinVer = 0 then
    Result := irNotOnThisPlatform
  else begin
    if (Ver < MinVer) or
       (IsNT and (LongRec(Ver).Hi = LongRec(MinVer).Hi) and
        (NTServicePackLevel < MinVersion.NTServicePack)) then
      Result := irVerTooLow
    else begin
      if OnlyBelowVer <> 0 then begin
        Ver2 := Ver;
        { A build number of 0 on OnlyBelowVersion means 'match any build' }
        if LongRec(OnlyBelowVer).Lo = 0 then
          Ver2 := Ver2 and $FFFF0000;  { set build number to zero on Ver2 also }
        if not IsNT then begin
          if Ver2 >= OnlyBelowVer then
            Result := irVerTooHigh;
        end
        else begin
          if (Ver2 > OnlyBelowVer) or
             ((LongRec(Ver).Hi = LongRec(OnlyBelowVer).Hi) and
              (NTServicePackLevel >= OnlyBelowVersion.NTServicePack)) then
            Result := irVerTooHigh;
        end;
      end;
    end;
  end;
end;

function GetSizeOfComponent(const ComponentName: String; const ExtraDiskSpaceRequired: Integer64): Integer64;
var
  ComponentNameAsList: TStringList;
  FileEntry: PSetupFileEntry;
  I: Integer;
begin
  Result := ExtraDiskSpaceRequired;

  ComponentNameAsList := TStringList.Create();
  try
    ComponentNameAsList.Add(ComponentName);
    for I := 0 to Entries[seFile].Count-1 do begin
      FileEntry := PSetupFileEntry(Entries[seFile][I]);
      with FileEntry^ do begin
        if (Components <> '') and
           ((Tasks = '') and (Check = '')) then begin {don't count tasks or scripted entries}
          if ShouldProcessFileEntry(ComponentNameAsList, nil, FileEntry, True) then begin
            if LocationEntry <> -1 then
              Inc6464(Result, PSetupFileLocationEntry(Entries[seFileLocation][LocationEntry])^.OriginalSize)
            else
              Inc6464(Result, ExternalSize);
            end;
        end;
      end;
    end;
  finally
    ComponentNameAsList.Free();
  end;
end;

function GetSizeOfType(const TypeName: String; const IsCustom: Boolean): Integer64;
var
  ComponentTypes: TStringList;
  I: Integer;
begin
  Result.Hi := 0;
  Result.Lo := 0;
  ComponentTypes := TStringList.Create();

  for I := 0 to Entries[seComponent].Count-1 do begin
    with PSetupComponentEntry(Entries[seComponent][I])^ do begin
      ComponentTypes.CommaText := Types;
      { For custom types, only count fixed components. Otherwise count all. }
      if IsCustom then begin
        if (coFixed in Options) and ListContains(ComponentTypes, TypeName) then
          Inc6464(Result, Size);
      end else begin
        if ListContains(ComponentTypes, TypeName) then
          Inc6464(Result, Size);
      end;
    end;
  end;

  ComponentTypes.Free();
end;

function IsRecurseableDirectory(const FindData: TWin32FindData): Boolean;
{ Returns True if FindData is a directory that may be recursed into.
  Intended only for use when processing external+recursesubdirs file entries. }
begin
  Result :=
    (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and
    (FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN = 0) and
    (StrComp(FindData.cFileName, '.') <> 0) and
    (StrComp(FindData.cFileName, '..') <> 0);
end;

procedure EnumProc(const Filename: String; Param: Pointer);
begin
  TStringList(Param).Add(PathLowercase(Filename));
end;

function PreviousInstallNotCompleted: Boolean;
var
  SL: TStringList;

  function CheckForFile(Filename: String): Boolean;
  var
    J: Integer;
  begin
    if UsingWinNT then
      Filename := PathLowercase(Filename)
    else
      Filename := PathLowercase(GetShortName(Filename));
    for J := 0 to SL.Count-1 do begin
      if SL[J] = Filename then begin
        LogFmt('Found pending rename or delete that matches one of our files: %s', [Filename]);
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;

  function RecurseExternalCheckForFile(const SearchBaseDir, SearchSubDir,
    SearchWildcard: String; const SourceIsWildcard: Boolean;
    const CurFile: PSetupFileEntry): Boolean;
  var
    SearchFullPath, DestName: String;
    H: THandle;
    FindData: TWin32FindData;
  begin
    SearchFullPath := SearchBaseDir + SearchSubDir + SearchWildcard;
    Result := False;

    H := FindFirstFile(PChar(SearchFullPath), FindData);
    if H <> INVALID_HANDLE_VALUE then begin
      try
        repeat
          if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin

            if SourceIsWildcard then
              if FindData.dwFileAttributes and FILE_ATTRIBUTE_HIDDEN <> 0 then
                Continue;

            DestName := ExpandConst(CurFile^.DestName);
            if not(foCustomDestName in CurFile^.Options) then
              DestName := DestName + SearchSubDir + FindData.cFileName
            else if SearchSubDir <> '' then
              DestName := PathExtractPath(DestName) + SearchSubDir + PathExtractName(DestName);
            if CheckForFile(DestName) then begin
              Result := True;
              Exit;
            end;
          end;
        until not FindNextFile(H, FindData);
      finally
        Windows.FindClose(H);
      end;
    end;

    if foRecurseSubDirsExternal in CurFile^.Options then begin
      H := FindFirstFile(PChar(SearchBaseDir + SearchSubDir + '*'), FindData);
      if H <> INVALID_HANDLE_VALUE then begin
        try
          repeat
            if IsRecurseableDirectory(FindData) then
              if RecurseExternalCheckForFile(SearchBaseDir,
                 SearchSubDir + FindData.cFileName + '\', SearchWildcard,
                 SourceIsWildcard, CurFile) then begin
                Result := True;
                Exit;
              end;
          until not FindNextFile(H, FindData);
        finally
          Windows.FindClose(H);
        end;
      end;
    end;
  end;

var
  I: Integer;
  CurFile: PSetupFileEntry;
  SourceWildcard: String;
begin
  Result := False;
  if Entries[seFile].Count = 0 then
    Exit;
  SL := TStringList.Create;
  try
    EnumFileReplaceOperationsFilenames(EnumProc, SL);
    if SL.Count = 0 then
      Exit;
    for I := 0 to Entries[seFile].Count-1 do begin
      CurFile := PSetupFileEntry(Entries[seFile][I]);
      if (CurFile^.FileType = ftUserFile) and
         ShouldProcessFileEntry(WizardComponents, WizardTasks, CurFile, False) then begin
        if CurFile^.LocationEntry <> -1 then begin
          { Non-external file }
          if CheckForFile(ExpandConst(CurFile^.DestName)) then begin
            Result := True;
            Exit;
          end;
        end
        else begin
          { External file }
          SourceWildcard := ExpandConst(CurFile^.SourceFilename);
          if RecurseExternalCheckForFile(PathExtractPath(SourceWildcard), '',
             PathExtractName(SourceWildcard), IsWildcard(SourceWildcard), CurFile) then begin
            Result := True;
            Exit;
          end;
        end;
      end;
    end;
  finally
    SL.Free;
  end;
end;

procedure DebugNotifyEntry(EntryType: TEntryType; Number: Integer);
var
  Kind: TDebugEntryKind;
  B: Boolean;
begin
  if not Debugging then Exit;
  case EntryType of
    seDir: Kind := deDir;
    seFile: Kind := deFile;
    seIcon: Kind := deIcon;
    seIni: Kind := deIni;
    seRegistry: Kind := deRegistry;
    seInstallDelete: Kind := deInstallDelete;
    seUninstallDelete: Kind := deUninstallDelete;
    seRun: Kind := deRun;
    seUninstallRun: Kind := deUninstallRun;
  else
    Exit;
  end;
  DebugNotify(Kind, Integer(OriginalEntryIndexes[EntryType][Number]), B);
end;

procedure InternalError(const Id: String);
begin
  raise Exception.Create(FmtSetupMessage1(msgErrorInternal2, Id));
end;

procedure CodeRunnerOnDllImport(var DllName: String; var ForceDelayLoad: Boolean);
var
  BaseName: String;
begin
  while True do begin
    if Pos('setup:', DllName) = 1 then begin
      if IsUninstaller then begin
        DllName := '';
        ForceDelayLoad := True;
        Exit;
      end;
      Delete(DllName, 1, Length('setup:'));
    end
    else if Pos('uninstall:', DllName) = 1 then begin
      if not IsUninstaller then begin
        DllName := '';
        ForceDelayLoad := True;
        Exit;
      end;
      Delete(DllName, 1, Length('uninstall:'));
    end
    else
      Break;
  end;

  if Pos('files:', DllName) = 1 then begin
    if IsUninstaller then begin
      { Uninstall doesn't do 'files:' }
      DllName := '';
      ForceDelayLoad := True;
    end
    else begin
      BaseName := ExpandConst(Copy(DllName, Length('files:')+1, Maxint));
      DllName := AddBackslash(TempInstallDir) + BaseName;
      if not NewFileExists(DllName) then
        ExtractTemporaryFile(BaseName);
    end;
  end
  else
    DllName := ExpandConst(DllName);
end;

procedure CodeRunnerOnDebug(const Position: LongInt; var ContinueStepOver: Boolean);
begin
  DebugNotify(deCodeLine, Position, ContinueStepOver);
end;

procedure CodeRunnerOnDebugIntermediate(const Position: LongInt);