compile.pas

源代码

  I: Integer;
begin
  Cardinal(Rec) := Cardinal(DebugInfo.Memory) + SizeOf(TDebugInfoHeader);
  for I := 0 to DebugEntryCount-1 do begin
    if Rec.Kind = Ord(AKind) then
      Inc(Rec.Index);
    Inc(Rec);
  end;
end;

procedure TSetupCompiler.DoCallback(const Code: Integer;
  var Data: TCompilerCallbackData);
begin
  if CallbackProc(Code, Data, AppData) = iscrRequestAbort then
    Abort;
end;

procedure TSetupCompiler.CallIdleProc;
const
  ProgressMax = 1024;
var
  Data: TCompilerCallbackData;
begin
  if ((BytesCompressedSoFar.Lo = 0) and (BytesCompressedSoFar.Hi = 0)) or
     ((TotalBytesToCompress.Lo = 0) and (TotalBytesToCompress.Hi = 0)) then begin
    { Optimization(?) and avoid division by zero when TotalBytesToCompress=0 }
    Data.CompressProgress := 0;
  end
  else begin
    Data.CompressProgress := Trunc((Comp(BytesCompressedSoFar) * ProgressMax) /
      Comp(TotalBytesToCompress));
    { In case one of the files got bigger since we checked the sizes... }
    if Data.CompressProgress > ProgressMax then
      Data.CompressProgress := ProgressMax;
  end;
  Data.CompressProgressMax := ProgressMax;
  DoCallback(iscbNotifyIdle, Data);
end;

function TSetupCompiler.ReadScriptFile(const Filename: String): TStringList;
var
  I: Integer;
  F: TTextFileReader;
  Lines: TStringList;
  Reset: Boolean;
  Data: TCompilerCallbackData;
begin
  for I := 0 to ScriptFiles.Count-1 do
    if PathCompare(ScriptFiles[I], Filename) = 0 then begin
      Result := TStringList(ScriptFiles.Objects[I]);
      Exit;
    end;

  Lines := TStringList.Create;
  try
    if Filename = '' then begin
      Reset := True;
      while True do begin
        Data.Reset := Reset;
        Data.LineRead := nil;
        DoCallback(iscbReadScript, Data);
        if Data.LineRead = nil then
          Break;
        Lines.Add(Data.LineRead);
        Reset := False;
      end;
    end
    else begin
      F := nil;  { avoid warning }
      try
        F := TTextFileReader.Create(Filename, fdOpenExisting, faRead, fsRead);
      except
        AbortCompileOnLineFmt(SCompilerErrorOpeningIncludeFile,
          [Filename, GetExceptMessage]);
      end;
      try
        while not F.Eof do
          Lines.Add(F.ReadLine);
      finally
        F.Free;
      end;
    end;
  except
    Lines.Free;
    raise;
  end;

  ScriptFiles.AddObject(Filename, Lines);
  Result := Lines;
end;

procedure TSetupCompiler.EnumIniSection(const EnumProc: TEnumIniSectionProc;
  const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
  const Filename: String);
var
  FoundSection: Boolean;
  LastSection: String;

  procedure DoFile(Filename: String);

    procedure Directive(D: String);
    var
      Dir: String;
    begin
      if Copy(D, 1, Length('include')) = 'include' then begin
        Delete(D, 1, Length('include'));
        if (D = '') or (D[1] > ' ') then
          AbortCompileOnLine(SCompilerInvalidDirective);
        D := TrimLeft(D);
        if (Length(D) < 3) or (D[1] <> '"') or (PathLastChar(D)^ <> '"') then
          AbortCompileOnLine(SCompilerInvalidDirective);
        if Filename = '' then  { the Filename passed to DoFile }
          Dir := OriginalSourceDir
        else
          Dir := PathExtractPath(Filename);
        DoFile(PrependDirName(RemoveQuotes(D), Dir));
      end
      else
        AbortCompileOnLine(SCompilerInvalidDirective);
    end;

  var
    Lines: TStringList;
    B, L: String;
    SaveLineNumber, I: Integer;
  begin
    if Filename <> '' then
      Filename := PathExpand(PrependSourceDirName(Filename));

    { Check if it's a recursive include }
    for I := 0 to ParseFilenameStack.Count-1 do
      if PathCompare(ParseFilenameStack[I], Filename) = 0 then
        AbortCompileOnLineFmt(SCompilerRecursiveInclude, [Filename]);

    Lines := ReadScriptFile(Filename);
    SaveLineNumber := LineNumber;
    ParseFilenameStack.Add(Filename);

    LineNumber := 0;
    while LineNumber < Lines.Count do begin
      B := Lines[LineNumber];
      Inc(LineNumber);
      L := Trim(B);
      { Check for blank lines or comments }
      if (not FoundSection or SkipBlankLines) and ((L = '') or (L[1] = ';')) then Continue;
      if (L <> '') and (L[1] = '#') then begin
        { Compiler directive }
        Directive(Copy(L, 2, Maxint));
      end
      else if (L <> '') and (L[1] = '[') then begin
        { Section tag }
        I := Pos(']', L);
        if I < 3 then
          AbortCompileOnLine(SCompilerSectionTagInvalid);
        L := Copy(L, 2, I-2);
        if L[1] = '/' then begin
          L := Copy(L, 2, Maxint);
          if (LastSection = '') or (CompareText(L, LastSection) <> 0) then
            AbortCompileOnLineFmt(SCompilerSectionBadEndTag, [L]);
          FoundSection := False;
          LastSection := '';
        end
        else begin
          FoundSection := (CompareText(L, SectionName) = 0);
          LastSection := L;
        end;
      end
      else begin
        if not FoundSection then begin
          if LastSection = '' then
            AbortCompileOnLine(SCompilerTextNotInSection);
          Continue;  { not on the right section }
        end;
        if Verbose then begin
          if ParseFilename = '' then
            AddStatus(Format(SCompilerStatusParsingSectionLine,
              [SectionName, LineNumber]))
          else
            AddStatus(Format(SCompilerStatusParsingSectionLineFile,
              [SectionName, LineNumber, ParseFilename]));
        end;
        EnumProc(PChar(B), Ext);
      end;
    end;

    LineNumber := SaveLineNumber;
    ParseFilenameStack.Delete(ParseFilenameStack.Count-1);
  end;

begin
  FoundSection := False;
  LastSection := '';
  DoFile(Filename);
end;

procedure TSetupCompiler.ExtractParameters(S: PChar;
  const ParamInfo: array of TParamInfo; var ParamValues: array of TParamValue);

  function GetParamIndex(const AName: String): Integer;
  var
    I: Integer;
  begin
    for I := 0 to High(ParamInfo) do
      if CompareText(ParamInfo[I].Name, AName) = 0 then begin
        Result := I;
        if ParamValues[I].Found then
          AbortCompileParamError(SCompilerParamDuplicated, ParamInfo[I].Name);
        ParamValues[I].Found := True;
        Exit;
      end;
    { Unknown parameter }
    AbortCompileOnLineFmt(SCompilerParamUnknownParam, [AName]);
    Result := -1;
  end;

  function ExtractWords(var S: PChar; const Sep: Char): String;
  { Extracts characters from S until it reaches the character Sep or the end
    of S. The returned string has trailing whitespace characters trimmed off. }  
  var
    StartPos, EndPos: PChar;
  begin
    StartPos := S;
    EndPos := S;
    while (S^ <> #0) and (S^ <> Sep) do begin
      if S^ > ' ' then
        EndPos := S + 1;
      Inc(S);
    end;
    SetString(Result, StartPos, EndPos - StartPos);
  end;

var
  I, ParamIndex: Integer;
  ParamName, Data: String;
begin
  for I := 0 to High(ParamValues) do begin
    ParamValues[I].Found := False;
    ParamValues[I].Data := '';
  end;

  while True do begin
    { Parameter name }
    SkipWhitespace(S);
    if S^ = #0 then
      Break;
    ParamName := ExtractWords(S, ':');
    ParamIndex := GetParamIndex(ParamName);
    if S^ <> ':' then
      AbortCompileOnLineFmt(SCompilerParamHasNoValue, [ParamName]);
    Inc(S);

    { Parameter value }
    SkipWhitespace(S);
    if S^ <> '"' then begin
      Data := ExtractWords(S, ';');
      if Pos('"', Data) <> 0 then
        AbortCompileOnLineFmt(SCompilerParamQuoteError, [ParamName]);
      if S^ = ';' then
        Inc(S);
    end
    else begin
      Inc(S);
      Data := '';
      while True do begin
        if S^ = #0 then
          AbortCompileOnLineFmt(SCompilerParamMissingClosingQuote, [ParamName]);
        if S^ = '"' then begin
          Inc(S);
          if S^ <> '"' then
            Break;
        end;
        Data := Data + S^;
        Inc(S);
      end;
      SkipWhitespace(S);
      case S^ of
        #0 : ;
        ';': Inc(S);
      else
        AbortCompileOnLineFmt(SCompilerParamQuoteError, [ParamName]);
      end;
    end;

    { Assign the data }
    if (piNoEmpty in ParamInfo[ParamIndex].Flags) and (Data = '') then
      AbortCompileParamError(SCompilerParamEmpty2, ParamInfo[ParamIndex].Name);
    if (piNoQuotes in ParamInfo[ParamIndex].Flags) and (Pos('"', Data) <> 0) then
      AbortCompileParamError(SCompilerParamNoQuotes2, ParamInfo[ParamIndex].Name);
    ParamValues[ParamIndex].Data := Data;
  end;

  { Check for missing required parameters }
  for I := 0 to High(ParamInfo) do begin
    if (piRequired in ParamInfo[I].Flags) and
       not ParamValues[I].Found then
      AbortCompileParamError(SCompilerParamNotSpecified, ParamInfo[I].Name);
  end;
end;

procedure TSetupCompiler.AddStatus(const S: String);
var
  Data: TCompilerCallbackData;
begin
  Data.StatusMsg := PChar(S);
  CallbackProc(iscbNotifyStatus, Data, AppData);
end;

procedure TSetupCompiler.AbortCompile(const Msg: String);
begin
  raise EISCompileError.Create(Msg);
end;

procedure TSetupCompiler.AbortCompileFmt(const Msg: String; const Args: array of const);
begin
  AbortCompile(Format(Msg, Args));
end;

procedure TSetupCompiler.AbortCompileOnLine(const Msg: String);
{ AbortCompileOnLine is now equivalent to AbortCompile }
begin
  AbortCompile(Msg);
end;

procedure TSetupCompiler.AbortCompileOnLineFmt(const Msg: String;
  const Args: array of const);
begin
  AbortCompileOnLine(Format(Msg, Args));
end;

procedure TSetupCompiler.AbortCompileParamError(const Msg, ParamName: String);
begin
  AbortCompileOnLineFmt(Msg, [ParamName]);
end;

function TSetupCompiler.PrependDirName(const Filename, Dir: String): String;
begin
  if CompareText(Copy(Filename, 1, 9), 'compiler:') = 0 then
    Result := CompilerDir + Copy(Filename, 10, Maxint)
  else begin
    if (Filename = '') or not IsRelativePath(Filename) then
      Result := Filename
    else
      Result := Dir + Filename;
  end;
end;

function TSetupCompiler.PrependSourceDirName(const Filename: String): String;
begin
  Result := PrependDirName(Filename, SourceDir);
end;

function MinVersionErrorMessage(const Param: Boolean;
  const WinVersion, NTVersion: Word): String;

  function VerToStr(Ver: Cardinal; ServicePack: Word): String;
  var
    Digits: Integer;
  begin
    with TSetupVersionDataVersion(Ver) do begin
      Digits := 2;
      if Minor mod 10 = 0 then begin
        Dec(Digits);
        Minor := Minor div 10;
      end;
      FmtStr(Result, '%d.%.*d', [Major, Digits, Minor]);
      if Build <> 0 then
        Result := Result + Format('.%d', [Build]);
      if ServicePack <> 0 then begin
        Result := Result + ' Service Pack ' + IntToStr(Hi(ServicePack));
        if Lo(ServicePack) <> 0 then
          Result := Result + Format('.%d', [Lo(ServicePack)]);
      end;
    end;
  end;

var
  WinVer, NTVer: String;
begin
  WinVer := VerToStr(WinVersion shl 16, 0);
  NTVer := VerToStr(NTVersion shl 16, 0);
  if not Param then
    FmtStr(Result, SCompilerMinVersionError, [WinVer, NTVer, WinVer, NTVer])
  else
    FmtStr(Result, SCompilerMinVersionErrorParam, [WinVer, NTVer,
      WinVer, NTVer, WinVer, NTVer]);
end;

function TSetupCompiler.CheckConst(const S: String; const MinVersion: TSetupVersionData;
  const AllowedConsts: TAllowedConsts): Boolean;
{ Returns True if S contains constants. Aborts compile if they are invalid. }

  function CheckEnvConst(C: String): Boolean;
  { based on ExpandEnvConst in Main.pas }
  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);
    if ConvertConstPercentStr(VarName) and ConvertConstPercentStr(Default) then begin
      CheckConst(VarName, 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 CheckRegConst(C: String): Boolean;