compile.pas

源代码

  { based on ExpandRegConst in Main.pas }
  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;
  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
              CheckConst(Subkey, MinVersion, AllowedConsts);
              CheckConst(Value, MinVersion, AllowedConsts);
              CheckConst(Default, MinVersion, AllowedConsts);
              Result := True;
              Exit;
            end;
          end;
        end;
      end;
    end;
    { it will only reach here if there was a parsing error }
    Result := False;
  end;

  function CheckIniConst(C: String): Boolean;
  { based on ExpandIniConst in Main.pas }
  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
            CheckConst(Filename, MinVersion, AllowedConsts);
            CheckConst(Section, MinVersion, AllowedConsts);
            CheckConst(Key, MinVersion, AllowedConsts);
            CheckConst(Default, MinVersion, AllowedConsts);
            Result := True;
            Exit;
          end;
        end;
      end;
    end;
    { it will only reach here if there was a parsing error }
    Result := False;
  end;

  function CheckParamConst(C: String): Boolean;
  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
      CheckConst(Param, MinVersion, AllowedConsts);
      CheckConst(Default, MinVersion, AllowedConsts);
      Result := True;
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    Result := False;
  end;

  function CheckCodeConst(C: String): Boolean;
  var
    Z, ScriptFunc, Param: String;
    I: Integer;
  begin
    Delete(C, 1, 5);  { skip past 'code:' }
    Z := C;
    I := ConstPos('|', Z);  { check for optional parameter }
    if I = 0 then
      I := Length(Z)+1;
    Param := Copy(Z, I+1, Maxint);
    SetLength(Z, I-1);
    ScriptFunc := Z;
    if ConvertConstPercentStr(ScriptFunc) and ConvertConstPercentStr(Param) then begin
      CheckConst(Param, MinVersion, AllowedConsts);
      CodeCompiler.AddExport(ScriptFunc, 'String @String', True, ParseFileName, LineNumber);
      Result := True;
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    Result := False;
  end;

  function CheckDriveConst(C: String): Boolean;
  begin
    Delete(C, 1, 6);  { skip past 'drive:' }
    if ConvertConstPercentStr(C) then begin
      CheckConst(C, MinVersion, AllowedConsts);
      Result := True;
      Exit;
    end;
    { it will only reach here if there was a parsing error }
    Result := False;
  end;

  function CheckCustomMessageConst(C: String): Boolean;
  var
    MsgName, Arg: String;
    I, ArgCount: Integer;
    Found: Boolean;
    LineInfo: TLineInfo;
  begin
    Delete(C, 1, 3);  { skip past 'cm:' }
    I := ConstPos(',', C);
    if I = 0 then
      MsgName := C
    else
      MsgName := Copy(C, 1, I-1);

    { Check each argument }
    ArgCount := 0;
    while I > 0 do begin
      if ArgCount >= 9 then begin
        { Can't have more than 9 arguments (%1 through %9) }
        Result := False;
        Exit;
      end;
      Delete(C, 1, I);
      I := ConstPos(',', C);
      if I = 0 then
        Arg := C
      else
        Arg := Copy(C, 1, I-1);
      if not ConvertConstPercentStr(Arg) then begin
        Result := False;
        Exit;
      end;
      CheckConst(Arg, MinVersion, AllowedConsts);
      Inc(ArgCount);
    end;

    Found := False;
    for I := 0 to ExpectedCustomMessageNames.Count-1 do begin
      if CompareText(ExpectedCustomMessageNames[I], MsgName) = 0 then begin
        Found := True;
        Break;
      end;
    end;
    if not Found then begin
      LineInfo := TLineInfo.Create;
      LineInfo.FileName := ParseFileName;
      LineInfo.FileLineNumber := LineNumber;
      ExpectedCustomMessageNames.AddObject(MsgName, LineInfo);
    end;
    Result := True;
  end;

const
  Consts: array[0..23] of PChar = (
    'src', 'srcexe', 'tmp', 'app', 'win', 'sys', 'sd', 'groupname', 'fonts',
    'hwnd', 'pf', 'cf', 'computername', 'dao', 'cmd', 'username', 'wizardhwnd',
    'sysuserinfoname', 'sysuserinfoorg', 'userinfoname', 'userinfoorg', 'userinfoserial',
    'uninstallexe', 'language');
  ShellFolderConsts: array[0..16] of PChar = (
    'group', 'userdesktop', 'userstartmenu', 'userprograms', 'userstartup',
    'commondesktop', 'commonstartmenu', 'commonprograms', 'commonstartup',
    'sendto', 'userappdata', 'userdocs', 'commonappdata', 'commondocs',
    'usertemplates', 'commontemplates', 'localappdata');
  ShellFolderConsts98: array[0..1] of PChar = ('userfavorites', 'commonfavorites');
  AllowedConstsNames: array[TAllowedConst] of PChar = (
    'olddata', 'break');
var
  NotWin98orNT4: Boolean;
  I, Start, K: Integer;
  C: TAllowedConst;
  Cnst: String;
label 1;
begin
  with MinVersion do
    NotWin98orNT4 := ((WinVersion <> 0) and (WinVersion < $040A0000)) or
      ((NTVersion <> 0) and (NTVersion < $04000000));
  Result := False;
  I := 1;
  while I <= Length(S) do begin
    if S[I] = '{' then begin
      if (I < Length(S)) and (S[I+1] = '{') then
        Inc(I)
      else begin
        Result := True;

        Start := I;
        { Find the closing brace, skipping over any embedded constants }
        I := SkipPastConst(S, I);
        if I = 0 then  { unclosed constant? }
          AbortCompileOnLineFmt(SCompilerUnterminatedConst, [Copy(S, Start+1, Maxint)]);
        Dec(I);  { 'I' now points to the closing brace }

        { Now check the constant }
        Cnst := Copy(S, Start+1, I-(Start+1));
        if Cnst <> '' then begin
          if Cnst = '\' then
            goto 1;
          if Cnst[1] = '%' then begin
            if not CheckEnvConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadEnvConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 4) = 'reg:' then begin
            if not CheckRegConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadRegConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 4) = 'ini:' then begin
            if not CheckIniConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadIniConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 6) = 'param:' then begin
            if not CheckParamConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadParamConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 5) = 'code:' then begin
            if not CheckCodeConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadCodeConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 6) = 'drive:' then begin
            if not CheckDriveConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadDriveConst, [Cnst]);
            goto 1;
          end;
          if Copy(Cnst, 1, 3) = 'cm:' then begin
            if not CheckCustomMessageConst(Cnst) then
              AbortCompileOnLineFmt(SCompilerBadCustomMessageConst, [Cnst]);
            goto 1;
          end;
          for K := Low(Consts) to High(Consts) do
            if Cnst = StrPas(Consts[K]) then
              goto 1;
          for K := Low(ShellFolderConsts) to High(ShellFolderConsts) do
            if Cnst = StrPas(ShellFolderConsts[K]) then
              goto 1;
          for K := Low(ShellFolderConsts98) to High(ShellFolderConsts98) do
            if Cnst = StrPas(ShellFolderConsts98[K]) then begin
              if NotWin98orNT4 then
                AbortCompileOnLineFmt(SCompilerConstUsed + SNewLine2 +
                  MinVersionErrorMessage(True, $40A, $400), [Cnst]);
              goto 1;
            end;
          for C := Low(C) to High(C) do
            if Cnst = StrPas(AllowedConstsNames[C]) then begin
              if not(C in AllowedConsts) then
                AbortCompileOnLineFmt(SCompilerConstCannotUse, [Cnst]);
              goto 1;
            end;
         end;
         AbortCompileOnLineFmt(SCompilerUnknownConst, [Cnst]);

      1:{ Constant is OK }
      end;
    end
    else if S[I] in CompilerLeadBytes then
      Inc(I);
    Inc(I);
  end;
end;

function TSetupCompiler.EvalCheckOrInstallIdentifier(Sender: TSimpleExpression;
  const Name: String; const Parameters: array of const): Boolean;
var
  IsCheck: Boolean;
  Decl: String;
  I: Integer;
begin
  IsCheck := Boolean(Sender.Tag);

  if IsCheck then
    Decl := 'Boolean'
  else
    Decl := '0';

  for I := Low(Parameters) to High(Parameters) do begin
    if Parameters[I].VType = vtAnsiString then
      Decl := Decl + ' @String'
    else if Parameters[I].VType = vtInteger then
      Decl := Decl + ' @LongInt'
    else if Parameters[I].VType = vtBoolean then
      Decl := Decl + ' @Boolean'
    else
      raise Exception.Create('Internal Error: unknown parameter type');
  end;

  CodeCompiler.AddExport(Name, Decl, True, ParseFileName, LineNumber);

  Result := True; { Result doesn't matter }
end;

procedure TSetupCompiler.CheckCheckOrInstall(const ParamName, ParamData: String;
  const IsCheck: Boolean);
var
  SimpleExpression: TSimpleExpression;
begin
  if ParamData <> '' then begin
    { Check the expression in ParamData and add exports while
      evaluating. Use Lazy checking to make sure everything is evaluated. }
    try
      SimpleExpression := TSimpleExpression.Create;
      try
        SimpleExpression.Lazy := False;
        SimpleExpression.Expression := ParamData;
        SimpleExpression.OnEvalIdentifier := EvalCheckOrInstallIdentifier;
        SimpleExpression.SilentOrAllowed := False;
        SimpleExpression.SingleIdentifierMode := not IsCheck;
        SimpleExpression.ParametersAllowed := True;
        SimpleExpression.Tag := Integer(IsCheck);
        SimpleExpression.Eval;
      finally
        SimpleExpression.Free;
      end;
    except
      AbortCompileOnLineFmt(SCompilerParamExpressionError, [ParamName,
        GetExceptMessage]);
    end;
  end;
end;

function ExtractStr(var S: String; const Separator: Char): String;
var
  I: Integer;
begin
  repeat
    I := PathPos(Separator, S);
    if I = 0 then I := Length(S)+1;
    Result := Trim(Copy(S, 1, I-1));
    S := Trim(Copy(S, I+1, Maxint));
  until (Result <> '') or (S = '');
end;

function ExtractFlag(var S: String; const FlagStrs: array of PChar): Integer;
var
  I: Integer;
  F: String;
begin
  F := ExtractStr(S, ' ');
  if F = '' then begin
    Result := -2;
    Exit;
  end;

  Result := -1;
  for I := 0 to High(FlagStrs) do
    if StrIComp(FlagStrs[I], PChar(F)) = 0 then begin
      Result := I;
      Break;
    end;
end;

function ExtractType(var S: String; const TypeEntries: TList): Integer;
var
  I: Integer;
  F: String;
begin
  F := E