scriptfunc_r.pas

源代码

    Stack.SetString(PStart, GenerateUniqueName(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  end else if Proc.Name = 'GETCOMPUTERNAMESTRING' then begin
    Stack.SetString(PStart, GetComputerNameString());
  end else if Proc.Name = 'GETMD5OFFILE' then begin
    Stack.SetString(PStart, MD5DigestToString(GetMD5OfFile(Stack.GetString(PStart-1))));
  end else if Proc.Name = 'GETMD5OFSTRING' then begin
    Stack.SetString(PStart, MD5DigestToString(GetMD5OfString(Stack.GetString(PStart-1))));
  end else if Proc.Name = 'GETSPACEONDISK' then begin
    if GetSpaceOnDisk(Stack.GetString(PStart-1), FreeBytes, TotalBytes) then begin
      if Stack.GetBool(PStart-2) then begin
        Div64(FreeBytes, 1024*1024);
        Div64(TotalBytes, 1024*1024);
      end;
      { Cap at 2 GB, as [Code] doesn't support 64-bit integers }
      if (FreeBytes.Hi <> 0) or (FreeBytes.Lo and $80000000 <> 0) then
        FreeBytes.Lo := $7FFFFFFF;
      if (TotalBytes.Hi <> 0) or (TotalBytes.Lo and $80000000 <> 0) then
        TotalBytes.Lo := $7FFFFFFF;
      Stack.SetUInt(PStart-3, FreeBytes.Lo);
      Stack.SetUInt(PStart-4, TotalBytes.Lo);
      Stack.SetBool(PStart, True);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'GETUSERNAMESTRING' then begin
    Stack.SetString(PStart, GetUserNameString());
  end else if Proc.Name = 'INCREMENTSHAREDCOUNT' then begin
    IncrementSharedCount(Stack.GetString(PStart), Stack.GetBool(PStart-1));
  end else if Proc.Name = 'EXEC' then begin
    Filename := Stack.GetString(PStart-1);
    if PathCompare(Filename, SetupLdrOriginalFilename) <> 0 then begin
      { Disable windows so the user can't utilize our UI during the InstExec
        call. But don't disable the application window, or else the focus
        won't return to us after the program terminates. }
      WindowList := DisableTaskWindows(Application.Handle);
      try
        { Increment InExecuteLoop to prevent the user from closing the app
          via the application window (taskbar button) }
        if Assigned(MainForm) then
          Inc(MainForm.InExecuteLoop);
        try
          Stack.SetBool(PStart, InstExec(Filename,
            Stack.GetString(PStart-2), Stack.GetString(PStart-3),
            TExecWait(Stack.GetInt(PStart-5)) = ewWaitUntilTerminated,
            TExecWait(Stack.GetInt(PStart-5)) = ewWaitUntilIdle,
            Stack.GetInt(PStart-4), ProcessMessagesProc, ResultCode));
        finally
          if Assigned(MainForm) then
            Dec(MainForm.InExecuteLoop);
        end;
      finally
        EnableTaskWindows(WindowList);
      end;
      Stack.SetInt(PStart-6, ResultCode);
    end else begin
      Stack.SetBool(PStart, False);
      Stack.SetInt(PStart-6, ERROR_ACCESS_DENIED);
    end;
  end else if Proc.Name = 'SHELLEXEC' then begin
    Filename := Stack.GetString(PStart-2);
    if PathCompare(Filename, SetupLdrOriginalFilename) <> 0 then begin
      { Disable windows so the user can't utilize our UI during the InstShellExec
        call. But don't disable the application window, or else the focus
        won't return to us after the program terminates. }
      WindowList := DisableTaskWindows(Application.Handle);
      try
        { Increment InExecuteLoop to prevent the user from closing the app
          via the application window (taskbar button) }
        if Assigned(MainForm) then
          Inc(MainForm.InExecuteLoop);
        try
          Stack.SetBool(PStart, InstShellExec(Stack.GetString(PStart-1), Filename,
            Stack.GetString(PStart-3), Stack.GetString(PStart-4),
            TExecWait(Stack.GetInt(PStart-6)) = ewWaitUntilTerminated,
            TExecWait(Stack.GetInt(PStart-6)) = ewWaitUntilIdle,
            Stack.GetInt(PStart-5), ProcessMessagesProc, ErrorCode));
        finally
          if Assigned(MainForm) then
            Dec(MainForm.InExecuteLoop);
        end;
      finally
        EnableTaskWindows(WindowList);
      end;
      Stack.SetInt(PStart-7, ErrorCode);
    end else begin
      Stack.SetBool(PStart, False);
      Stack.SetInt(PStart-7, ERROR_ACCESS_DENIED);
    end;
  end else if Proc.Name = 'ISPROTECTEDSYSTEMFILE' then begin
    Stack.SetBool(PStart, IsProtectedSystemFile(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'MAKEPENDINGFILERENAMEOPERATIONSCHECKSUM' then begin
    Stack.SetString(PStart, MD5DigestToString(MakePendingFileRenameOperationsChecksum));
  end else if Proc.Name = 'MODIFYPIFFILE' then begin
    Stack.SetBool(PStart, ModifyPifFile(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
  end else if Proc.Name = 'REGISTERSERVER' then begin
    RegisterServer(Stack.GetString(PStart), Stack.GetBool(PStart-1));
  end else if Proc.Name = 'UNREGISTERSERVER' then begin
    Stack.SetBool(PStart, UnregisterServer(Stack.GetString(PStart-1), Stack.GetBool(PStart-2)));
  end else if Proc.Name = 'UNREGISTERFONT' then begin
    UnregisterFont(Stack.GetString(PStart), Stack.GetString(PStart-1));
  end else if Proc.Name = 'RESTARTREPLACE' then begin
    RestartReplace(Stack.GetString(PStart), Stack.GetString(PStart-1));
  end else
    Result := False;
end;

{ InstFnc2 }
function InstFnc2Proc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'CREATESHELLLINK' then begin
    Stack.SetString(PStart, CreateShellLink(Stack.GetString(PStart-1),
      Stack.GetString(PStart-2), Stack.GetString(PStart-3),
      Stack.GetString(PStart-4), Stack.GetString(PStart-5),
      Stack.GetString(PStart-6), Stack.GetInt(PStart-7),
      Stack.GetInt(PStart-8), 0, False));
  end else if Proc.Name = 'REGISTERTYPELIBRARY' then begin
    RegisterTypeLibrary(Stack.GetString(PStart));
  end else if Proc.Name = 'UNREGISTERTYPELIBRARY' then begin
    Stack.SetBool(PStart, UnregisterTypeLibrary(Stack.GetString(PStart-1)));
  end else
    Result := False;
end;

{ Main }
function MainProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

  { Also present in Compile.pas ! }
  function StrToVersionNumbers (const S: String; var VerData: TSetupVersionData): Boolean;
    procedure Split (const Str: String; var Ver: TSetupVersionDataVersion;
      var ServicePack: Word);
    var
      I, J: Integer;
      Z, B: String;
      HasBuild: Boolean;
    begin
      Cardinal(Ver) := 0;
      ServicePack := 0;
      Z := Lowercase(Str);
      I := Pos('sp', Z);
      if I <> 0 then begin
        J := StrToInt(Copy(Z, I+2, Maxint));
        if (J < Low(Byte)) or (J > High(Byte)) then
          Abort;
        ServicePack := J shl 8;
        { ^ Shift left 8 bits because we're setting the "major" service pack
          version number. This parser doesn't currently accept "minor" service
          pack version numbers. }
        SetLength (Z, I-1);
      end;
      I := Pos('.', Z);
      if I = Length(Z) then Abort;
      if I <> 0 then begin
        J := StrToInt(Copy(Z, 1, I-1));
        if (J < Low(Ver.Major)) or (J > High(Ver.Major)) then
          Abort;
        Ver.Major := J;
        Z := Copy(Z, I+1, Maxint);
        I := Pos('.', Z);
        HasBuild := I <> 0;
        if not HasBuild then
          I := Length(Z)+1;
        B := Copy(Z, I+1, Maxint);
        Z := Copy(Z, 1, I-1);
        J := StrToInt(Z);
        if (J < 0) or (J > 99) then Abort;
        if (J < 10) and (Z[1] <> '0') then J := J * 10;
        Ver.Minor := J;
        if HasBuild then begin
          J := StrToInt(B);
          if (J < Low(Ver.Build)) or (J > High(Ver.Build)) then
            Abort;
          Ver.Build := J;
        end;
      end
      else begin  { no minor version specified }
        J := StrToInt(Str);
        if (J < Low(Ver.Major)) or (J > High(Ver.Major)) then
          Abort;
        Ver.Major := J;
      end;
    end;
  var
    I: Integer;
    SP: Word;
  begin
    try
      I := Pos(',', S);
      if I = 0 then Abort;
      Split (Trim(Copy(S, 1, I-1)),
        TSetupVersionDataVersion(VerData.WinVersion), SP);
      if SP <> 0 then Abort;  { only NT has service packs }
      Split (Trim(Copy(S, I+1, Maxint)),
        TSetupVersionDataVersion(VerData.NTVersion), VerData.NTServicePack);
      Result := True;
    except
      Result := False;
    end;
  end;

var
  PStart: Cardinal;
  MinVersion, OnlyBelowVersion: TSetupVersionData;
  WizardComponents, WizardTasks: TStringList;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'WIZARDFORM' then begin
    Stack.SetClass(PStart, GetWizardForm);
  end else if Proc.Name = 'MAINFORM' then begin
    Stack.SetClass(PStart, GetMainForm);
  end else if Proc.Name = 'ACTIVELANGUAGE' then begin
    Stack.SetString(PStart, ExpandConst('{language}'));
  end else if Proc.Name = 'ISCOMPONENTSELECTED' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    WizardComponents := TStringList.Create();
    try
      GetWizardForm.GetSelectedComponents(WizardComponents, False, False);
      Stack.SetBool(PStart, ShouldProcessEntry(WizardComponents, nil, Stack.GetString(PStart-1), '', '', ''));
    finally
      WizardComponents.Free();
    end;
  end else if Proc.Name = 'ISTASKSELECTED' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    WizardTasks := TStringList.Create();
    try
      GetWizardForm.GetSelectedTasks(WizardTasks, False, False, False);
      Stack.SetBool(PStart, ShouldProcessEntry(nil, WizardTasks, '', Stack.GetString(PStart-1), '', ''));
    finally
      WizardTasks.Free();
    end;
  end else if Proc.Name = 'EXPANDCONSTANT' then begin
    Stack.SetString(PStart, ExpandConst(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'EXPANDCONSTANTEX' then begin
    Stack.SetString(PStart, ExpandConstEx(Stack.GetString(PStart-1), [Stack.GetString(PStart-2), Stack.GetString(PStart-3)]));
  end else if Proc.Name = 'EXITSETUPMSGBOX' then begin
    Stack.SetBool(PStart, ExitSetupMsgBox());
  end else if Proc.Name = 'GETSHELLFOLDER' then begin
    Stack.SetString(PStart, GetShellFolder(Stack.GetBool(PStart-1), TShellFolderID(Stack.GetInt(PStart-2)), False));
  end else if Proc.Name = 'GETSHELLFOLDERBYCSIDL' then begin
    Stack.SetString(PStart, GetShellFolderByCSIDL(Stack.GetInt(PStart-1), Stack.GetBool(PStart-2)));
  end else if Proc.Name = 'INSTALLONTHISVERSION' then begin
    if not StrToVersionNumbers(Stack.GetString(PStart-1), MinVersion) then
      Stack.SetInt(PStart, irInvalid)
    else if not StrToVersionNumbers(Stack.GetString(PStart-2), OnlyBelowVersion) then
      Stack.SetInt(PStart, irInvalid)
    else
      Stack.SetInt(PStart, Integer(InstallOnThisVersion(MinVersion, OnlyBelowVersion)));
  end else if Proc.Name = 'GETWINDOWSVERSION' then begin
    Stack.SetUInt(PStart, WindowsVersion);
  end else if Proc.Name = 'GETWINDOWSVERSIONSTRING' then begin
    Stack.SetString(PStart, Format('%u.%.2u.%u', [WindowsVersion shr 24,
      (WindowsVersion shr 16) and $FF, WindowsVersion and $FFFF]));
  end else
    Result := False;
end;

{ Msgs }
function MsgsProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'SETUPMESSAGE' then begin
    Stack.SetString(PStart, SetupMessages[TSetupMessageID(Stack.GetInt(PStart-1))]);
  end else
    Result := False;
end;

{ System }
function SystemProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
  F: TFile;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'RANDOM' then begin
    Stack.SetInt(PStart, Random(Stack.GetInt(PStart-1)));
  end else if Proc.Name = 'FILESIZE' then begin
    try
      F := TFile.Create(Stack.GetString(PStart-1), fdOpenExisting, faRead, fsReadWrite);
      try
        Stack.SetInt(PStart-2, F.CappedSize);
        Stack.SetBool(PStart, True);
      finally
        F.Free;
      end;
    except
      Stack.SetBool(PStart, False);
    end;
  end else
    Result := False;
end;

{ SysUtils }

type
  { *Must* keep this in synch with ScriptFunc_C }
  TFindRec = record
    Name: String;
    Attributes: LongWord;
    SizeHigh: LongWord;
    SizeLow: LongWord;
    FindHandle: THandle;
  end;

function SysUtilsProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;

  { ExtractRelativePath is not in Delphi 2's SysUtils. Use the one from Delphi 5. }
  function ExtractRelativePath(const BaseName, DestName: string): string;
  var
    BasePath, DestPath: string;
    BaseDirs, DestDirs: array[0..129] of PChar;
    BaseDirCount, DestDirCount: Integer;
    I, J: Integer;