scriptfunc_r.pas

源代码

unit ScriptFunc_R;

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

  Script support functions (run time)

  $jrsoftware: issrc/Projects/ScriptFunc_R.pas,v 1.93 2004/12/22 19:52:44 jr Exp $
}

interface

{$I VERSION.INC}

uses
  uPSRuntime;

procedure ScriptFuncLibraryInit;
procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);
procedure ScriptFuncLibraryUpdateVars(ScriptInterpreter: TPSExec);
procedure ScriptFuncLibraryDeInit;

implementation

uses
  Windows, ScriptFunc,
  Forms, SysUtils, Classes, Graphics, Controls, TypInfo,
  {$IFNDEF Delphi3orHigher} Ole2, {$ELSE} ActiveX, {$ENDIF}
  uPSUtils,
  Struct, ScriptDlg, Main, PathFunc, CmnFunc, CmnFunc2, FileClass,
  Install, InstFunc, InstFnc2, Msgs, MsgIDS, NewDisk, Wizard, VerInfo,
  SetupTypes, Int64Em, MD5, Logging, SetupForm;

var
  ScaleBaseUnitsInitialized: Boolean;
  ScaleBaseUnitX, ScaleBaseUnitY: Integer;

procedure NoSetupFuncError(const C: String);
begin
  InternalError(Format('Cannot call "%s" function during Setup', [C]));
end;

procedure NoUninstallFuncError(const C: String);
begin
  InternalError(Format('Cannot call "%s" function during Uninstall', [C]));
end;

function GetMainForm: TMainForm;
begin
  Result := MainForm;
  if Result = nil then
    InternalError('An attempt was made to access MainForm before it has been created'); 
end;

function GetWizardForm: TWizardForm;
begin
  Result := WizardForm;
  if Result = nil then
    InternalError('An attempt was made to access WizardForm before it has been created'); 
end;

procedure InitializeScaleBaseUnits;
var
  Font: TFont;
begin
  if ScaleBaseUnitsInitialized then
    Exit;
  Font := TFont.Create;
  try
    SetFontNameSize(Font, LangOptions.DialogFontName, LangOptions.DialogFontSize,
      '', 8);
    CalculateBaseUnitsFromFont(Font, ScaleBaseUnitX, ScaleBaseUnitY);
  finally
    Font.Free;
  end;
  ScaleBaseUnitsInitialized := True;
end;

{---}

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

  function ArrayToStringList(Arr: PPSVariantIFC): TStringList;
  var
    StringList: TStringList;
    I, N: Integer;
  begin
    StringList := TStringList.Create();
    N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
    for I := 0 to N-1 do
      StringList.Append(VNGetString(PSGetArrayField(Arr^, I)));
    Result := StringList;
  end;

  procedure StringListToArray(StringList: TStringList; Arr: PPSVariantIFC);
  var
    I, N: Integer;
  begin
    N := StringList.Count;
    for I := 0 to N-1 do
      VNSetString(PSGetArrayField(Arr^, I), StringList[I]);
  end;

var
  PStart: Cardinal;
  NewPage: TWizardPage;
  NewInputQueryPage: TInputQueryWizardPage;
  NewInputOptionPage: TInputOptionWizardPage;
  NewInputDirPage: TInputDirWizardPage;
  NewInputFilePage: TInputFileWizardPage;
  NewOutputMsgPage: TOutputMsgWizardPage;
  NewOutputMsgMemoPage: TOutputMsgMemoWizardPage;
  NewOutputProgressPage: TOutputProgressWizardPage;
  NewSetupForm: TSetupForm;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'PAGEFROMID' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    Stack.SetClass(PStart, GetWizardForm.PageFromID(Stack.GetInt(PStart-1)));
  end else if Proc.Name = 'CREATECUSTOMPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewPage := TWizardPage.Create(GetWizardForm);
    try
      NewPage.Caption := Stack.GetString(PStart-2);
      NewPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewPage, Stack.GetInt(PStart-1));
    except
      NewPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewPage);
  end else if Proc.Name = 'CREATEINPUTQUERYPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewInputQueryPage := TInputQueryWizardPage.Create(GetWizardForm);
    try
      NewInputQueryPage.Caption := Stack.GetString(PStart-2);
      NewInputQueryPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewInputQueryPage, Stack.GetInt(PStart-1));
      NewInputQueryPage.Initialize(Stack.GetString(PStart-4));
    except
      NewInputQueryPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewInputQueryPage);
  end else if Proc.Name = 'CREATEINPUTOPTIONPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewInputOptionPage := TInputOptionWizardPage.Create(GetWizardForm);
    try
      NewInputOptionPage.Caption := Stack.GetString(PStart-2);
      NewInputOptionPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewInputOptionPage, Stack.GetInt(PStart-1));
      NewInputOptionPage.Initialize(Stack.GetString(PStart-4),
        Stack.GetBool(PStart-5), Stack.GetBool(PStart-6));
    except
      NewInputOptionPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewInputOptionPage);
  end else if Proc.Name = 'CREATEINPUTDIRPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewInputDirPage := TInputDirWizardPage.Create(GetWizardForm);
    try
      NewInputDirPage.Caption := Stack.GetString(PStart-2);
      NewInputDirPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewInputDirPage, Stack.GetInt(PStart-1));
      NewInputDirPage.Initialize(Stack.GetString(PStart-4), Stack.GetBool(PStart-5),
         Stack.GetString(PStart-6));
    except
      NewInputDirPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewInputDirPage);
  end else if Proc.Name = 'CREATEINPUTFILEPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewInputFilePage := TInputFileWizardPage.Create(GetWizardForm);
    try
      NewInputFilePage.Caption := Stack.GetString(PStart-2);
      NewInputFilePage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewInputFilePage, Stack.GetInt(PStart-1));
      NewInputFilePage.Initialize(Stack.GetString(PStart-4));
    except
      NewInputFilePage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewInputFilePage);
  end else if Proc.Name = 'CREATEOUTPUTMSGPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewOutputMsgPage := TOutputMsgWizardPage.Create(GetWizardForm);
    try
      NewOutputMsgPage.Caption := Stack.GetString(PStart-2);
      NewOutputMsgPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewOutputMsgPage, Stack.GetInt(PStart-1));
      NewOutputMsgPage.Initialize(Stack.GetString(PStart-4));
    except
      NewOutputMsgPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewOutputMsgPage);
  end else if Proc.Name = 'CREATEOUTPUTMSGMEMOPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewOutputMsgMemoPage := TOutputMsgMemoWizardPage.Create(GetWizardForm);
    try
      NewOutputMsgMemoPage.Caption := Stack.GetString(PStart-2);
      NewOutputMsgMemoPage.Description := Stack.GetString(PStart-3);
      GetWizardForm.AddPage(NewOutputMsgMemoPage, Stack.GetInt(PStart-1));
      NewOutputMsgMemoPage.Initialize(Stack.GetString(PStart-4),
         Stack.GetString(PStart-5));
    except
      NewOutputMsgMemoPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewOutputMsgMemoPage);
  end else if Proc.Name = 'CREATEOUTPUTPROGRESSPAGE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    NewOutputProgressPage := TOutputProgressWizardPage.Create(GetWizardForm);
    try
      NewOutputProgressPage.Caption := Stack.GetString(PStart-1);
      NewOutputProgressPage.Description := Stack.GetString(PStart-2);
      GetWizardForm.AddPage(NewOutputProgressPage, -1);
      NewOutputProgressPage.Initialize;
    except
      NewOutputProgressPage.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewOutputProgressPage);
  end else if Proc.Name = 'SCALEX' then begin
    InitializeScaleBaseUnits;
    Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitX, OrigBaseUnitX));
  end else if Proc.Name = 'SCALEY' then begin
    InitializeScaleBaseUnits;
    Stack.SetInt(PStart, MulDiv(Stack.GetInt(PStart-1), ScaleBaseUnitY, OrigBaseUnitY));
  end else if Proc.Name = 'CREATECUSTOMFORM' then begin
    NewSetupForm := TSetupForm.CreateNew(nil);
    try
      NewSetupForm.AutoScroll := False;
      NewSetupForm.BorderStyle := bsDialog;
      NewSetupForm.InitializeFont;
    except
      NewSetupForm.Free;
      raise;
    end;
    Stack.SetClass(PStart, NewSetupForm);
  end else
    Result := False;
end;

{ NewDisk }
function NewDiskProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
  S: String;
  ParentWnd: HWND;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'BROWSEFORFOLDER' then begin
    if Assigned(WizardForm) then
      ParentWnd := WizardForm.Handle
    else
      ParentWnd := 0;
    S := Stack.GetString(PStart-2);
    Stack.SetBool(PStart, BrowseForFolder(Stack.GetString(PStart-1), S, ParentWnd, Stack.GetBool(PStart-3)));
    Stack.SetString(PStart-2, S);
  end else if Proc.Name = 'GETOPENFILENAME' then begin
    if Assigned(WizardForm) then
      ParentWnd := WizardForm.Handle
    else
      ParentWnd := 0;
    S := Stack.GetString(PStart-2);
    Stack.SetBool(PStart, NewGetOpenFileName(Stack.GetString(PStart-1), S, Stack.GetString(PStart-3), Stack.GetString(PStart-4), Stack.GetString(PStart-5), ParentWnd));
    Stack.SetString(PStart-2, S);
  end else
    Result := False;
end;

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

  if Proc.Name = 'MSGBOX' then begin
    if IsUninstaller then
      ID := msgUninstallAppTitle
    else
      ID := msgSetupAppTitle;
    Stack.SetInt(PStart, MsgBox(Stack.GetString(PStart-1), SetupMessages[ID], TMsgBoxType(Stack.GetInt(PStart-2)), Stack.GetInt(PStart-3)));
  end else
    Result := False;
end;

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

  function GetSubkeyOrValueNames(const RootKey: HKEY; const SubKeyName: String;
    Arr: PPSVariantIFC; const Subkey: Boolean): Boolean;
  const
    samDesired: array [Boolean] of REGSAM = (KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS);
  var
    K: HKEY;
    I: Cardinal;
    Buf, S: String;
    BufSize, R: DWORD;
  begin
    Result := False;
    SetString(Buf, nil, 512);