{ CMDLINE.PAS -- Command line parameters parsing }
unit cmdline;
interface
{$DEFINE WINDOWS}
uses SysUtils;
{use following method:

  function ProcessCommadLine(Options : POptionsArray; OptionCount : Integer) : Boolean;

  where Options is predefined constats array (see TOptionsArray) of
  allowed command line parameters and OptionCount their count;

  Returns false if encountered undefined parameter or it has wrong value

  DO NOT USE option names which are beginning substrings of other option name
  (then the option value will be assigned to the first substring matched
  option. So it can be actually used, but the shorter option name must be specified
  first in the Options array definition)
}
const
  MaxOptions = 100;

{oiXXXX predefined Options Indexes (such options should be defined
  by any application that wants to use cmdline) }
  oiHelp = 1;
  oiBootLog = 2;

type
  TOptionType = (otBool, otInt, otString, otFilename, otSingle);

  TOptionName = string[20];
  POptionRec = ^TOptionRec;
  TOptionRec = packed record
    OptionName: TOptionName;
      {if option char = ' ', then it is nonoption
        command parameter, such beasts must appear in command line
        in predefined order, and they don't start with '-' or '/';
        if more such parameters appear than is the number of ' ' optionrecords
        it is an error
      }
    OptionDesc: PChar; { Description of the option's function }
    Flag: longint;
      { otBool, then can assign to Flag binary mask that will be used
        to update CMDLineFlags variable }
    Present: boolean;
      { was the option present in the command line? }
    Mandatory: boolean;
    case Option: TOptionType of
      otBool: (OnOff : Boolean);
      otInt: (Value : Longint);
      otString: (Param : ShortString);
      otFilename: (Filename : ShortString);
      otSingle: (Float: single);
  end;

  POptionsArray = ^TOptionsArray;
  TOptionsArray = Array [1..MaxOptions] of TOptionRec;
var
  CMDLineFlags:longint = 0;{combined from otBool options that have assinged Flag}
  CMDLineOptions:POptionsArray = nil;
  { Set by last call to ProcessCommandLine }
  CMDLineOptionCount:integer = 0;
  { Set by last call to ProcessCommandLine }

  DefCMDLineOptions: POptionsArray = nil;
  { Copy of the original Options array passed to ProcessCommandLine,
    before it is changed (i.e. contains default values) }


{
  GetOptionRec -- return a pointer to the options record in the
  passed Options array that corresponds to the specified option
  character.  Returns Nil if the option character is not in
  the passed Options array.
}
function GetOptionRec
      (
        Options : POptionsArray;
        OptionCount : Integer;
        OptionName : TOptionName
      ) : POptionRec;

{
  ProcessCommandLine -- process the command line according to the
  parameters list passed in the Options array.  Returns True if
  successful, or False if an error occurred in processing.
}
function ProcessCommandLine
      (
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;

procedure PrintOptionsHelp;{of last options passed to ProcessCommandLine}

function GetCommandLine: string;
  { returns the original command line used to start the program }

{ Returns the reason of last failure }
function GetLastErrorMsg: string;

implementation
var
  CommandLine: string = '';

var
  LastErrorMsg: string = '';

function GetLastErrorMsg: string;
begin
  Result := LastErrorMsg;
end;

procedure LogErr(msg:string);
begin
  {$IFDEF USEDLL}
{  SysLogLog(leError, 'CmdLine: ' + msg);}
  {$ELSE}
  Writeln(msg);
  {$ENDIF}
  LastErrorMsg := msg;
end;
{
  GetOptionRec -- return a pointer to the options record in the
  passed Options array that corresponds to the specified option
  character.  Returns Nil if the option character is not in
  the passed Options array.
}
function GetOptionRec
      (
        Options : POptionsArray;
        OptionCount : Integer;
        OptionName : TOptionName
      ) : POptionRec;
var
  i : Integer;
begin
  Result := Nil;
  for i := 1 to OptionCount do begin
    if (pos(Options^[i].OptionName, OptionName) = 1) then begin
      Result := @Options^[i].OptionName;
      Break;
    end;
  end;
{$IFNDEF WINDOWS}
  GetOptionRec := Result;
{$ENDIF}
end;

{
  ProcessBool

  Extract the on/off state for a parameter.  If the passed Param
  is a blank string, it is assumed to be On (+).  Otherwise the
  routine expects the string to start with + or -, and sets the
  OnOff variable accordingly.
}
function ProcessBool(Param: String; var OnOff: Boolean): Boolean;
begin
  Result := True;
  if (Length (Param) = 0) then begin
    OnOff := True;
    exit;
  end;

  case Param[1] of
    '+' : OnOff := True;
    '-' : OnOff := False;
    '0' : OnOff := False;
    '1' : OnOff := True;

    else begin
      LogErr ('Error: Param value=' + Param + ' found; + or - expected');
      Result := False;
    end;
  end;
end;

{
  ProcessInt

  Extract an integer from the passed command line parameter.
}

function ProcessInt(Param: String; var Value: longint): Boolean;
var
  code: integer;
begin
  if (Length (Param) = 0) then begin
    Result := False;
    LogErr ('Error:  integer expected');
    exit;
  end;

  Result := True;
  val(Param, Value, code);
  if code <> 0 then begin
    LogErr ('Error:  integer expected');
    Result := False;
  end;
end;



{
  ProcessFloat

  Extract a single from the passed command line parameter.
}

function ProcessFloat(Param: String; var Float: single): Boolean;
var
  code: integer;
begin
  if (Length (Param) = 0) then begin
    Result := False;
    LogErr ('Error:  single expected');
    exit;
  end;

  Result := True;
  val(Param, Float, code);
  if code <> 0 then begin
    LogErr ('Error:  single expected');
    Result := False;
  end;
end;

{
  ProcessString

  Copy the passed string to the Option variable.  No error checking
  is performed, and a blank string is considered a valid parameter.
}
function ProcessString
      (
        Param : String;
        var Option : ShortString
      ) : Boolean;
begin
  Option := Param;
{$IFNDEF WINDOWS}
  ProcessString := true;
{$ELSE}
  Result := True;
{$ENDIF}
end;

{
  ProcessFilename

  Extract a file name from the passed command line parameter.
  Currently, this function just calls ProcessString to copy the
  string parameter to the Filename.  It could, in the future,
  check to see if the string represents a valid file name, or it
  could be used to expand a short filename to a full path/file.
}
function ProcessFilename
      (
        Param : String;
        var Filename : ShortString
      ) : Boolean;
begin
{$IFNDEF WINDOWS}
  ProcessFileName := ProcessString (Param, Filename);
{$ELSE}
  Result := ProcessString (Param, Filename);
{$ENDIF}
end;

var
  CurNonOptPar:integer;

{
  CheckParam

  Check the passed Param, representing one command-line argument, against
  the list of options.  If the option character is valid, then process
  the option based on its type (Boolean, Integer, String, or Filename).

  Returns True if option processed and stored correctly, False otherwise.
}
function CheckParam
      (
        Param : String;
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;
var
  Rec : POptionRec;
  Option : String;
{label ex;}

  function CheckNonOption:boolean;
  var
    i:integer;
    nonOpts:integer;
  begin
    CheckNonOption := false;
    nonOpts := 0;
    for i := 1 to OptionCount do begin
      if (Options^[i].OptionName = ' ') then begin
        if nonOpts < CurNonOptPar then
          continue;
        inc(nonOpts);
        Options^[i].Param := Param;
        CurNonOptPar := nonOpts;
        CheckNonOption := true;
        Break;
      end;
    end;
  end;

begin
  Result := False;
  if (Param[1] in ['-', '/']) then begin
    if (Length (Param) < 2) then begin
      LogErr ('Invalid option');
    end
    else begin
      Rec := GetOptionRec (Options, OptionCount, copy(Param,2,255){Param[2]});
      if (Rec <> Nil) then begin
        Rec^.Present := true;
        Option := Copy (Param, Length(Rec^.OptionName) + 2{3}, Length (Param){ - 2});
        if (Option <> '') and (Option[1] = '=') then begin
          Option := copy(Option, 2, length(Option));
        end;

        case Rec^.Option of
          otBool :
            Result := ProcessBool (Option, Rec^.OnOff);
          otInt :
            Result := ProcessInt (Option, Rec^.Value);
          otString :
            Result := ProcessString (Option, Rec^.Param);
          otFilename :
            Result := ProcessFilename (Option, Rec^.Filename);
          otSingle:
            Result := ProcessFloat(Option, Rec^.Float);
          else

            LogErr ('Invalid option specification: '+ Param[2]);
        end;
      end else begin
        LogErr ('Invalid option character: '+ Param[2]);
      end;
    end;
  end
  else begin
    if not CheckNonOption then
    begin
      {LogErr ('Error: options must start with - or /:' + Param);
      ignore it}
      Result := true;
    end else
      Result := true;
  end;
end;

{
  ProcessCommandLine

  Given a list of option characters and parameter types, check each
  command line argument against the list and set the values in the
  options structure accordingly.

  Returns True if all parameters processed and stored successfully.
}
function ProcessCommandLine
      (
        Options : POptionsArray;
        OptionCount : Integer
      ) : Boolean;

var
  ParamNo : Integer;
  i:integer;

{$IFNDEF WINDOWS}
var
  Result:boolean;
{$ENDIF}
begin
  LastErrorMsg := '';
  Result := True;
  CurNonOptPar:= 0;

  if DefCMDLineOptions <> nil then begin
    FreeMem(DefCMDLineOptions, CMDLineOptionCount*sizeof(TOptionRec));
    DefCmdLineOptions := nil;
  end;

  if (Options <> nil) and (OptionCount > 0) then begin
    GetMem(DefCMDLineOptions, OptionCount * sizeof(TOptionRec));
    if DefCMDLineOptions = nil then
      RunError(8);
    Move(Options^, DefCMDLineOptions^, OptionCount * sizeof(TOptionRec));
  end;

  for i := 1 to OptionCount do begin
    Options^[i].Present := false;
  end;

  CommandLine := '';
  for ParamNo := 1 to ParamCount do begin
    CommandLine := CommandLine + ParamStr(ParamNo) + ' ';
    if (Not CheckParam (ParamStr (ParamNo), Options, OptionCount)) then begin
      Result := False;
      break;
    end;
  end;

  CMDLineOptions := Options;
  CMDLineOptionCount := OptionCount;
  for i := 1 to OptionCount do begin
    with Options^[i] do begin
      if (Option = otBool) and (Flag <> 0) then begin
        if OnOff then
          CMDLineFlags := CMDLineFlags or Flag
        else
          CMDLineFlags := CMDLineFlags and (not Flag);
      end;
    end;
  end;
{$IFNDEF WINDOWS}
  ProcessCommandLine := Result;
{$ENDIF}
end;

procedure PrintOptionsHelp;
var
  i:integer;
  d:PChar;
  s, line:string;
  p, l, cnt: integer;
  Options:POptionsArray;
  OptionCount:integer;
  headWritten: boolean;
const
  e:array[0..0]of char = (#0);

begin
  headWritten := false;
  Options := DefCMDLineOptions;
  OptionCount := CMDLineOptionCount;
  if (Options = nil) or (OptionCount = 0) then begin
    LogErr('No options defined.');
    exit;
  end;
//  writeln('Possible command line options:');
//  writeln;
  for i := 1 to OptionCount do begin
    with Options^[i] do begin
      d := OptionDesc;
      if d = nil then begin
        if (OptionName = 'Tag') or (OptionName = 'Name') then begin
          // for CmdLineClassu, if no description given for the
          // command TComponent properties, then they considered not used
          continue;
        end;
        d := e;
      end;
      if (OptionName <> ' ') then begin
        if not headWritten then begin
          writeln('OPTIONS:');
          headWritten := true;
        end;
        write('  /', OptionName, '[');
        case Option of
          otBool: begin
            if OnOff then
              s := '+'
            else
              s := '-';
          end;
          otInt: begin
            str(Value, s);
          end;
          otString: begin
            s := Param;
          end;
          otFileName: begin
            s := FileName;
          end;
        end;
        s := s + ']  ';
        l := length('  /  ');
        cnt := 0;
        write(s);
        s := d;
      end else begin
        // OptionName = ' ' means COMMAND:
        l := 0;
        s := d;
        if pos('USAGE', UpperCase(s)) = 0 then begin
          writeln('Usage: ' + ChangeFileExt(ExtractFileName(paramstr(0)),'') + ' COMMAND [[/OPT1[=VAL1]] [/OPT1[=VAL2] ...]');
        end;
      end;
    end;

    repeat
      p := pos(#13#10, s);
      if p > 0 then begin
        line := copy(s, 1, p - 1);
        s := copy(s, p + 2, length(s));
      end else begin
        line := s;
        s := '';
      end;
      if cnt > 0 then
        for p := 1 to l do write(' ');
      writeln(line);
      inc(cnt);
    until s = '';

    //writeln(s, ']  ', d);
  end;
end;
function GetCommandLine:string;
begin
  GetCommandLine := CommandLine;
end;
{v2.18 ghs}
var
  SavedExitProc:pointer;
{$S-}
procedure DoneUnit;far;
begin
  ExitProc := SavedExitProc;
  {anything here}
  if DefCMDLineOptions <> nil then begin
    FreeMem(DefCMDLineOptions, CMDLineOptionCount*sizeof(TOptionRec));
    DefCmdLineOptions := nil;
  end;
end;

procedure InitUnit;
begin
  SavedExitProc := ExitProc;
  ExitProc := @DoneUnit;
  {anything here}
end;

begin
  InitUnit;
{/v2.18}
(*
  Example definition of Options array:
const
  DBCOptionCount = 3;

  cpFileName = 0;{command line paramterer}

  DBCOptions: array[1..DBCOptionCount] of TOptionRec = (
    (OptionName:' '; OptionDesc:nil;Option: otString; Param: ''),
    (OptionName:'TALK'; OptionDesc:nil;Option: otBool; OnOff:false),
    (OptionName:'DEVI'; OptionDesc:nil;Option: otString; Param: 'SCREEN')
  );

  OptionCount = 3;
  Options:array[1..OptionCount] of TOptionRec = (
    (OptionName:'?'; OptionDesc:'Print help about options.';
      Flag:0; Present:false; Mandatory: false; Option:otBool; OnOff:false),
    (OptionName:'x'; OptionDesc:'Start printing x th money order on page (0..2)';
      Flag:0; Present:false; Mandatory: false; Option:otInt; Value:0),
    (OptionName:'name'; OptionDesc:
     'Include only records containing strings listed (";" separated) ' +
     #13#10'      after "-name=" in PMO.DBF NAME field';
      Flag:0; Present:false; Mandatory: false; Option:otString; Param:'')
  );


*)
end.

