main.pas

源代码

    I := ConstPos(',', C);
    if I = 0 then
      MsgName := C
    else
      MsgName := Copy(C, 1, I-1);

    { Prepare arguments. Excess arguments are ignored. }
    ArgCount := 0;
    while (I > 0) and (ArgCount <= High(ArgValues)) do begin
      Delete(C, 1, I);
      I := ConstPos(',', C);
      if I = 0 then
        ArgValues[ArgCount] := C
      else
        ArgValues[ArgCount] := Copy(C, 1, I-1);
      if not ConvertConstPercentStr(ArgValues[ArgCount]) then
        InternalError('Failed to parse "cm" constant');
      ArgValues[ArgCount] := ExpandConstEx(ArgValues[ArgCount], CustomConsts);
      Inc(ArgCount);
    end;

    { Look up the message value }
    Found := False;
    for J := 0 to Entries[seCustomMessage].Count-1 do begin
      with PSetupCustomMessageEntry(Entries[seCustomMessage][J])^ do begin
        if (CompareText(Name, MsgName) = 0) and
           ((LangIndex = -1) or (LangIndex = ActiveLanguage)) then begin
          Found := True;
          Result := Value;
          { don't stop looping, last item counts }
        end;
      end;
    end;
    if not Found then
      InternalError(Format('Unknown custom message name "%s" in "cm" constant', [MsgName]));

    { Expand the message }
    Result := FmtMessage(PChar(Result), Slice(ArgValues, ArgCount));
  end;

const
  FolderConsts: array[Boolean, TShellFolderID] of String =
    (('userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
      'sendto', 'fonts', 'userappdata', 'userdocs', 'usertemplates',
      'userfavorites', 'localappdata'),
     ('commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
      'sendto', 'fonts', 'commonappdata', 'commondocs', 'commontemplates',
      'commonfavorites', 'localappdata'));
  NoUninstallConsts: array[0..6] of String =
    ('src', 'srcexe', 'userinfoname', 'userinfoorg', 'userinfoserial', 'hwnd',
     'wizardhwnd');
var
  Z: String;
  B: Boolean;
  SF: TShellFolderID;
  K: Integer;
begin
  if IsUninstaller then
    for K := Low(NoUninstallConsts) to High(NoUninstallConsts) do
      if NoUninstallConsts[K] = Cnst then
        NoUninstallConstError(NoUninstallConsts[K]);

  if Cnst = '\' then Result := '\'
  else if Cnst = 'app' then begin
    if IsUninstaller then begin
      if UninstallExpandedApp = '' then
        InternalError('An attempt was made to expand the "app" constant but Setup didn''t create the "app" dir');
      Result := UninstallExpandedApp;
    end else begin
      if WizardDirValue = '' then
        InternalError('An attempt was made to expand the "app" constant before it was initialized');
      Result := WizardDirValue;
    end;
  end
  else if Cnst = 'win' then Result := WinDir
  else if Cnst = 'sys' then Result := WinSystemDir
  else if Cnst = 'src' then Result := SourceDir
  else if Cnst = 'srcexe' then Result := SetupLdrOriginalFilename
  else if Cnst = 'tmp' then Result := TempInstallDir
  else if Cnst = 'sd' then Result := SystemDrive
  else if Cnst = 'pf' then Result := ProgramFilesDir
  else if Cnst = 'cf' then Result := CommonFilesDir
  else if Cnst = 'dao' then Result := DAODir
  else if Cnst = 'cmd' then Result := CmdFilename
  else if Cnst = 'computername' then Result := GetComputerNameString
  else if Cnst = 'username' then Result := GetUserNameString
  else if Cnst = 'groupname' then begin
    if IsUninstaller then begin
      if UninstallExpandedGroupName = '' then
        InternalError('Cannot expand "groupname" constant because it was not available at install time');
      Result := UninstallExpandedGroupName;
    end
    else begin
      if WizardGroupValue = '' then
        InternalError('An attempt was made to expand the "groupname" constant before it was initialized');
      Result := WizardGroupValue;
    end;
  end
  else if Cnst = 'sysuserinfoname' then Result := SysUserInfoName
  else if Cnst = 'sysuserinfoorg' then Result := SysUserInfoOrg
  else if Cnst = 'userinfoname' then Result := WizardUserInfoName
  else if Cnst = 'userinfoorg' then Result := WizardUserInfoOrg
  else if Cnst = 'userinfoserial' then Result := WizardUserInfoSerial
  else if Cnst = 'uninstallexe' then Result := UninstallExeFilename
  else if Cnst = 'group' then begin
    if IsUninstaller then begin
      if UninstallExpandedGroup = '' then
        InternalError('Cannot expand "group" constant because it was not available at install time');
      Result := UninstallExpandedGroup;
    end
    else begin
      if WizardGroupValue = '' then
        InternalError('An attempt was made to expand the "group" constant before it was initialized');
      Z := GetShellFolder(not(shAlwaysUsePersonalGroup in SetupHeader.Options),
        sfPrograms, False);
      if Z = '' then
        InternalError('Failed to expand "group" constant');
      Result := AddBackslash(Z) + WizardGroupValue;
    end;
  end
  else if Cnst = 'language' then begin
    if IsUninstaller then
      Result := UninstallExpandedLanguage
    else
      Result := PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name
  end
  else if Cnst = 'hwnd' then begin
    if Assigned(MainForm) then
      Result := IntToStr(MainForm.Handle)
    else
      Result := '0';
  end
  else if Cnst = 'wizardhwnd' then begin
    if Assigned(WizardForm) then
      Result := IntToStr(WizardForm.Handle)
    else
      Result := '0';
  end
  else if (Cnst <> '') and (Cnst[1] = '%') then Result := ExpandEnvConst(Cnst)
  else if StrLComp(PChar(Cnst), 'reg:', 4) = 0 then Result := ExpandRegConst(Cnst)
  else if StrLComp(PChar(Cnst), 'ini:', 4) = 0 then Result := ExpandIniConst(Cnst)
  else if StrLComp(PChar(Cnst), 'param:', 6) = 0 then Result := ExpandParamConst(Cnst)
  else if StrLComp(PChar(Cnst), 'code:', 5) = 0 then Result := ExpandCodeConst(Cnst)
  else if StrLComp(PChar(Cnst), 'drive:', 6) = 0 then Result := ExpandDriveConst(Cnst)
  else if StrLComp(PChar(Cnst), 'cm:', 3) = 0 then Result := ExpandCustomMessageConst(Cnst)
  else begin
    { Shell folder constants }
    for B := False to True do
      for SF := Low(SF) to High(SF) do
        if Cnst = FolderConsts[B, SF] then begin
          Z := GetShellFolder(B, SF, False);
          if Z = '' then
            InternalError(Format('Failed to expand shell folder constant "%s"', [Cnst]));
          Result := Z;
          Exit;
        end;
    { Custom constants }
    if Cnst <> '' then begin
      K := 0;
      while K < High(CustomConsts) do begin
        if Cnst = CustomConsts[K] then begin
          Result := CustomConsts[K+1];
          Exit;
        end;
        Inc(K, 2);
      end;
    end;
    { Unknown constant }
    InternalError(Format('Unknown constant "%s"', [Cnst]));
  end;
end;

function ExpandConst(const S: String): String;
begin
  Result := ExpandConstEx(S, ['']);
end;

function ExpandConstEx(const S: String; const CustomConsts: array of String): String;
var
  I, Start: Integer;
  Cnst, ReplaceWith: String;
begin
  Result := S;
  I := 1;
  while I <= Length(Result) do begin
    if Result[I] = '{' then begin
      if (I < Length(Result)) and (Result[I+1] = '{') then begin
        { Change '{{' to '{' if not in an embedded constant }
        Inc(I);
        Delete(Result, I, 1);
      end
      else begin
        Start := I;
        { Find the closing brace, skipping over any embedded constants }
        I := SkipPastConst(Result, I);
        if I = 0 then  { unclosed constant? }
          InternalError('Unclosed constant');
        Dec(I);  { 'I' now points to the closing brace }

        { Now translate the constant }
        Cnst := Copy(Result, Start+1, I-(Start+1));
        ReplaceWith := ExpandIndividualConst(Cnst, CustomConsts);
        Delete(Result, Start, (I+1)-Start);
        Insert(ReplaceWith, Result, Start);
        I := Start + Length(ReplaceWith);
        if (ReplaceWith <> '') and (PathLastChar(ReplaceWith)^ = '\') and
           (I <= Length(Result)) and (Result[I] = '\') then
          Delete(Result, I, 1);
      end;
    end
    else begin
      if Result[I] in ConstLeadBytes^ then
        Inc(I);
      Inc(I);
    end;
  end;
end;

procedure InitMainNonSHFolderConsts;

  procedure ReadSysUserInfo;
  const
    Paths: array[Boolean] of PChar = (NEWREGSTR_PATH_SETUP,
      'SOFTWARE\Microsoft\Windows NT\CurrentVersion');
  var
    K: HKEY;
  begin
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, Paths[IsNT], 0, KEY_QUERY_VALUE,
       K) = ERROR_SUCCESS then begin
      RegQueryStringValue(K, 'RegisteredOwner', SysUserInfoName);
      RegQueryStringValue(K, 'RegisteredOrganization', SysUserInfoOrg);
      RegCloseKey(K);
    end;
  end;

begin
  { Read Windows and Windows System dirs }
  WinDir := GetWinDir;
  WinSystemDir := GetSystemDir;

  { Get system drive }
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    SystemDrive := GetEnv('SystemDrive')  {don't localize}
  else
    SystemDrive := '';
  if SystemDrive = '' then begin
    SystemDrive := PathExtractDrive(WinDir);
    if SystemDrive = '' then
      { In some rare case that PathExtractDrive failed, just default to C }
      SystemDrive := 'C:';
  end;

  { Get Program Files and Common Files dirs }
  ProgramFilesDir := GetProgramFilesPath;
  if ProgramFilesDir = '' then
    ProgramFilesDir := SystemDrive + '\Program Files';  {don't localize}
  CommonFilesDir := GetCommonFilesPath;
  if CommonFilesDir = '' then
    CommonFilesDir := AddBackslash(ProgramFilesDir) + 'Common Files';  {don't localize}

  { Generate DAO directory name }
  DAODir := AddBackslash(CommonFilesDir) + 'Microsoft Shared\DAO';

  { Get path of command interpreter }
  if IsNT then
    CmdFilename := AddBackslash(WinSystemDir) + 'cmd.exe'
  else
    CmdFilename := AddBackslash(WinDir) + 'COMMAND.COM';

  { Get user info from system }
  ReadSysUserInfo;
end;

function CreateTempDir: String;
var
  Dir: String;
  ErrorCode: DWORD;
begin
  while True do begin
    Dir := GenerateUniqueName(GetTempDir, '.tmp');
    if CreateDirectory(PChar(Dir), nil) then
      Break;
    ErrorCode := GetLastError;
    if ErrorCode <> ERROR_ALREADY_EXISTS then
      raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
        [FmtSetupMessage1(msgErrorCreatingDir, Dir), IntToStr(ErrorCode),
         Win32ErrorString(ErrorCode)]));
  end;
  Result := Dir;
end;

procedure SaveStreamToTempFile(const Strm: TCustomMemoryStream;
  const Filename: String);
var
  ErrorCode: DWORD;
begin
  try
    Strm.SaveToFile(Filename);
  except
    { Display more useful error message than 'Stream write error' etc. }
    on EStreamError do begin
      ErrorCode := GetLastError;
      raise Exception.Create(FmtSetupMessage(msgLastErrorMessage,
        [SetupMessages[msgLdrCannotCreateTemp], IntToStr(ErrorCode),
         Win32ErrorString(ErrorCode)]));
    end;
  end;
end;

procedure LoadSHFolderDLL;
var
  Filename: String;
  ResStrm: TResourceStream;
  ExistingFileVersion, NewFileVersion: TFileVersionNumbers;
const
  shfolder = 'shfolder.dll';
begin
  Filename := AddBackslash(TempInstallDir) + '_shfoldr.dll';
  {$R _shfoldr.res}  { Link in the .res file containing the DLL image }
  ResStrm := TResourceStream.Create(HInstance, 'SHFOLDERDLL', RT_RCDATA);
  try
    SaveStreamToTempFile(ResStrm, Filename);
  finally
    ResStrm.Free;
  end;
  if not GetVersionNumbers(Filename, NewFileVersion) then
    InternalError('Failed to get version numbers of _shfoldr.dll');
  { Does the system already have the same version or a newer version of
    shfolder.dll? If so, use it instead of the one we just extracted. }
  if GetVersionNumbers(shfolder, ExistingFileVersion) and
     (((ExistingFileVersion.MS > NewFileVersion.MS) or
       ((ExistingFileVersion.MS = NewFileVersion.MS) and
        (ExistingFileVersion.LS > NewFileVersion.LS)))) or
      ((ExistingFileVersion.MS = NewFileVersion.MS) and
       (ExistingFileVersion.LS = NewFileVersion.LS)) then
    Filename := shfolder;
  { Ensure shell32.dll is pre-loaded so it isn't loaded/freed for each
    individual SHGetFolderPath call }
  SafeLoadLibrary(shell32, SEM_NOOPENFILEERRORBOX);
  SHFolderDLLHandle := SafeLoadLibrary(Filename, SEM_NOOPENFILEERRORBOX);
  if SHFolderDLLHandle = 0 then
    InternalError(Format('Failed to load DLL "%s"', [Filename]));
  @SHGetFolderPathFunc := GetProcAddress(SHFolderDLLHandle, 'SHGetFolderPathA');
  if @SHGetFolderPathFunc = nil then
    InternalError('Failed to get address of SHGetFolderPathA function');
end;

procedure UnloadSHFolderDLL;
begin
  @SHGetFolderPathFunc := nil;
  if SHFolderDLLHandle <> 0 then begin
    FreeLibrary(SHFolderDLLHandle);
    SHFolderDLLHandle := 0;
  end;
end;

function GetShellFolderByCSIDL(Folder: Integer; const Create: Boolean): String;
const
  CSIDL_FLAG_CREATE = $8000;
  SHGFP_TYPE_CURRENT = 0;
var
  Buf: array[0..MAX_PATH-1] of Char;
begin
  if Create then
    Folder := Folder or CSIDL_FLAG_CREATE;
  if SHGetFolderPathFunc(0, Folder, 0, SHGFP_TYPE_CURRENT, Buf) = S_OK then
    Result := RemoveBackslashUnlessRoot(PathExpand(Buf))
  else
    Result := '';
end;