DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦023cc1471⟧ TextFile

    Length: 9106 (0x2392)
    Types: TextFile
    Names: »PARAM.PAS«

Derivation

└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
    └─⟦this⟧ »UNITS\PARAM.PAS«

TextFile

      {$R-}    {Range checking off}\r
      {$B+}    {Boolean complete evaluation on}\r
      {$S+}    {Stack checking on}\r
      {$I+}    {I/O checking on}\r
      {$N-}    {No numeric coprocessor}\r
 \r
  UNIT Param;\r
 \r
    INTERFACE\r
 \r
  USES\r
    Crt,\r
    Dos,\r
    DosUtil;\r
 \r
  CONST\r
    Max_KeyWord_Length = 8;\r
    FM_ReadOnly = 0 { Common values for all file types, keept in FileMode };\r
    FM_Write = 1;\r
    FM_ReadWrite = 2;\r
 \r
 \r
  TYPE\r
    KindType = (OnOff, Numeric, TextType, FileType, KnownFile);\r
    ParamRec  = RECORD\r
                   Kind    : KindType;    { Parameter kind }\r
                   Defined : boolean;     { true if parameter specified }\r
                   KeyWord : STRING[Max_KeyWord_length]; { Keyword name for options }\r
                   NumVal  : LongInt;     { Value of numerical parameter }\r
                   TextVal : STRING;      { Parameter value in text form }\r
                END;\r
 \r
  PROCEDURE GetOptions(OptionString: STRING;\r
    VAR OptionList; MaxOption: integer);\r
 \r
  PROCEDURE GetParams(VAR ParamList;  MaxParam: integer;\r
    VAR OptionList; MaxOption: integer);\r
 \r
  FUNCTION MatchOptionStr(Opt_Str: STRING;\r
    Opt_txt_size: integer; Opt_List: STRING): integer;\r
 \r
      {===========================================================================}\r
 \r
  IMPLEMENTATION\r
      { 1989-01-26  LEI  NumVal set to LongInt, KeyCh changed to KeyWord, and\r
      MatchOption procedure introduced.\r
      1989-01-31  LEI  Changed match og keywords to allow keys of more than 1\r
      char, and ensure match on the minimun number of chars\r
      neaded to locate the key uniquely.\r
      1989-02-12  LEI  Introduced FileMode, to be able to access read-only files.\r
      }\r
 \r
  CONST\r
    ErrorString : STRING[13] = 'Environment: ';\r
 \r
 \r
 \r
 \r
  TYPE\r
    Params = ARRAY[1..128] OF ParamRec;\r
 \r
    PROCEDURE ParamError( Message : STRING);\r
    BEGIN\r
      WriteLn(ErrorString, Message);\r
      Halt;\r
    END;\r
 \r
    PROCEDURE GetOptions(OptionString: STRING;\r
      VAR OptionList; MaxOption: integer);\r
    VAR\r
      np, nr : integer;\r
      Result,\r
      ParamNo : integer;\r
      KeyStr, TempStr : STRING;\r
      FM_atCall: byte;\r
 \r
      FUNCTION MatchKeyWord( keyw: STRING): integer;\r
      VAR\r
        found, i, nkw: integer;\r
        uc_key: STRING;\r
 \r
      BEGIN\r
        uc_key := UpperStr(keyw);\r
 \r
        found := 0 (* assume no find *);\r
 \r
        FOR i := 1 TO MaxOption DO\r
          IF ( Pos(uc_key, Params(Optionlist)[i].KeyWord ) = 1) AND\r
            ( length(uc_key) <= Max_KeyWord_Length ) THEN\r
            BEGIN\r
              IF found = 0 THEN\r
                found := i\r
              ELSE\r
                found := -1  (* keyw not unique *);\r
            END;\r
        MatchKeyWord := found;\r
      END (* MatchKeyWord *);\r
 \r
 \r
    BEGIN\r
      FM_atCall := FileMode;\r
      FileMode := FM_ReadOnly { Make it possible to se read_only files };\r
 \r
      WHILE Pos('/', OptionString) > 0 DO\r
        BEGIN\r
 \r
          TempStr := copy(OptionString, 2, 255) (* skip '/' *);\r
          nr := Pos('/', TempStr);\r
          IF nr = 0 THEN\r
            nr := length(TempStr) + 1;\r
 \r
          OptionString := Copy(OptionString, nr+1, 255);\r
          Delete(TempStr, nr, 255);\r
 \r
          nr := Pos(':', TempStr);\r
          IF nr = 0 THEN\r
            nr := length(TempStr) + 1;\r
          KeyStr := Copy(TempStr, 1, nr-1);\r
          Delete(TempStr, 1, nr);\r
 \r
          IF length(KeyStr) = 0 THEN\r
            ParamError(' Option must be specifyed: /');\r
 \r
          np := MatchKeyWord( KeyStr);\r
 \r
          CASE np OF\r
 \r
            -1 : ParamError(' Option not unique:  /'+ KeyStr);\r
 \r
            0 : ParamError(' Option not found:  /'+ KeyStr);\r
 \r
          ELSE\r
            WITH Params(OptionList)[np] DO\r
              CASE Kind OF\r
 \r
                OnOff:\r
                  IF length(TempStr) > 0 THEN\r
                    BEGIN\r
                      TextVal := UpperStr(TempStr);\r
                      IF (TextVal = 'ON') OR (TextVal = 'OFF') THEN Defined := true;\r
                      IF NOT Defined THEN\r
                        ParamError('Illegal ON/OFF option: /'+KeyWord+':'+TempStr);\r
                    END\r
                  ELSE\r
                    BEGIN\r
                      Defined := true;\r
                      TextVal := 'ON';\r
                    END;\r
 \r
 \r
                Numeric:\r
                  BEGIN\r
                    TextVal := TempStr;\r
                    Val(TexTVal,NumVal,Result);\r
                    Defined := Result = 0;\r
                    IF NOT Defined THEN\r
                      ParamError('Illegal numeric option: /'+KeyWord+':'+TempStr);\r
                  END;\r
 \r
                TextType:\r
                  BEGIN\r
                    TextVal := TempStr;\r
                    Defined := true;\r
                  END;\r
 \r
                KnownFile:\r
                  BEGIN\r
                    IF Pos('.',TempStr) > 0 THEN\r
                      TextVal := UpperStr(TempStr)\r
                    ELSE\r
                      TextVal := UpperStr(TempStr)+TextVal;\r
                    Defined := FileExist(TextVal);\r
                    IF NOT Defined THEN\r
                      ParamError('File not known, option: /'+KeyWord+':'+TempStr);\r
                  END;\r
 \r
                FileType:\r
                  BEGIN\r
                    TextVal := UpperStr(TempStr);\r
                    Defined := true;\r
                  END;\r
 \r
              ELSE\r
                ParamError('Illegal syntax, option: ' + KeyWord);\r
 \r
        END; { case Kind }\r
    END; { Case np }\r
 \r
  END (* while *);\r
 \r
  FileMode := FM_atCall;\r
  END; { GetOptions }\r
 \r
  PROCEDURE GetParams;\r
  VAR\r
    np, nr : integer;\r
    Result,\r
    ParamNo : integer;\r
    TempStr,\r
    OptionString : STRING;\r
    FM_atCall: byte;\r
 \r
  BEGIN\r
    FM_atCall := FileMode;\r
    FileMode := FM_ReadOnly { Make it possible to se read_only files };\r
    ErrorString := 'Parameters: ';\r
    OptionString := '';\r
    ParamNo := 0;\r
    FOR np := 1 TO ParamCount DO\r
      BEGIN\r
        TempStr := ParamStr(np);\r
        IF TempStr[1] = '/' THEN OptionString := OptionString + TempStr\r
        ELSE\r
          BEGIN\r
            nr := Pos('/',TempStr);\r
            IF nr > 0 THEN\r
              BEGIN\r
                OptionString := OptionString + Copy(TempStr,nr,255);\r
                Delete(TempStr,nr,255);\r
              END;\r
            ParamNo := Succ(ParamNo);\r
            IF ParamNo > MaxParam THEN ParamError('Too many parameters');\r
            WITH Params(ParamList)[ParamNo] DO\r
              BEGIN\r
                CASE Kind OF\r
 \r
                  OnOff:\r
                    BEGIN\r
                      TextVal := UpperStr(TempStr);\r
                      IF (TextVal = 'ON') OR (TextVal = 'OFF') THEN Defined := true;\r
                      IF NOT Defined THEN\r
                        ParamError('Illegal ON/OFF parameter: '+TempStr);\r
                    END;\r
 \r
                  Numeric:\r
                    BEGIN\r
                      TextVal := TempStr;\r
                      Val(TexTVal,NumVal,Result);\r
                      Defined := Result = 0;\r
                      IF NOT Defined THEN\r
                        ParamError('Illegal numeric parameter: '+TempStr);\r
                    END;\r
 \r
                  TextType:\r
                    BEGIN\r
                      TextVal := TempStr;\r
                      Defined := true;\r
                    END;\r
 \r
                  KnownFile:\r
                    BEGIN\r
                      IF Pos('.',TempStr) > 0 THEN\r
                        TextVal := UpperStr(TempStr)\r
                      ELSE\r
                        TextVal := UpperStr(TempStr)+TextVal;\r
                      Defined := FileExist(TextVal);\r
                      IF NOT Defined THEN\r
                        ParamError('File not known, parameter: '+TempStr);\r
                    END;\r
 \r
                  FileType:\r
                    BEGIN\r
                      TextVal := UpperStr(TempStr);\r
                      Defined := true;\r
                    END;\r
 \r
                ELSE\r
                  ParamError('Illegal syntax, option: ' + KeyWord);\r
 \r
              END; { case }\r
          END;\r
      END; { Parameter }\r
  END; { Scan parameters }\r
  GetOptions(OptionString, OptionList, MaxOption);\r
 \r
  FileMode := FM_atCall;\r
  END; { GetParams }\r
 \r
  FUNCTION MatchOptionStr;\r
  VAR\r
    found, i, nkw: integer;\r
    uc_key: STRING;\r
 \r
  BEGIN\r
    uc_key := UpperStr(Opt_Str);\r
 \r
    nkw := length(Opt_List) DIV Opt_txt_size;\r
    found := 0 (* assume no find *);\r
 \r
    FOR i := 1 TO nkw DO\r
      IF ( Pos(uc_key,\r
        copy(Opt_List, 1 + (i-1)*Opt_txt_size, Opt_txt_size) ) = 1  ) AND\r
        ( length(uc_key) <= Opt_txt_size ) THEN\r
        BEGIN\r
          IF found = 0 THEN\r
            found := i\r
          ELSE\r
            found := -1  (* Opt_Str not unique *);\r
        END;\r
    MatchOptionStr := found;\r
  END (* MatchOptionStr *);\r
 \r
  END.\r