Power-Programmierung/CD1.mdf/pascal/library/dos/nktools/strutil.pas

Pascal/Delphi Source File | 1990-05-14 | 25.3 KB | 622 lines

UNIT StrUtil;
(*====================================================================*\
|| MODULE NAME:  StrUtil                                              ||
|| DEPENDENCIES: System                                               ||
|| LAST MOD ON:  9005.14                                              ||
|| PROGRAMMERS:  Andrea Spilholtz, Mike Temkin, SteveAlter,           ||
||               Naoto Kimura                                         ||
||                                                                    ||
||     This is a library of string handling routines.  Many have been ||
|| rewritten in assembler for the sake of speed.                      ||
||                                                                    ||
|| Modification history                                               ||
||                                                                    ||
|| 8907.10    Naoto Kimura                                            ||
||            * Last update before the code was prepared for spring   ||
||              semester.                                             ||
|| 8912.10    Naoto Kimura                                            ||
||            * Added LoCase, UpperCaseStr, and LowerCaseStr          ||
||              functions.                                            ||
|| 9001.17    Naoto Kimura                                            ||
||            * Started to modify some functions for rewriting in     ||
||              assembly.                                             ||
|| 9001.19    Naoto Kimura                                            ||
||            * Minor modifications for efficiency.                   ||
||            * Renamed some functions: UpperCaseStr --> UpperStr     ||
||              and LowerCaseStr --> LowerStr.                        ||
||            * Changed UpperCase, LowerCase, Alphabet and AlphaNum   ||
||              into regular variables instead of typed constants.    ||
||              (Just in case the UpCase function gets redefined)     ||
||            * Added two new functions, LoCase2 and UpCase2 to       ||
||              perform lowercasing and uppercasing as defined by the ||
||              user (by changing the variables LowerTbl and UpperTbl ||
||              look-up tables)                                       ||
|| 9001.20    Naoto Kimura                                            ||
||            * The following routines have been rewritten in         ||
||              assembly to speed them up and to reduce memory usage: ||
||                 LoCase, LoCase2, UpCase2                           ||
||                 UpperStr, LowerStr                                 ||
||                 RightPos                                           ||
||                 RightJustify, LeftJustify, Center, Reverse         ||
|| 9001.20    Naoto Kimura                                            ||
||            * The following was rewritten in assembly:              ||
||                 Copies                                             ||
|| 9002.26    Naoto Kimura                                            ||
||            * Added function LeftPos which does a similar task as   ||
||              the RightPos function.                                ||
||            * Added function Strip to perform stripping of unwanted ||
||              characters.  Eventually, this too shall be rewritten  ||
||              in assembler.                                         ||
|| 9005.06    Naoto Kimura                                            ||
||            * Rewrote RPos in assembler and split up the assembler  ||
||              modules to aid the unused code removal.               ||
|| 9005.14    Naoto Kimura                                            ||
||            * Rewrote Strip in assembler.                           ||
\*====================================================================*)
{$R-}    {Range checking off}
{$S+}    {Stack checking on}
{$D-}    {Debug info off}
{$I-}    {I/O checking off}
{$N-}    {No numeric coprocessor}

INTERFACE

TYPE
    CharLookTbl    = ARRAY [Char] OF Char;
    CharSet    = SET OF Char;

CONST
    WhiteSpace    : CharSet    = [' ',#9,#10,#13];
    Numeric    : CharSet    = ['0'..'9'];

VAR
    UpperCase    : CharSet;
    LowerCase    : CharSet;
    Alphabet    : CharSet;
    AlphaNum    : CharSet;
{$IFDEF DEBUG}
    StdLower    : CharLookTbl;
{$ENDIF}
    LowerTbl,
    UpperTbl    : CharLookTbl;

(*--------------------------------------------------------------------*\
| NAME:  StrInt                                                        |
|                                                                      |
|     This function returns string representation of an integer value. |
| This function really returns the value of the Str procedure, but     |
| this way we can use the value w/o having to explicitly call Str with |
| a temporary string.  This really only comes in handy if you want to  |
| the conversion and then use the string value to do concatenation or  |
| pass the string value into a function.                               |
\*--------------------------------------------------------------------*)
FUNCTION StrInt (
        I: Integer
    ): String;

(*--------------------------------------------------------------------*\
| NAME:  StrReal                                                       |
|                                                                      |
|     This function returns string representation of a real value.     |
| This function really returns the value of the Str procedure, but     |
| this way we can use the value w/o having to explicitly call Str with |
| a temporary string.  This really only comes in handy if you want to  |
| the conversion and then use the string value to do concatenation or  |
| pass the string value into a function.                               |
\*--------------------------------------------------------------------*)
FUNCTION StrReal (
        R: Real
    ): String;

(*--------------------------------------------------------------------*\
| NAME: LoCase                                                         |
|                                                                      |
|     This function performs the opposite function as the UpCase       |
| function; it takes an upper case character and transforms it into    |
| its lower case form.                                                 |
\*--------------------------------------------------------------------*)
FUNCTION LoCase (
        C: Char
    ): Char;

(*--------------------------------------------------------------------*\
| NAME: LoCase2                                                        |
|                                                                      |
|     This function performs a similar function as the LoCase          |
| function; it takes an upper case character and transforms it into    |
| its lower case form.  The difference is that the the lowercasing can |
| be altered by the user.                                              |
\*--------------------------------------------------------------------*)
FUNCTION LoCase2 (
        C: Char
    ): Char;

(*--------------------------------------------------------------------*\
| NAME: UpCase2                                                        |
|                                                                      |
|     This function performs a similar function as the UpCase          |
| function; it takes an lower case character and transforms it into    |
| its upper case form.  The difference is that the the uppercasing can |
| be altered by the user.                                              |
\*--------------------------------------------------------------------*)
FUNCTION UpCase2 (
        C: Char
    ): Char;

(*--------------------------------------------------------------------*\
| NAME:  UpperStr                                                      |
|                                                                      |
|     This function returns the passed string with all the lower case  |
| characters transformed into upper case characters.                   |
\*--------------------------------------------------------------------*)
FUNCTION UpperStr (
        S    :String
    ): String;

(*--------------------------------------------------------------------*\
| NAME:  LowerStr                                                      |
|                                                                      |
|     This function returns the passed string with all the upper case  |
| characters transformed into lower case characters.                   |
\*--------------------------------------------------------------------*)
FUNCTION LowerStr (
        S    :String
    ): String;

(*--------------------------------------------------------------------*\
| NAME:  RightPos                                                      |
|                                                                      |
|     This function returns the last matching position of character    |
| "C" in "S".                                                          |
\*--------------------------------------------------------------------*)
FUNCTION RightPos (
        S    : String;
        C    : Char
    ): Integer;

(*--------------------------------------------------------------------*\
| NAME:  LeftPos                                                       |
|                                                                      |
|     This function returns the first matching position of character   |
| "C" in "S".                                                          |
\*--------------------------------------------------------------------*)
FUNCTION LeftPos (
        S    : String;
        C    : Char
    ): Integer;

(*--------------------------------------------------------------------*\
| NAME:  RPos                                                          |
|                                                                      |
|     This function returns the last matching position of "Needle" in  |
| "HayStack."                                                          |
\*--------------------------------------------------------------------*)
FUNCTION RPos(
        Needle,
        HayStack    : string
    ) : byte;

(*--------------------------------------------------------------------*\
| NAME:  CharSetPos                                                    |
|                                                                      |
|     This routine returns the first position of a member of a set     |
| "Srch" within the string "HayStack."                                 |
\*--------------------------------------------------------------------*)
FUNCTION CharSetPos(
        Srch    : CharSet;
        HayStack    : string
    ) : byte;

(*--------------------------------------------------------------------*\
| NAME:  RCharSetPos                                                   |
|                                                                      |
|     This routine returns the last position of a member of a set      |
| "Srch" within the string "HayStack."                                 |
\*--------------------------------------------------------------------*)
FUNCTION RCharSetPos(
        Srch    : CharSet;
        HayStack    : string
    ) : byte;

(*--------------------------------------------------------------------*\
| NAME: CharSetStrip                                                   |
|                                                                      |
|     This function strips off the specified characters from Original. |
| Leading characters to strip off are specified in LeadSet and         |
| trailing characters to strip off are specifed in TrailSet.           |
\*--------------------------------------------------------------------*)
FUNCTION CharSetStrip (
        Original    : string;
        LeadSet,
        TrailSet    : CharSet
    ) : string;

(*--------------------------------------------------------------------*\
| NAME:  Copies                                                        |
|                                                                      |
|     This function returns as many copies of a string concatenated    |
| together as requested.                                               |
\*--------------------------------------------------------------------*)
FUNCTION Copies (
        Original    : String;
        Num        : Byte
    ) : String;

(*--------------------------------------------------------------------*\
| NAME:  RightJustify                                                  |
|                                                                      |
|     This function returns a string that has the string "Original"    |
| right justified in a field of length "width" of the character        |
| "filler".  If the string is longer than the field, the string will   |
| be truncated at the field width.                                     |
\*--------------------------------------------------------------------*)
FUNCTION RightJustify (
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;

(*--------------------------------------------------------------------*\
| NAME:  LeftJustify                                                   |
|                                                                      |
|     This function returns a string that has the string "Original"    |
| left justified in a field of length "width" of the character         |
| "filler".  If the string is longer than the field, the string will   |
| be truncated at the field width.                                     |
\*--------------------------------------------------------------------*)
FUNCTION LeftJustify (
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;

(*--------------------------------------------------------------------*\
| NAME:  Center                                                        |
|                                                                      |
|     This function returns a string that has the string "Original"    |
| centered in a field of length "width" of the character "filler".  If |
| the string is longer than the field, the string will be truncated at |
| the field width.                                                     |
\*--------------------------------------------------------------------*)
FUNCTION Center (
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;

(*--------------------------------------------------------------------*\
| NAME: Strip                                                          |
|                                                                      |
|     This function strips off unwanted characters from either the     |
| left, right or both ends of a string.
\*--------------------------------------------------------------------*)
function Strip (
        Original    : String;
        Unwanted    : String;
        Location    : Char
    ) : String;

(*--------------------------------------------------------------------*\
| NAME:  SkipStr                                                       |
|                                                                      |
|     This routine is used to grab a copy of the string, past the      |
| location of the given pattern.                                       |
\*--------------------------------------------------------------------*)
FUNCTION SkipStr (
        Original,
        pattern    : string
    ) : string;

(*--------------------------------------------------------------------*\
| NAME:  Reverse                                                       |
|                                                                      |
|     This function returns a copy of a string that is reversed.       |
\*--------------------------------------------------------------------*)
FUNCTION Reverse (
        Original    : string
    ) : string;

(*--------------------------------------------------------------------*\
| NAME:  FindPos                                                       |
|                                                                      |
|     This function returns the position of the character "C" within   |
| string "S," ignoring any occurances before the "P"th position with   |
| "S."                                                                 |
\*--------------------------------------------------------------------*)
FUNCTION FindPos (
        S    : String;
        C    : Char;
        P    : Integer
    ): Integer;

IMPLEMENTATION

VAR
    WorkBuffer    : String;
{$IFNDEF DEBUG}
    StdLower    : CharLookTbl;
{$ENDIF}

(*--------------------------------------------------------------------*\
| NAME:  StrInt                                                        |
\*--------------------------------------------------------------------*)
FUNCTION StrInt (
        I: Integer
    ): String;
    BEGIN
    Str(I,WorkBuffer);  StrInt := WorkBuffer;
    END;  (* StrInt *)

(*--------------------------------------------------------------------*\
| NAME:  StrReal                                                       |
\*--------------------------------------------------------------------*)
FUNCTION StrReal (
        R: Real
    ): String;
    BEGIN
    Str(R:1:5,WorkBuffer);  StrReal := WorkBuffer;
    END;  (* StrReal *)

{$L Cases.OBJ}

(*--------------------------------------------------------------------*\
| NAME: LoCase                                                         |
\*--------------------------------------------------------------------*)
FUNCTION LoCase (C: Char): Char;
    External;

(*--------------------------------------------------------------------*\
| NAME: LoCase2                                                        |
\*--------------------------------------------------------------------*)
FUNCTION LoCase2 (C: Char): Char;
    External;

(*--------------------------------------------------------------------*\
| NAME: UpCase2                                                        |
\*--------------------------------------------------------------------*)
FUNCTION UpCase2 (C: Char): Char;
    External;

(*--------------------------------------------------------------------*\
| NAME:  UpperStr                                                      |
\*--------------------------------------------------------------------*)
FUNCTION UpperStr ( S :String ): String;
    External;

(*--------------------------------------------------------------------*\
| NAME:  LowerStr                                                      |
\*--------------------------------------------------------------------*)
FUNCTION LowerStr ( S :String ): String;
    External;

{$L StrPos.OBJ}

(*--------------------------------------------------------------------*\
| NAME:  RPos                                                          |
\*--------------------------------------------------------------------*)
FUNCTION RPos(
        Needle,
        HayStack    : string
    ) : byte;
    External;

(*--------------------------------------------------------------------*\
| NAME:  RightPos                                                      |
\*--------------------------------------------------------------------*)
FUNCTION RightPos ( S:String;  C:Char ) : Integer;
    External;

(*--------------------------------------------------------------------*\
| NAME:  LeftPos                                                       |
\*--------------------------------------------------------------------*)
FUNCTION LeftPos ( S:String;  C:Char ) : Integer;
    External;

(*--------------------------------------------------------------------*\
| NAME:  CharSetPos                                                    |
\*--------------------------------------------------------------------*)
FUNCTION CharSetPos(
        Srch    : CharSet;
        HayStack    : string
    ) : byte;
    VAR
    i    : byte;
    BEGIN
    IF (HayStack = '') OR (Srch = []) THEN
        CharSetPos := 0
    ELSE BEGIN
        FOR i := 1 TO length(HayStack) DO
        IF HayStack[i] IN Srch THEN BEGIN
            CharSetPos := i;
            exit
          END;
        CharSetPos := 0
      END
    END;    (* CharSetPos *)

(*--------------------------------------------------------------------*\
| NAME:  RCharSetPos                                                   |
\*--------------------------------------------------------------------*)
FUNCTION RCharSetPos(
        Srch    : CharSet;
        HayStack    : string
    ) : byte;
    VAR
    i    : byte;
    BEGIN
    IF (HayStack = '') OR (Srch = []) THEN
        RCharSetPos := 0
    ELSE BEGIN
        FOR i := length(HayStack) DOWNTO 1 DO
        IF HayStack[i] IN Srch THEN BEGIN
            RCharSetPos := i;
            exit
          END;
        RCharSetPos := 0
      END
    END;    (* RCharSetPos *)

(*--------------------------------------------------------------------*\
| NAME: CharSetStrip                                                   |
\*--------------------------------------------------------------------*)
FUNCTION CharSetStrip(
        Original    : string;
        LeadSet,
        TrailSet    : CharSet
    ) : string;
    VAR
    Left,
    Right    : byte;
    stop    : boolean;
    BEGIN
    Left := 1;
    Right := length(Original);
    IF Left>Right THEN
        stop := FALSE
    ELSE
        stop := NOT (Original[Left] IN LeadSet)
            AND NOT (Original[Right] IN TrailSet);
    WHILE NOT (stop OR (Right<Left)) DO BEGIN
        stop := TRUE;
        IF Original[Left] IN LeadSet THEN BEGIN
        inc(Left);
        stop := FALSE
          END;
        IF Original[Right] IN TrailSet THEN BEGIN
        dec(Right);
        stop := FALSE
          END
      END;
    IF stop THEN
        CharSetStrip := copy(Original,Left,Right-Left+1)
    ELSE
        CharSetStrip := ''
    END;    (* CharSetStrip *)

{$L StrFmt.OBJ}

(*--------------------------------------------------------------------*\
| NAME:  Copies                                                        |
\*--------------------------------------------------------------------*)
FUNCTION Copies (
        Original    : String;
        Num        : Byte
    ) : String;
    External;

(*--------------------------------------------------------------------*\
| NAME:  RightJustify                                                  |
\*--------------------------------------------------------------------*)
FUNCTION RightJustify(
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;
    External;

(*--------------------------------------------------------------------*\
| NAME:  LeftJustify                                                   |
\*--------------------------------------------------------------------*)
FUNCTION LeftJustify(
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;
    External;

(*--------------------------------------------------------------------*\
| NAME:  Center                                                        |
\*--------------------------------------------------------------------*)
FUNCTION Center(
        Original    : string;
        width    : byte;
        filler    : char
    ) : string;
    External;

(*--------------------------------------------------------------------*\
| NAME: Strip                                                          |
\*--------------------------------------------------------------------*)
function Strip (
        Original    : String;
        Unwanted    : String;
        Location    : Char
    ) : String;
    External;

(*--------------------------------------------------------------------*\
| NAME:  SkipStr                                                       |
\*--------------------------------------------------------------------*)
FUNCTION SkipStr(
        original,
        pattern    : string
    ) : string;
    BEGIN
    SkipStr := copy(original,
            pos(pattern,original)+length(pattern),
            length(original))
    END;    (* SkipStr *)

(*--------------------------------------------------------------------*\
| NAME:  Reverse                                                       |
\*--------------------------------------------------------------------*)
FUNCTION Reverse( Original : String ) : String;
    External;

(*--------------------------------------------------------------------*\
| NAME:  FindPos                                                       |
\*--------------------------------------------------------------------*)
FUNCTION FindPos (
        S    : String;
        C    : Char;
        P    : Integer
    ): Integer;
    VAR
    T    : Integer;
    BEGIN
    IF (P < 1) OR (P > Length(S)) THEN
        FindPos := 0
    ELSE BEGIN
        T := Pos(C,Copy(S,P,Length(S)));
        IF T <> 0 THEN
        T := T - 1 + P;
        FindPos := T
      END
    END;  (* FindPos *)

PROCEDURE Init;
    VAR
    C    : Char;
    BEGIN
    LowerCase := [];
    UpperCase := [];

{$IFDEF DEBUG}
    FillChar(StdLower,SizeOf(StdLower),128);
    FillChar(LowerTbl,SizeOf(LowerTbl),128);
    FillChar(UpperTbl,SizeOf(UpperTbl),128);
{$ENDIF}

    FOR C := chr(0) TO chr(255) DO BEGIN
        UpperTbl[C] := C;
        StdLower[C] := C;
        LowerTbl[C] := C
      END;

    FOR C := chr(0) TO chr(255) DO
        IF UpCase(C) <> C THEN BEGIN
        StdLower[UpCase(C)] := C;
        LowerTbl[UpCase(C)] := C;
        UpperTbl[C] := UpCase(C);
        UpperCase := UpperCase + [UpCase(C)];
        LowerCase := LowerCase + [C]
          END;

    Alphabet := LowerCase + UpperCase;
    AlphaNum := Alphabet + Numeric
    END;

BEGIN
    Init;
END.