DP Tool Club 15/CD_ASCQ_15_070894.iso/vrac/sk210f.zip/SHCMDLIN.PAS

Pascal/Delphi Source File | 1994-05-15 | 12KB | 358 lines

{$I SHDEFINE.INC}

{$I SHUNITSW.INC}

{$D-,L-}
{$A-}
unit ShCmdLin;
{
                                ShCmdLin

                      A Command Line Parsing Unit

                                   by

                              Bill Madison

                   W. G. Madison and Associates, Ltd.
                          13819 Shavano Downs
                            P.O. Box 780956
                       San Antonio, TX 78278-0956
                             [phone]
                             CIS 73240,342
                Internet [e-mail]

                Copyright 1990, '94 Madison & Associates
                          All Rights Reserved

        This file may  be used and distributed  only in accord-
        ance with the provisions described on the title page of
                  the accompanying documentation file
                              SKYHAWK.DOC
}

Interface
{------------}

Uses
  ShList,
  ShUtilPk,
  Dos;

const
  Copyr = 'Copyright 1990, 1994 by W.G. Madison';

type
{$IFNDEF Gen87}
  extended  = real;
  Float           = real;
{$ELSE}
  Float           = extended;
{$ENDIF}

  ValueType = (VtStr, VtReal, VtInt);
  SwRec     = record
                Name  : string;
                case SwVal  : ValueType of
                  VtStr : (StrVal : string);
                  VtReal: (RealVal: Float);
                  VtInt : (IntVal : integer);
                end; {SwRec}
  CharSet = Set of Char;

procedure ClInit;
{Initializes the command line switch list}

procedure ClClose;
{Closes and frees the space associated with the command line switch list}

function GetSwitch(var Y : SwRec) : boolean;
{Retrieves the next switch record. Returns FALSE if no more.}

function PopSwitch(var Y : SwRec) : boolean;
{Retrieves the next switch record and frees its heap space.
 Returns FALSE if no more.}

function ReadSwCh : char;
{Reads and returns the current switch lead-in character}

procedure SetSwCh(C : char);
{Sets the switch lead-in character to C}

Procedure ClParse(StrPtr : Pointer; StrOnly : Boolean;
              LeadIn, ValDelim : CharSet; var Err : Integer);
{USAGE: Parsing is accomplished by invoking the procedure ClParse with
  five parameters:

  StrPtr of type Pointer is used to point to the string to be parsed. If
  StrPtr is NIL, the command tail will be parsed.

  StrOnly of type Boolean is used to determine if switch values of type
  String are to be forced, regardless of the form of the value. StrOnly
  = True forces String values.

  LeadIn of type CharSet is used to identify the set of characters used
  to mark the beginning of a switch. It is suggested that LeadIn be set
  to [ ReadSwCh ]. The weakest condition used should be that the
  expression ( ReadSwCh in LeadIn ) be TRUE.

  ValDelim of type CharSet is used to specify the set of characters
  which may be used to separate the switch name from the switch value.

  X of type ClType (i.e., a doubly linked list as defined in unit
  ShList) is used to return the names and values (if any) of any
  switches included in the string being parsed. The ClType must be
  initialized by a call to ClInit prior to the call to ClParse.

  Err of type Integer is used to return error conditions.

  The procedure returns a doubly linked list (as defined in unit ShList)
  of records, each record containing the name and value of one command
  line switch.

  All switches (with the optional exception of the first) are preceeded
  with the normal DOS switch lead-in character with which your DOS is
  configured (normally '/', but in pseudo-UNIX environments probably
  '-').

  Switches may take values of type Real, LongInt, or String. In each
  case, the switch value is separated from the switch name by one of the
  characters specified in the parameter ValDelim. Switches which do not
  take on any explicit value will be returned as type String, with a
  value length of zero.

  Switches whose VALUE is intended to be of type String, but with a FORM
  qualifying as a numeric must be enclosed in either single or double
  quotation marks. Otherwise, it will be returned as a Real or LongInt,
  as determined by its specific syntax (unless StrOnly = True in the
  call).

  Additionally, any blanks included in String values will be packed out
  unless the value is included in quotation marks. Further, if single
  quote marks are to be included as part of a string value, then double
  quotes must be used to define the value; and vice versa.

ERROR RETURNS:
  The error parameter returns one of three values:
            0 --> No error encountered.
            1 --> Unbalanced single quotes encountered.
            2 --> Unbalanced double quotes encountered.
            3 --> Insufficient heap space to store the switch list.
}


Implementation
{------------}

var
  IsFirst : boolean;
  X       : dlList;

procedure ClInit;
{Initializes the command line switch list}
  begin
    dlListInit(X, SizeOf(SwRec));
    IsFirst := true;
    end; {ClInit}

procedure ClClose;
{Closes and frees the space associated with the command line switch list}
  begin
    dlFree(X);
    end; {ClClose}

function GetSwitch(var Y : SwRec) : boolean;
{Retrieves the next switch record. Returns FALSE if no more.}
  var
    B1  : boolean;
  begin
    if IsFirst then begin
      B1 := dlGetFirst(X, Y);
      GetSwitch := B1;
      IsFirst := false;
      end
    else begin
      B1 := dlGetNext(X, Y);
      GetSwitch := B1;
      end;
    end; {GetSwitch}

function PopSwitch(var Y : SwRec) : boolean;
{Retrieves the next switch record and frees its heap space.
 Returns FALSE if no more.}
  var
    B1  : boolean;
  begin
    B1 := dlPop(X, Y);
    PopSwitch := B1;
    end; {PopSwitch}

function ReadSwCh : char;
{Reads the current switch lead-in character}
  var
    X     : Registers;
  begin {Read the current character}
    X.AH := $37;
    X.AL := 0;
    Intr($21, X);
    ReadSwCh := char(X.DL);
    end;

procedure SetSwCh(C : char);
{Sets the switch lead-in character to C}
  var
    X     : Registers;
  begin {Set the current character}
    X.AH := $37;
    X.AL := 1;
    char(X.DL) := C;
    Intr($21, X);
    end;

Procedure ClParse(StrPtr : Pointer; StrOnly : Boolean;
              LeadIn, ValDelim : CharSet; var Err : Integer);
  const
    MQT   = ^C;   {Master quote mark}
    MVD   = ^M;   {Master value delimiter}
    MLI   = ^[;   {Master lead-in mark}
  var
    CmdLine    : ^String;
    CLine      : String;
    QuoteState : (Qoff, Quote1, Quote2);
    ValueState : (Voff, Von);
    T1         : Integer;
  Procedure PackCommandLine( var Err : Integer );
  {Packs out all blanks not enclosed between balanced single or double
   quotes, and replaces all such quote marks with Master Quotes. Replaces
   all lead-in characters with Master Lead-In characters. Replaces all
   value delimiters with Master Value Delimiters.}
    const
      PM       : CharSet = ['+','-'];
    var
      T1       : Integer;
    begin
      CLine := '';
      QuoteState := Qoff;
      ValueState := Voff;
      For T1 := 1 to Length(CmdLine^) do
        Case QuoteState of
          Qoff   : Case CmdLine^[T1] of
                     ' '  : ;
                     '''' : begin
                              QuoteState := Quote1;
                              CLine := CLine + MQT;
                              end;
                     '"'  : begin
                              QuoteState := Quote2;
                              CLine := CLine + MQT;
                              end;
                     else begin
                            if (T1 > 1) and
                               (CLine[Length(CLine)] = MVD) and
                               (CmdLine^[T1] in PM) then begin
                              CLine := CLine + CmdLine^[T1];
                              end
                            else
                              if (CmdLine^[T1] in LeadIn) then begin
                                CLine := CLine + MLI;
                                ValueState := Voff;
                                end
                              else
                                if (CmdLine^[T1] in ValDelim) and
                                   (ValueState = Voff) then begin
                                  CLine := CLine + MVD;
                                  ValueState := Von;
                                  end
                                else begin
                                  CLine := CLine + CmdLine^[T1];
                                  end;
                            end;
                     end;
          Quote1 : Case CmdLine^[T1] of
                     '''' : begin
                              QuoteState := Qoff;
                              CLine := CLine + MQT;
                              end;
                     else   CLine := CLine + CmdLine^[T1];
                     end;
          Quote2 : Case CmdLine^[T1] of
                     '"'  : begin
                              QuoteState := Qoff;
                              CLine := CLine + MQT;
                              end;
                     else   CLine := CLine + CmdLine^[T1];
                     end;
          end;
      If (Length(CLine) > 0) and (CLine[1] <> MLI) then
        CLine := MLI + CLine;
      Err := ord(QuoteState);
      end; {PackCommandLine}
  function MakeSwitchRecord : boolean;
    var
      WorkSpace : String;
      Err       : Integer;
      T1        : Integer;
      SwitchRec : SwRec;
    begin
      Delete(CLine, 1, 1); {Strip leading MLI}
      WorkSpace := CLine;
      If Pos(MLI, WorkSpace) <> 0 then begin
        WorkSpace[0] := chr(Pos(MLI, WorkSpace) - 1);
        Delete(CLine, 1, Pos(MLI, CLine)-1);
        end
      else
        CLine := '';
      With SwitchRec do begin
        If Pos(MVD, WorkSpace) <> 0 then begin
          Name := Copy(WorkSpace, 1, Pos(MVD, WorkSpace)-1);
          Delete(WorkSpace, 1, Pos(MVD, WorkSpace));
          end
        else begin
          Name := WorkSpace;
          WorkSpace := '';
          end;
    {Name has been set. Now get type and value}
        If not StrOnly then begin
          If Length(WorkSpace) = 0 then begin
            SwVal   := VtStr;
            StrVal  := '';
            MakeSwitchRecord := dlPut(X, SwitchRec);
            exit
            end;
          Val(WorkSpace, IntVal, Err);
          If Err = 0 then begin
            SwVal := VtInt;
            MakeSwitchRecord := dlPut(X, SwitchRec);
            exit
            end;
          Val(WorkSpace, RealVal, Err);
          If Err = 0 then begin
            SwVal := VtReal;
            MakeSwitchRecord := dlPut(X, SwitchRec);
            exit
            end;
          end; {If not StrOnly}
        SwVal   := VtStr;
        StrVal  := WorkSpace;
        DelAll(StrVal, MQT, StrVal);
        MakeSwitchRecord := dlPut(X, SwitchRec);
        end; {With SwitchRec}
      end; {MakeSwitchRecord}
  begin {ClParse}
    If StrPtr = nil then
      CmdLine := Ptr(PrefixSeg, $0080)
    else
      CmdLine := StrPtr;
    PackCommandLine(Err);
    If (Length(CLine) = 0) or (Err <> 0) then exit;
    While Pos(MLI, CLine) <> 0 do begin
      if MakeSwitchRecord then
        Err := 0
      else begin
        Err := 3;
        exit;
        end;
      end;
    end; {ClParse}
  end.