scriptfunc_r.pas

源代码

      Result := '(There is no current exception)'
    else begin
      if Assigned(Caller.ExceptionObject) and (Caller.ExceptionObject is Exception) then
        Result := Exception(Caller.ExceptionObject).Message
      else
        Result := PSErrorToString(Caller.ExceptionCode, Caller.ExceptionString);
    end;
  end;

  { Based on FindPreviousData in Wizard.pas }
  function GetPreviousData(const ExpandedAppID, ValueName, DefaultValueData: String): String;
  const
    RootKeys: array[0..1] of HKEY = (HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE);
  var
    I: Integer;
    H: HKEY;
    UninstallRegKeyBaseName: String;
  begin
    Result := DefaultValueData;
    if ExpandedAppId <> '' then begin
      UninstallRegKeyBaseName := GetUninstallRegKeyBaseName(ExpandedAppId);
      for I := 0 to 1 do begin
        if RegOpenKeyEx(RootKeys[I], PChar(Format('%s\%s_is1', [NEWREGSTR_PATH_UNINSTALL, UninstallRegKeyBaseName])), 0, KEY_QUERY_VALUE, H) = ERROR_SUCCESS then begin
          try
            { do not localize or change the following strings }
            RegQueryStringValue (H, PChar('Inno Setup CodeFile: ' + ValueName), Result);
          finally
            RegCloseKey (H);
          end;
          Break;
        end;
      end;
    end;
  end;

  { Also see RegisterUninstallInfo in Install.pas }
  function SetPreviousData(const PreviousDataKey: HKEY; const ValueName, ValueData: String): Boolean;
  begin
    if ValueData <> '' then
      Result := RegSetValueEx(PreviousDataKey, PChar('Inno Setup CodeFile: ' + ValueName), 0, REG_SZ, PChar(ValueData), Length(ValueData)+1) = ERROR_SUCCESS
    else
      Result := True;
  end;

  function LoadStringFromFile(const FileName: String; var S: String): Boolean;
  var
    F: TFile;
    N: Cardinal;
  begin
    try
      F := TFile.Create(FileName, fdOpenExisting, faRead, fsRead);
      try
        N := F.CappedSize;
        SetLength(S, N);
        F.ReadBuffer(S[1], N);
      finally
        F.Free;
      end;

      Result := True;
    except
      Result := False;
    end;
  end;

  function LoadStringsFromFile(const FileName: String; Arr: PPSVariantIFC): Boolean;
  var
    F: TTextFileReader;
    I: Integer;
    S: String;
  begin
    try
      F := TTextFileReader.Create(FileName, fdOpenExisting, faRead, fsRead);
      try
        PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, 0);
        I := 0;
        while not F.Eof do begin
          S := F.ReadLine;
          PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1);
          VNSetString(PSGetArrayField(Arr^, I), S);
          Inc(I);
        end;
      finally
        F.Free;
      end;

      Result := True;
    except
      Result := False;
    end;
  end;

  function SaveStringToFile(const FileName, S: String; Append: Boolean): Boolean;
  var
    F: TFile;
  begin
    try
      if Append then
        F := TFile.Create(FileName, fdOpenAlways, faWrite, fsNone)
      else
        F := TFile.Create(FileName, fdCreateAlways, faWrite, fsNone);
      try
        F.SeekToEnd;
        F.WriteBuffer(S[1], Length(S));
      finally
        F.Free;
      end;

      Result := True;
    except
      Result := False;
    end;
  end;

  function SaveStringsToFile(const FileName: String; const Arr: PPSVariantIFC; Append: Boolean): Boolean;
  var
    F: TTextFileWriter;
    I, N: Integer;
  begin
    try
      if Append then
        F := TTextFileWriter.Create(FileName, fdOpenAlways, faWrite, fsNone)
      else
        F := TTextFileWriter.Create(FileName, fdCreateAlways, faWrite, fsNone);
      try
        N := PSDynArrayGetLength(Pointer(Arr.Dta^), Arr.aType);
        for I := 0 to N-1 do
          F.WriteLine(VNGetString(PSGetArrayField(Arr^, I)));
      finally
        F.Free;
      end;

      Result := True;
    except
      Result := False;
    end;
  end;

var
  PStart: Cardinal;
  TypeEntry: PSetupTypeEntry;
  StringList: TStringList;
  S: String;
  Arr: TPSVariantIFC;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'BRINGTOFRONTANDRESTORE' then begin
    Application.BringToFront();
    Application.Restore();
  end else if Proc.Name = 'WIZARDDIRVALUE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.DirEdit.Text));
  end else if Proc.Name = 'WIZARDGROUPVALUE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    Stack.SetString(PStart, RemoveBackslashUnlessRoot(GetWizardForm.GroupEdit.Text));
  end else if Proc.Name = 'WIZARDNOICONS' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    Stack.SetBool(PStart, GetWizardForm.NoIconsCheck.Checked);
  end else if Proc.Name = 'WIZARDSETUPTYPE' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    TypeEntry := GetWizardForm.GetSetupType();
    if TypeEntry <> nil then begin
      if Stack.GetBool(PStart-1) then
        Stack.SetString(PStart, TypeEntry.Description)
      else
        Stack.SetString(PStart, TypeEntry.Name);
    end
    else
      Stack.SetString(PStart, '');
  end else if Proc.Name = 'WIZARDSELECTEDCOMPONENTS' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    StringList := TStringList.Create();
    try
      GetWizardForm.GetSelectedComponents(StringList, Stack.GetBool(PStart-1), False);
      Stack.SetString(PStart, StringList.CommaText);
    finally
      StringList.Free();
    end;
  end else if Proc.Name = 'WIZARDSELECTEDTASKS' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    StringList := TStringList.Create();
    try
      GetWizardForm.GetSelectedTasks(StringList, Stack.GetBool(PStart-1), False, False);
      Stack.SetString(PStart, StringList.CommaText);
    finally
      StringList.Free();
    end;
  end else if Proc.Name = 'WIZARDSILENT' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    Stack.SetBool(PStart, InstallMode <> imNormal);
  end else if Proc.Name = 'ISUNINSTALLER' then begin
    Stack.SetBool(PStart, IsUninstaller);
  end else if Proc.Name = 'UNINSTALLSILENT' then begin
    if not IsUninstaller then
      NoSetupFuncError(Proc.Name);
    Stack.SetBool(PStart, UninstallSilent);
  end else if Proc.Name = 'CURRENTFILENAME' then begin
    if IsUninstaller then
      NoUninstallFuncError(Proc.Name);
    if CheckOrInstallCurrentFileName <> '' then
      Stack.SetString(PStart, CheckOrInstallCurrentFileName)
    else
      InternalError('An attempt was made to call the "CurrentFileName" function from outside a "Check", "BeforeInstall" or "AfterInstall" event function belonging to a "[Files]" entry');
  end else if Proc.Name = 'CASTSTRINGTOINTEGER' then begin
    Stack.SetInt(PStart, Integer(PChar(Stack.GetString(PStart-1))));
  end else if Proc.Name = 'CASTINTEGERTOSTRING' then begin
    Stack.SetString(PStart, String(PChar(Stack.GetInt(PStart-1))));
  end else if Proc.Name = 'ABORT' then begin
    Abort;
  end else if Proc.Name = 'GETEXCEPTIONMESSAGE' then begin
    Stack.SetString(PStart, GetExceptionMessage);
  end else if Proc.Name = 'RAISEEXCEPTION' then begin
    raise Exception.Create(Stack.GetString(PStart));
  end else if Proc.Name = 'SHOWEXCEPTIONMESSAGE' then begin
    TMainForm.ShowExceptionMsg(AddPeriod(GetExceptionMessage));
  end else if Proc.Name = 'TERMINATED' then begin
    Stack.SetBool(PStart, Application.Terminated);
  end else if Proc.Name = 'GETPREVIOUSDATA' then begin
    if IsUninstaller then
      Stack.SetString(PStart, GetPreviousData(UninstallExpandedAppId, Stack.GetString(PStart-1), Stack.GetString(PStart-2)))
    else
      Stack.SetString(PStart, GetPreviousData(ExpandConst(SetupHeader.AppId), Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  end else if Proc.Name = 'SETPREVIOUSDATA' then begin
    Stack.SetBool(PStart, SetPreviousData(Stack.GetInt(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  end else if Proc.Name = 'LOADSTRINGFROMFILE' then begin
    S := Stack.GetString(PStart-2);
    Stack.SetBool(PStart, LoadStringFromFile(Stack.GetString(PStart-1), S));
    Stack.SetString(PStart-2, S);
  end else if Proc.Name = 'LOADSTRINGSFROMFILE' then begin
    Arr := NewTPSVariantIFC(Stack[PStart-2], True);
    Stack.SetBool(PStart, LoadStringsFromFile(Stack.GetString(PStart-1), @Arr));
  end else if Proc.Name = 'SAVESTRINGTOFILE' then begin
    Stack.SetBool(PStart, SaveStringToFile(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3)));
  end else if Proc.Name = 'SAVESTRINGSTOFILE' then begin
    Arr := NewTPSVariantIFC(Stack[PStart-2], True);
    Stack.SetBool(PStart, SaveStringsToFile(Stack.GetString(PStart-1), @Arr, Stack.GetBool(PStart-3)));
  end else
    Result := False;
end;

{---}

procedure ScriptFuncLibraryInit();
begin
end;

procedure ScriptFuncLibraryRegister_R(ScriptInterpreter: TPSExec);

  function ExtractName(const S: String): String;
  var
    P: Integer;
  begin
    Result := S;

    if CompareText(Copy(Result, 1, Length('function')), 'function') = 0 then
      Delete(Result, 1, Length('function'))
    else if CompareText(Copy(Result, 1, Length('procedure')), 'procedure') = 0 then
      Delete(Result, 1, Length('procedure'));

    P := Pos('(', Result);
    if P = 0 then
      P := Pos(':', Result);
    if P = 0 then
      P := Pos(';', Result);
    Delete(Result, P, Maxint);

    Result := Trim(Result);
  end;

  procedure RegisterFunctionTable(const FunctionTable: array of String;
    const ProcPtr: TPSProcPtr);
  var
    I: Integer;
  begin
    for I := Low(FunctionTable) to High(FunctionTable) do
      ScriptInterpreter.RegisterFunctionName(ExtractName(FunctionTable[I]),
        ProcPtr, nil, nil);
  end;

begin
  RegisterFunctionTable(ScriptDlgTable, @ScriptDlgProc);
  RegisterFunctionTable(NewDiskTable, @NewDiskProc);
  RegisterFunctionTable(CmnFuncTable, @CmnFuncProc);
  RegisterFunctionTable(CmnFunc2Table, @CmnFunc2Proc);
  RegisterFunctionTable(InstallTable, @InstallProc);
  RegisterFunctionTable(InstFuncTable, @InstFuncProc);
  RegisterFunctionTable(InstFnc2Table, @InstFnc2Proc);
  RegisterFunctionTable(MainTable, @MainProc);
  RegisterFunctionTable(MsgsTable, @MsgsProc);
  RegisterFunctionTable(SystemTable, @SystemProc);
  RegisterFunctionTable(SysUtilsTable, @SysUtilsProc);
  RegisterFunctionTable(FileCtrlTable, @FileCtrlProc);
  RegisterFunctionTable(VerInfoTable, @VerInfoProc);
  RegisterFunctionTable(WindowsTable, @WindowsProc);
  RegisterFunctionTable(Ole2Table, @Ole2Proc);
  RegisterFunctionTable(LoggingTable, @LoggingProc);
  RegisterFunctionTable(OtherTable, @OtherProc);

  ScriptInterpreter.RegisterDelphiFunction(@_FindFirst, 'FindFirst', cdRegister);
  ScriptInterpreter.RegisterDelphiFunction(@_FindNext, 'FindNext', cdRegister);
  ScriptInterpreter.RegisterDelphiFunction(@_FindClose, 'FindClose', cdRegister);
end;

procedure ScriptFuncLibraryUpdateVars(ScriptInterpreter: TPSExec);
begin
  {}
end;

procedure ScriptFuncLibraryDeInit();
begin
end;

end.