iscc.dpr

源代码

program ISCC;
{$APPTYPE CONSOLE}

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

  Command-line compiler

  $jrsoftware: issrc/Projects/ISCC.dpr,v 1.29 2004/12/18 20:11:32 jr Exp $
}

{x$DEFINE STATICCOMPILER}
{ For debugging purposes, remove the 'x' to have it link the compiler code
  into this program and not depend on ISCmplr.dll. }

uses
  Windows, SysUtils,
  {$IFDEF STATICCOMPILER} Compile, {$ENDIF}
  PathFunc, CmnFunc2, CompInt, FileClass;

{$R *.RES}

{$I VERSION.INC}

var
  StdErr: TextFile;
  ScriptFilename: String;
  OutputPath, OutputFilename: String;
  F: TTextFileReader;
  CurLine: String;
  StartTime, EndTime: DWORD;
  Quiet, WantAbort: Boolean;

procedure OpenStdErr;
begin
  AssignFile(StdErr, '');
  Rewrite(StdErr);
  TTextRec(StdErr).Handle := GetStdHandle(STD_ERROR_HANDLE);
end;

function ConsoleCtrlHandler(dwCtrlType: DWORD): BOOL; stdcall;
begin
  { Abort gracefully when Ctrl+C/Break is pressed }
  WantAbort := True;
  Result := True;
end;

function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  AppData: Longint): Integer; stdcall;
begin
  if WantAbort then begin
    Result := iscrRequestAbort;
    Exit;
  end;
  Result := iscrSuccess;
  case Code of
    iscbReadScript: begin
        { Note: In Inno Setup 3.0.1 and later we can ignore Data.Reset since
          it is only True once (when reading the first line). }
        if not F.Eof then begin
          CurLine := F.ReadLine;
          Data.LineRead := PChar(CurLine);
        end;
      end;
    iscbNotifyStatus:
      if not Quiet then
        Writeln(Data.StatusMsg);
    iscbNotifySuccess: begin
        EndTime := GetTickCount;
        if not Quiet then begin
          Writeln;
          Writeln('Successful compile (', (EndTime - StartTime) / 1000 : 0 : 3,
            ' sec). Resulting Setup program filename is:');
          Writeln(Data.OutputExeFilename);
        end;
      end;
    iscbNotifyError:
      if Assigned(Data.ErrorMsg) then begin
        Write(StdErr, 'Error');
        if Data.ErrorLine <> 0 then
          Write(StdErr, ' on line ', Data.ErrorLine);
        if Assigned(Data.ErrorFilename) then
          Write(StdErr, ' in ', Data.ErrorFilename)
        else if ScriptFilename <> '' then
          Write(StdErr, ' in ', ScriptFilename);
        Writeln(StdErr, ': ', Data.ErrorMsg);
      end;
  end;
end;

procedure ProcessCommandLine;

  procedure ShowBanner;
  begin
    Writeln('Inno Setup 5 Command-Line Compiler');
    Writeln('Copyright (C) 1997-2004 Jordan Russell. All rights reserved.');
    Writeln('Portions by Martijn Laan');
    Writeln;
  end;

  procedure ShowUsage;
  begin
    Writeln(StdErr, 'Usage:  iscc [options] scriptfile.iss');
    Writeln(StdErr, 'or to read from standard input:  iscc [options] -');
    Writeln(StdErr, 'Options:  /Oc:\path   Output files to specified path (overrides OutputDir)');
    Writeln(StdErr, '          /Ffilename  Overrides OutputBaseFilename with the specified filename');
    Writeln(StdErr, '          /Q          Quiet compile (print error messages only)');
    Writeln(StdErr, '          /?          Show this help screen');
  end;

var
  I: Integer;
  S: String;
begin
  for I := 1 to NewParamCount do begin
    S := NewParamStr(I);
    if S[1] = '/' then begin
      if CompareText(S, '/Q') = 0 then
        Quiet := True
      else if CompareText(Copy(S, 1, 2), '/O') = 0 then
        OutputPath := Copy(S, 3, MaxInt)
      else if CompareText(Copy(S, 1, 2), '/F') = 0 then
        OutputFilename := Copy(S, 3, MaxInt)
      else if S = '/?' then begin
        ShowBanner;
        ShowUsage;
        Halt(1);
      end
      else begin
        ShowBanner;
        Writeln(StdErr, 'Unknown option: ', S);
        Halt(1);
      end;
    end
    else begin
      { Not a switch; must be the script filename }
      if ScriptFilename <> '' then begin
        ShowBanner;
        Writeln(StdErr, 'You may not specify more than one script filename.');
        Halt(1);
      end;
      ScriptFilename := S;
    end;
  end;

  if ScriptFilename = '' then begin
    ShowBanner;
    ShowUsage;
    Halt(1);
  end;

  if not Quiet then
    ShowBanner;
end;

procedure Go;
var
  ScriptPath: String;
  ExitCode: Integer;
  Ver: PCompilerVersionInfo;
  Params: TCompileScriptParamsEx;
  Options: String;
begin
  if ScriptFilename <> '-' then begin
    ScriptFilename := PathExpand(ScriptFilename);
    ScriptPath := PathExtractPath(ScriptFilename);
  end
  else begin
    { Read from standard input }
    ScriptFilename := '<stdin>';
    ScriptPath := GetCurrentDir;
  end;

  {$IFNDEF STATICCOMPILER}
  Ver := ISDllGetVersion;
  {$ELSE}
  Ver := ISGetVersion;
  {$ENDIF}
  if Ver.BinVersion < $05000500 then begin
    { 5.0.5 or later is required since we use TCompileScriptParamsEx }
    Writeln(StdErr, 'Incompatible compiler engine version.');
    Halt(1);
  end;

  ExitCode := 0;
  if ScriptFilename <> '<stdin>' then
    F := TTextFileReader.Create(ScriptFilename, fdOpenExisting, faRead, fsRead)
  else
    F := TTextFileReader.CreateWithExistingHandle(GetStdHandle(STD_INPUT_HANDLE));
  try
    if not Quiet then begin
      Writeln('Compiler engine version: ', Ver.Title, ' ', Ver.Version);
      Writeln;
    end;

    FillChar(Params, SizeOf(Params), 0);
    Params.Size := SizeOf(Params);
    Params.SourcePath := PChar(ScriptPath);
    Params.CallbackProc := CompilerCallbackProc;
    Options := '';
    if OutputPath <> '' then
      Options := Options + 'OutputDir=' + OutputPath + #0;
    if OutputFilename <> '' then
      Options := Options + 'OutputBaseFilename=' + OutputFilename + #0;
    Params.Options := PChar(Options);

    StartTime := GetTickCount;
    {$IFNDEF STATICCOMPILER}
    case ISDllCompileScript(Params) of
    {$ELSE}
    case ISCompileScript(Params, False) of
    {$ENDIF}
      isceInvalidParam: begin
          ExitCode := 1;
          Writeln(StdErr, 'Internal error 1.');
        end;
      isceCompileFailure: begin
          ExitCode := 2;
          Writeln(StdErr, 'Compile aborted.');
        end;
    end;
  finally
    F.Free;
  end;
  if ExitCode <> 0 then
    Halt(ExitCode);
end;

begin
  OpenStdErr;
  SetConsoleCtrlHandler(@ConsoleCtrlHandler, True);
  try
    ProcessCommandLine;
    Go;
  except
    { Show a friendlier exception message. (By default, Delphi prints out
      the exception class and address.) }
    Writeln(StdErr, GetExceptMessage);
    Halt(2);
  end;
end.