compile.pas

源代码

unit Compile;

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

  Compiler

  $jrsoftware: issrc/Projects/Compile.pas,v 1.311 2004/12/21 18:59:22 jr Exp $
}

{$I VERSION.INC}

interface

uses
  Windows, SysUtils, CompInt;

function ISCompileScript(const Params: TCompileScriptParamsEx;
  const PropagateExceptions: Boolean): Integer;
function ISGetVersion: PCompilerVersionInfo;

type
  EISCompileError = class(Exception);

implementation

uses
  Commctrl, Consts, Classes, IniFiles, TypInfo,
  PathFunc, CmnFunc2, Struct, Int64Em, CompMsgs, SetupEnt,
  FileClass, Compress, zlib, bzlib, LZMA, CallOptimizer, ArcFour, MD5,
  MsgIDs, DebugStruct, VerInfo, CompResUpdate,
  ScriptCompiler, SimpleExpression;

type
  TParamInfo = record
    Name: String;
    Flags: set of (piRequired, piNoEmpty, piNoQuotes);
  end;
  TParamValue = record
    Found: Boolean;
    Data: String;
  end;

  TEnumIniSectionProc = procedure(const Line: PChar; const Ext: Integer) of object;

  TSetupSectionDirectives = (
    ssAdminPrivilegesRequired,
    ssAllowCancelDuringInstall,
    ssAllowNoIcons,
    ssAllowRootDirectory,
    ssAllowUNCPath,
    ssAlwaysRestart,
    ssAlwaysShowComponentsList,
    ssAlwaysShowDirOnReadyPage,
    ssAlwaysShowGroupOnReadyPage,
    ssAlwaysUsePersonalGroup,
    ssAppCopyright,
    ssAppendDefaultDirName,
    ssAppendDefaultGroupName,
    ssAppComments,
    ssAppContact,
    ssAppId,
    ssAppModifyPath,
    ssAppMutex,
    ssAppName,
    ssAppPublisher,
    ssAppPublisherURL,
    ssAppReadmeFile,
    ssAppSupportURL,
    ssAppUpdatesURL,
    ssAppVerName,
    ssAppVersion,
    ssBackColor,
    ssBackColor2,
    ssBackColorDirection,
    ssBackSolid,
    ssChangesAssociations,
    ssChangesEnvironment,
    ssCompression,
    ssCreateAppDir,
    ssCreateUninstallRegKey,
    ssDefaultDirName,
    ssDefaultGroupName,
    ssDefaultUserInfoName,
    ssDefaultUserInfoOrg,
    ssDefaultUserInfoSerial,
    ssDirExistsWarning,
    ssDisableDirPage,
    ssDisableFinishedPage,
    ssDisableProgramGroupPage,
    ssDisableReadyMemo,
    ssDisableReadyPage,
    ssDisableStartupPrompt,
    ssDiskClusterSize,
    ssDiskSliceSize,
    ssDiskSpanning,
    ssDontMergeDuplicateFiles,
    ssEnableDirDoesntExistWarning,
    ssEncryption,
    ssExtraDiskSpaceRequired,
    ssFlatComponentsList,
    ssInfoAfterFile,
    ssInfoBeforeFile,
    ssInternalCompressLevel,
    ssLanguageDetectionMethod,
    ssLicenseFile,
    ssMergeDuplicateFiles,
    ssMessagesFile,
    ssMinVersion,
    ssOnlyBelowVersion,
    ssOutputBaseFilename,
    ssOutputDir,
    ssOutputManifestFile,
    ssPassword,
    ssPrivilegesRequired,
    ssReserveBytes,
    ssRestartIfNeededByRun,
    ssSetupIconFile,
    ssShowComponentSizes,
    ssShowLanguageDialog,
    ssShowTasksTreeLines,
    ssSlicesPerDisk,
    ssSolidCompression,
    ssSourceDir,
    ssTimeStampRounding,
    ssTimeStampsInUTC,
    ssTouchDate,
    ssTouchTime,
    ssUpdateUninstallLogAppName,
    ssUninstallable,
    ssUninstallDisplayIcon,
    ssUninstallDisplayName,
    ssUninstallFilesDir,
    ssUninstallIconFile,
    ssUninstallLogMode,
    ssUninstallRestartComputer,
    ssUninstallStyle,
    ssUsePreviousAppDir,
    ssUsePreviousGroup,
    ssUsePreviousSetupType,
    ssUsePreviousTasks,
    ssUsePreviousUserInfo,
    ssUseSetupLdr,
    ssUserInfoPage,
    ssVersionInfoCompany,
    ssVersionInfoDescription,
    ssVersionInfoTextVersion,
    ssVersionInfoVersion,
    ssWindowResizable,
    ssWindowShowCaption,
    ssWindowStartMaximized,
    ssWindowVisible,
    ssWizardImageBackColor,
    ssWizardImageFile,
    ssWizardImageStretch,
    ssWizardSmallImageBackColor,
    ssWizardSmallImageFile,
    ssWizardStyle);
  TLangOptionsSectionDirectives = (
    lsCopyrightFontName,
    lsCopyrightFontSize,
    lsDialogFontName,
    lsDialogFontSize,
    lsDialogFontStandardHeight,
    lsLanguageCodePage,
    lsLanguageID,
    lsLanguageName,
    lsTitleFontName,
    lsTitleFontSize,
    lsWelcomeFontName,
    lsWelcomeFontSize);

  TAllowedConst = (acOldData, acBreak);
  TAllowedConsts = set of TAllowedConst;

  TLineInfo = class
  public
    FileName: String;
    FileLineNumber: Integer;
  end;

  TLangData = class
  public
    MessagesDefined: array[TSetupMessageID] of Boolean;
    Messages: array[TSetupMessageID] of String;
  end;

  TNameAndAccessMask = record
    Name: String;
    Mask: DWORD;
  end;

  TLowFragList = class(TList)
  protected
    procedure Grow; override;
  end;

  THashStringItem = record
    Hash: Longint;
    Str: String;
  end;
  PHashStringItemList = ^THashStringItemList;
  THashStringItemList = array[0..MaxListSize-1] of THashStringItem;
  THashStringList = class
  private
    FCapacity: Integer;
    FCount: Integer;
    FList: PHashStringItemList;
    procedure Grow;
  public
    destructor Destroy; override;
    function Add(const S: String): Integer;
    function CaseInsensitiveIndexOf(const S: String): Integer;
    procedure Clear;
    function Get(Index: Integer): String;
    property Count: Integer read FCount;
    property Strings[Index: Integer]: String read Get; default;
  end;

  TSetupCompiler = class
  private
    ScriptFiles: TStringList;

    LanguageEntries,
    CustomMessageEntries,
    PermissionEntries,
    TypeEntries,
    ComponentEntries,
    TaskEntries,
    DirEntries,
    FileEntries,
    FileLocationEntries,
    IconEntries,
    IniEntries,
    RegistryEntries,
    InstallDeleteEntries,
    UninstallDeleteEntries,
    RunEntries,
    UninstallRunEntries: TList;

    FileLocationEntryFilenames: THashStringList;
    WarningsList, ExpectedCustomMessageNames: TStringList;

    LangDataList: TList;

    OutputDir, OutputBaseFilename, OutputManifestFile, ExeFilename: String;
    FixedOutputDir, FixedOutputBaseFilename: Boolean;
    CompressMethod: TSetupCompressMethod;
    InternalCompressLevel, CompressLevel: Integer;
    UseSolidCompression: Boolean;
    DontMergeDuplicateFiles: Boolean;
    CryptKey: String;
    TimeStampsInUTC: Boolean;
    TimeStampRounding: Integer;
    TouchDateOption: (tdCurrent, tdNone, tdExplicit);
    TouchDateYear, TouchDateMonth, TouchDateDay: Integer;
    TouchTimeOption: (ttCurrent, ttNone, ttExplicit);
    TouchTimeHour, TouchTimeMinute, TouchTimeSecond: Integer;

    SetupHeader: TSetupHeader;

    SetupDirectiveLines: array[TSetupSectionDirectives] of Integer;
    UseSetupLdr, DiskSpanning, BackSolid: Boolean;
    DiskSliceSize, DiskClusterSize, SlicesPerDisk, ReserveBytes: Longint;
    LicenseFile, InfoBeforeFile, InfoAfterFile, WizardImageFile: String;
    WizardSmallImageFile: String;

    VersionInfoVersion: TFileVersionNumbers;
    VersionInfoVersionOriginalValue, VersionInfoCompany, VersionInfoDescription, VersionInfoTextVersion: String;
    SetupIconFilename: String;

    CodeText: TStringList;
    CodeCompiler: TScriptCompiler;
    CompiledCodeText: String;

    LineNumber: Integer;
    ParseFilenameStack: TStringList;

    DebugInfo, CodeDebugInfo: TMemoryStream;
    DebugEntryCount, VariableDebugEntryCount: Integer;
    CompiledCodeTextLength, CompiledCodeDebugInfoLength: Integer;

    TotalBytesToCompress, BytesCompressedSoFar: Integer64;
    procedure AddStatus(const S: String);
    procedure AbortCompile(const Msg: String);
    procedure AbortCompileFmt(const Msg: String; const Args: array of const);
    procedure AbortCompileOnLine(const Msg: String);
    procedure AbortCompileOnLineFmt(const Msg: String;
      const Args: array of const);
    procedure AbortCompileParamError(const Msg, ParamName: String);
    function PrependDirName(const Filename, Dir: String): String;
    function PrependSourceDirName(const Filename: String): String;
    procedure CallIdleProc;
    procedure DoCallback(const Code: Integer; var Data: TCompilerCallbackData);
    procedure EnumIniSection(const EnumProc: TEnumIniSectionProc;
      const SectionName: String; const Ext: Integer; const Verbose, SkipBlankLines: Boolean;
      const Filename: String);
    function EvalCheckOrInstallIdentifier(Sender: TSimpleExpression; const Name: String;
      const Parameters: array of const): Boolean;
    procedure CheckCheckOrInstall(const ParamName, ParamData: String;
      const IsCheck: Boolean);
    function CheckConst(const S: String; const MinVersion: TSetupVersionData;
      const AllowedConsts: TAllowedConsts): Boolean;
    procedure CheckCustomMessageDefinitions;
    procedure CheckCustomMessageReferences;
    procedure EnumTypes(const Line: PChar; const Ext: Integer);
    procedure EnumComponents(const Line: PChar; const Ext: Integer);
    procedure EnumTasks(const Line: PChar; const Ext: Integer);
    procedure EnumDirs(const Line: PChar; const Ext: Integer);
    procedure EnumIcons(const Line: PChar; const Ext: Integer);
    procedure EnumINI(const Line: PChar; const Ext: Integer);
    procedure EnumLangOptions(const Line: PChar; const Ext: Integer);
    procedure EnumLanguages(const Line: PChar; const Ext: Integer);
    procedure EnumRegistry(const Line: PChar; const Ext: Integer);
    procedure EnumDelete(const Line: PChar; const Ext: Integer);
    procedure EnumFiles(const Line: PChar; const Ext: Integer);
    procedure EnumRun(const Line: PChar; const Ext: Integer);
    procedure EnumSetup(const Line: PChar; const Ext: Integer);
    procedure EnumMessages(const Line: PChar; const Ext: Integer);
    procedure EnumCustomMessages(const Line: PChar; const Ext: Integer);
    procedure ExtractParameters(S: PChar; const ParamInfo: array of TParamInfo;
      var ParamValues: array of TParamValue);
    function FindLangEntryIndexByName(const AName: String): Integer;
    procedure InitBzipDLL;
    procedure InitCryptDLL;
    procedure InitLanguageEntry(var ALanguageEntry: TSetupLanguageEntry);
    procedure InitLZMADLL;
    procedure InitZipDLL;
    function ParseFilename: String;
    procedure PopulateLanguageEntryData;
    procedure ProcessMinVersionParameter(const ParamValue: TParamValue;
      var AMinVersion: TSetupVersionData);
    procedure ProcessOnlyBelowVersionParameter(const ParamValue: TParamValue;
      var AOnlyBelowVersion: TSetupVersionData);
    procedure ProcessPermissionsParameter(ParamData: String;
      const AccessMasks: array of TNameAndAccessMask; var PermissionsEntry: Smallint);
    function EvalComponentIdentifier(Sender: TSimpleExpression; const Name: String;
      const Parameters: array of const): Boolean;
    function EvalTaskIdentifier(Sender: TSimpleExpression; const Name: String;
      const Parameters: array of const): Boolean;
    function EvalLanguageIdentifier(Sender: TSimpleExpression; const Name: String;
      const Parameters: array of const): Boolean;
    procedure ProcessExpressionParameter(const ParamName,
      ParamData: String; OnEvalIdentifier: TSimpleExpressionOnEvalIdentifier;
      SlashConvert: Boolean; var ProcessedParamData: String);
    procedure ReadMessagesFromFiles(const AFiles: String; const ALangIndex: Integer);
    procedure ReadMessagesFromScript;
    function ReadScriptFile(const Filename: String): TStringList;
    procedure EnumCode(const Line: PChar; const Ext: Integer);
    procedure ReadCode;
    procedure CodeCompilerOnLineToLineInfo(const Line: LongInt; var Filename: String; var FileLine: LongInt);
    procedure CodeCompilerOnUsedLine(const Filename: String; const Line, Position: LongInt);
    procedure CodeCompilerOnUsedVariable(const Filename: String; const Line, Col, Param1, Param2, Param3: LongInt; const Param4: String);
    procedure CodeCompilerOnError(const Msg: String; const ErrorFilename: String; const ErrorLine: LongInt);
    procedure CodeCompilerOnWarning(const Msg: String);
    procedure CompileCode;
    procedure SeparateDirective(const Line: PChar; var Key, Value: String);
    procedure ShiftDebugEntryIndexes(AKind: TDebugEntryKind);
    procedure WriteDebugEntry(Kind: TDebugEntryKind; Index: Integer);
    procedure WriteCompiledCodeText(const CompiledCodeText: String);
    procedure WriteCompiledCodeDebugInfo(const CompiledCodeDebugInfo: String);
  public
    AppData: Longint;
    CallbackProc: TCompilerCallbackProc;
    CompilerDir, SourceDir, OriginalSourceDir: String;
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure Compile;
  end;

var
  CompilerLeadBytes: TLeadByteSet;
  ZipInitialized, BzipInitialized, LZMAInitialized, CryptInitialized: Boolean;

const
  ParamCommonFlags = 'Flags';
  ParamCommonComponents = 'Components';
  ParamCommonTasks = 'Tasks';
  ParamCommonLanguages = 'Languages';
  ParamCommonCheck = 'Check';
  ParamCommonBeforeInstall = 'BeforeInstall';
  ParamCommonAfterInstall = 'AfterInstall';
  ParamCommonMinVersion = 'MinVersion';
  ParamCommonOnlyBelowVersion = 'OnlyBelowVersion';

  DefaultTypeEntryNames: array[0..2] of PChar = ('full', 'compact', 'custom');

  MaxDiskSliceSize = 2100000000;

type
  TColor = $7FFFFFFF-1..$7FFFFFFF;

const
  clScrollBar = TColor(COLOR_SCROLLBAR or $80000000);
  clBackground = TColor(COLOR_BACKGROUND or $80000000);
  clActiveCaption = TColor(COLOR_ACTIVECAPTION or $80000000);
  clInactiveCaption = TColor(COLOR_INACTIVECAPTION or $80000000);
  clMenu = TColor(COLOR_MENU or $80000000);
  clWindow = TColor(COLOR_WINDOW or $80000000);
  clWindowFrame = TColor(COLOR_WINDOWFRAME or $80000000);
  clMenuText = TColor(COLOR_MENUTEXT or $80000000);
  clWindowText = TColor(COLOR_WINDOWTEXT or $80000000);
  clCaptionText = TColor(COLOR_CAPTIONTEXT or $80000000);
  clActiveBorder = TColor(COLOR_ACTIVEBORDER or $80000000);
  clInactiveBorder = TColor(COLOR_INACTIVEBORDER or $80000000);
  clAppWorkSpace = TColor(COLOR_APPWORKSPACE or $80000000);
  clHighlight = TColor(COLOR_HIGHLIGHT or $80000000);
  clHighlightText = TColor(COLOR_HIGHLIGHTTEXT or $80000000);
  clBtnFace = TColor(COLOR_BTNFACE or $80000000);
  clBtnShadow = TColor(COLOR_BTNSHADOW or $80000000);
  clGrayText = TColor(COLOR_GRAYTEXT or $80000000);