⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        Result := SimpleExpression.Eval;
      finally
        SimpleExpression.Free;
      end;
    except
      InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
      Result := False;
    end;
  end;

  function EvalCheck(const Expression: String; Default: Boolean): Boolean;
  var
    SimpleExpression: TSimpleExpression;
  begin
    try
      SimpleExpression := TSimpleExpression.Create;
      try
        SimpleExpression.Lazy := True;
        SimpleExpression.Expression := Expression;
        SimpleExpression.OnEvalIdentifier := TDummyClass.EvalCheckIdentifier;
        SimpleExpression.OnExpandConstant := TDummyClass.ExpandCheckOrInstallConstant;
        SimpleExpression.ParametersAllowed := True;
        SimpleExpression.SilentOrAllowed := False;
        SimpleExpression.SingleIdentifierMode := False;
        SimpleExpression.Tag := LongInt(Default);
        Result := SimpleExpression.Eval;
      finally
        SimpleExpression.Free;
      end;
    except
      InternalError(Format('Expression error ''%s''', [GetExceptMessage]));
      Result := False;
    end;
  end;

var
  ProcessComponent, ProcessTask, ProcessLanguage: Boolean;
begin
  if (Components <> '') or (Tasks <> '') or (Languages <> '') or (Check <> '') then begin
    if (Components <> '') and (WizardComponents <> nil) then
      ProcessComponent := EvalExpression(Components, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardComponents))
    else
      ProcessComponent := True;

    if (Tasks <> '') and (WizardTasks <> nil) then
      ProcessTask := EvalExpression(Tasks, TDummyClass.EvalComponentOrTaskIdentifier, LongInt(WizardTasks))
    else
      ProcessTask := True;

    if Languages <> '' then
      ProcessLanguage := EvalExpression(Languages, TDummyClass.EvalLanguageIdentifier, 0)
    else
      ProcessLanguage := True;

    Result := ProcessComponent and ProcessTask and ProcessLanguage;
    if Result and (Check <> '') then begin
      try
        if CodeRunner = nil then
          InternalError('"Check" parameter with no CodeRunner');
        Result := EvalCheck(Check, Result);
      except
        { Don't allow exceptions raised by Check functions to be propagated out }
        Application.HandleException(nil);
        Result := False;
      end;
    end;
  end else
    Result := True;
end;

function ShouldProcessFileEntry(const WizardComponents, WizardTasks: TStringList;
  const FileEntry: PSetupFileEntry; const IgnoreCheck: Boolean): Boolean;
begin
  CheckOrInstallCurrentFileName := FileEntry.DestName;
  if IgnoreCheck then
    Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, '')
  else
    Result := ShouldProcessEntry(WizardComponents, WizardTasks, FileEntry.Components, FileEntry.Tasks, FileEntry.Languages, FileEntry.Check);
  CheckOrInstallCurrentFileName := '';
end;

function ShouldProcessRunEntry(const WizardComponents, WizardTasks: TStringList;
  const RunEntry: PSetupRunEntry): Boolean;
begin
  if (InstallMode <> imNormal) and (roSkipIfSilent in RunEntry.Options) then
    Result := False
  else if (InstallMode = imNormal) and (roSkipIfNotSilent in RunEntry.Options) then
    Result := False
  else
    Result := ShouldProcessEntry(WizardComponents, WizardTasks, RunEntry.Components, RunEntry.Tasks, RunEntry.Languages, RunEntry.Check);
end;

function ShouldProcessIconEntry(const WizardComponents, WizardTasks: TStringList;
  const WizardNoIcons: Boolean; const IconEntry: PSetupIconEntry): Boolean;
begin
  if WizardNoIcons and (IconEntry.Tasks = '') then
    Result := False
  else
    Result := ShouldProcessEntry(WizardComponents, WizardTasks, IconEntry.Components, IconEntry.Tasks, IconEntry.Languages, IconEntry.Check);
end;

procedure LoadInf(const FileName: String);
var
  Section: String;
begin
  Section := 'Setup';
  //saved infs
  InitLang := GetIniString(Section, 'Lang', InitLang, FileName);
  InitDir := GetIniString(Section, 'Dir', InitDir, FileName);
  InitProgramGroup := GetIniString(Section, 'Group', InitProgramGroup, FileName);
  InitNoIcons := GetIniBool(Section, 'NoIcons', InitNoIcons, FileName);
  InitComponents.CommaText := GetIniString(Section, 'Components', InitComponents.CommaText, FileName);
  //non saved infs (=non user settable)
  InitSilent := GetIniBool(Section, 'Silent', InitSilent, FileName);
  InitVerySilent := GetIniBool(Section, 'VerySilent', InitVerySilent, FileName);
  InitNoRestart := GetIniBool(Section, 'NoRestart', InitNoRestart, FileName);
  InitPassword := GetIniString(Section, 'Password', InitPassword, FileName);
  InitRestartExitCode := GetIniInt(Section, 'RestartExitCode', InitRestartExitCode, 0, 0, FileName);
  InitSaveInf := GetIniString(Section, 'SaveInf', InitSaveInf, FileName);
end;

procedure SaveInf(const FileName: String);
var
  Section: String;
begin
  Section := 'Setup';
  SetIniString(Section, 'Lang',
    PSetupLanguageEntry(Entries[seLanguage][ActiveLanguage]).Name, FileName);
  SetIniString(Section, 'Dir', WizardDirValue, FileName);
  SetIniString(Section, 'Group', WizardGroupValue, FileName);
  SetIniBool(Section, 'NoIcons', WizardNoIcons, FileName);
  SetIniString(Section, 'Components', WizardComponents.CommaText, FileName);
end;

function ExpandIndividualConst(const Cnst: String;
  const CustomConsts: array of String): String;
{ Cnst must be the name of a single constant, without the braces.
  For example: app
  IsPath is set to True if the result is a path which needs special trailing-
  backslash handling. }

  procedure NoUninstallConstError(const C: String);
  begin
    InternalError(Format('Cannot evaluate "%s" constant during Uninstall', [C]));
  end;

  function ExpandEnvConst(C: String): String;
  var
    I: Integer;
    VarName, Default: String;
  begin
    Delete(C, 1, 1);
    I := ConstPos('|', C);  { check for 'default' value }
    if I = 0 then
      I := Length(C)+1;
    VarName := Copy(C, 1, I-1);
    Default := Copy(C, I+1, Maxint);
    Result := '';
    if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
      Result := GetEnv(ExpandConstEx(VarName, CustomConsts));
      if Result = '' then
        Result := ExpandConstEx(Default, CustomConsts);
    end;
  end;

  function ExpandRegConst(C: String): String;
  { Expands a registry-value constant in the form:
    reg:HKxx\SubkeyName,ValueName|DefaultValue }
  type
    TKeyNameConst = packed record
      KeyName: String;
      KeyConst: HKEY;
    end;
  const
    KeyNameConsts: array[0..4] of TKeyNameConst = (
      (KeyName: 'HKCR'; KeyConst: HKEY_CLASSES_ROOT),
      (KeyName: 'HKCU'; KeyConst: HKEY_CURRENT_USER),
      (KeyName: 'HKLM'; KeyConst: HKEY_LOCAL_MACHINE),
      (KeyName: 'HKU';  KeyConst: HKEY_USERS),
      (KeyName: 'HKCC'; KeyConst: HKEY_CURRENT_CONFIG));
  var
    Z, Subkey, Value, Default: String;
    I, J: Integer;
    RootKey: HKEY;
    K: HKEY;
  begin
    Delete(C, 1, 4);  { skip past 'reg:' }
    I := ConstPos('\', C);
    if I <> 0 then begin
      Z := Copy(C, 1, I-1);
      if Z <> '' then begin
        RootKey := 0;
        for J := Low(KeyNameConsts) to High(KeyNameConsts) do
          if CompareText(KeyNameConsts[J].KeyName, Z) = 0 then begin
            RootKey := KeyNameConsts[J].KeyConst;
            Break;
          end;
        if RootKey <> 0 then begin
          Z := Copy(C, I+1, Maxint);
          I := ConstPos('|', Z);  { check for a 'default' data }
          if I = 0 then
            I := Length(Z)+1;
          Default := Copy(Z, I+1, Maxint);
          SetLength(Z, I-1);
          I := ConstPos(',', Z);  { comma separates subkey and value }
          if I <> 0 then begin
            Subkey := Copy(Z, 1, I-1);
            Value := Copy(Z, I+1, Maxint);
            if ConvertConstPercentStr(Subkey) and ConvertConstPercentStr(Value) and
               ConvertConstPercentStr(Default) then begin
              Result := ExpandConstEx(Default, CustomConsts);
              if RegOpenKeyEx(RootKey, PChar(ExpandConstEx(Subkey, CustomConsts)),
                 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
                RegQueryStringValue(K, PChar(ExpandConstEx(Value, CustomConsts)),
                  Result);
                RegCloseKey(K);
              end;
              Exit;
            end;
          end;
        end;
      end;
    end;
    { it will only reach here if there was a parsing error }
    InternalError('Failed to parse "reg" constant');
  end;

  function ExpandIniConst(C: String): String;
  { Expands an INI-value constant in the form:
    filename,section,key|defaultvalue }
  var
    Z, Filename, Section, Key, Default: String;
    I: Integer;
  begin
    Delete(C, 1, 4);  { skip past 'ini:' }
    I := ConstPos(',', C);
    if I <> 0 then begin
      Z := Copy(C, 1, I-1);
      if Z <> '' then begin
        Filename := Z;
        Z := Copy(C, I+1, Maxint);
        I := ConstPos('|', Z);  { check for a 'default' data }
        if I = 0 then
          I := Length(Z)+1;
        Default := Copy(Z, I+1, Maxint);
        SetLength(Z, I-1);
        I := ConstPos(',', Z);  { comma separates section and key }
        if I <> 0 then begin
          Section := Copy(Z, 1, I-1);
          Key := Copy(Z, I+1, Maxint);
          if ConvertConstPercentStr(Filename) and ConvertConstPercentStr(Section) and ConvertConstPercentStr(Key) and
             ConvertConstPercentStr(Default) then begin
            Filename := ExpandConstEx(Filename, CustomConsts);
            Section := ExpandConstEx(Section, CustomConsts);
            Key := ExpandConstEx(Key, CustomConsts);
            Default := ExpandConstEx(Default, CustomConsts);
            Result := GetIniString(Section, Key, Default, Filename);
            Exit;
          end;
        end;
      end;
    end;
    { it will only reach here if there was a parsing error }
    InternalError('Failed to parse "ini" constant');
  end;

  function ExpandParamConst(C: String): String;
  { Expands an commandline-parameter-value constant in the form:
    parametername|defaultvalue }

    function GetParamString(const StartParam: Integer; const Param, Default: String): String;
    var
      I, PCount: Integer;
      Z: String;
    begin
      PCount := NewParamCount();
      for i := StartParam to PCount do begin
        Z := NewParamStr(i);
        if StrLIComp(PChar(Z), PChar('/'+Param+'='), Length(Param)+2) = 0 then begin
          Delete(Z, 1, Length(Param)+2);
          Result := Z;
          Exit;
        end;
      end;

      Result := Default;
    end;

  var
    Z, Param, Default: String;
    I: Integer;
  begin
    Delete(C, 1, 6);  { skip past 'param:' }
    Z := C;
    I := ConstPos('|', Z);  { check for a 'default' data }
    if I = 0 then
      I := Length(Z)+1;
    Default := Copy(Z, I+1, Maxint);
    SetLength(Z, I-1);
    Param := Z;
    if ConvertConstPercentStr(Param) and ConvertConstPercentStr(Default) then begin
      Param := ExpandConstEx(Param, CustomConsts);
      Default := ExpandConstEx(Default, CustomConsts);
      Result := GetParamString(StartParam, Param, Default);
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    InternalError('Failed to parse "param" constant');
  end;

  function ExpandCodeConst(C: String): String;
  { Expands an Pascal-script-value constant in the form:
    parametername|defaultvalue }

    function GetCodeString(const ScriptFunc, Default: String): String;
    begin
      if (CodeRunner <> nil) then
        Result := CodeRunner.RunStringFunction(ScriptFunc, [Default], True, Default)
      else begin
        InternalError('"code" constant with no CodeRunner');
        Result := '';
      end;
    end;

  var
    Z, ScriptFunc, Default: String;
    I: Integer;
  begin
    if ConstReadOnly then
      raise Exception.Create('Cannot evaluate "code" constant because of possible side effects');

    Delete(C, 1, 5);  { skip past 'code:' }
    Z := C;
    I := ConstPos('|', Z);  { check for a 'default' data }
    if I = 0 then
      I := Length(Z)+1;
    Default := Copy(Z, I+1, Maxint);
    SetLength(Z, I-1);
    ScriptFunc := Z;
    if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Default) then begin
      Default := ExpandConstEx(Default, CustomConsts);
      Result := GetCodeString(ScriptFunc, Default);
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    InternalError('Failed to parse "code" constant');
  end;

  function ExpandDriveConst(C: String): String;
  begin
    Delete(C, 1, 6);  { skip past 'drive:' }
    if ConvertConstPercentStr(C) then begin
      Result := PathExtractDrive(ExpandConstEx(C, CustomConsts));
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    InternalError('Failed to parse "drive" constant');
  end;

  function ExpandCustomMessageConst(C: String): String;
  var
    I, J, ArgCount: Integer;
    MsgName: String;
    ArgValues: array[0..8] of String;  { %1 through %9 }
    Found: Boolean;
  begin
    if IsUninstaller then
      NoUninstallConstError('cm');

    Delete(C, 1, 3);  { skip past 'cm:' }

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -