Power-Programmierung/CD1.mdf/pascal/library/dos/btree/tree/compare.pas

Pascal/Delphi Source File | 1989-07-13 | 17.5 KB | 455 lines

(* TBTree16             Copyright (c)  1988,1989       Dean H. Farwell II    *)

unit Compare;

(*****************************************************************************)
(*                                                                           *)
(*             D A T A   C O M P A R I S O N   R O U T I N E S               *)
(*                                                                           *)
(*****************************************************************************)

(* This unit contains two routines which will compare two values and
   determine whether the first value is LESSTHAN, EQUALTO, or GREATERTHAN the
   second value.  The following predefined Turbo Pascal types are supported:

                   Byte
                   ShortInt
                   Integer
                   LongInt
                   Word
                   String (any sizes)
                   Real
                   Single
                   Double
                   Extended
                   Comp
                   ByteArray

   Note - To use Single, Double, Extended and Comp (8087 types) you must
   compile the unit using {$N+}.

   Additionally, the ByteArray type is also handled.  This type is defined in
   the Numbers unit.

   This unit also contains three routines for determining if a substring
   starts a target string, ends a target string, or is contained in a target
   string.  These routines are placed in this unit, because the strings are
   passed in as untyped parameters just like in the first two routines in
   this unit.                                                                *)

(*\*)
(* Version Information

   Version 1.1 - Added SubstringCompare routine

               - Added ContainsSubstring routine

               - Added StartsWithSubstring routine

               - Added EndsWithSubstring routine

   Version 1.2 - No Changes

   Version 1.3 - No Changes

   Version 1.4 - Moved the ValueType type definition from this unit to the
                 Numbers unit in order to preclude a circular definition
                 error.

               - Upgraded CompareValues to handle BYTEARRAYVALUEs

               - Fixed error in EndsWithSubstring routine.  Previously, a
                 search for a string such as 'xxx' would not find a match for
                 a string ending with 'xxxx' using this routine.  This has
                 been corrected

               - Added the ContainsSubstringAtPosition routine

               - Now use an {$IFOPT N+} conditional compilation directive to
                 handle 8087 types

   Version 1.5 - Changed code internally to use Inc and Dec where practical

   Version 1.6 - No Changes                                                  *)


(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

uses
    ByteData,
    Numbers;

type
    Comparison = (LESSTHAN,EQUALTO,GREATERTHAN);


(*\*)
(* This routine will compare two values and return the result of the comparison.
   The result is of type Comparison and LESSTHAN, EQUALTO, or GREATERTHAN will
   be returned.  The values compared must be of the same type.  Legal types are
   those enumerated in the type ValueType.  The type of the values is passed in
   as a parameter along with the values.

   note : the values must reside in a variable since a var parameter is used.
   This is necessary since the address is needed to facilitate the use of this
   routine with multiple types.                                              *)

function CompareValues(var paramValue1;
                       var paramValue2;
                       vType : ValueType) : Comparison;


(* This routine will compare two values of type STRINGVALUE and look for a
   partial match.  The first parameter (paramValue1) contains a substring which
   will be searched for in paramValue2.  The search is only to see if
   paramValue2 starts with substring paramValue1.  If paramValue2 starts with
   paramValue1 then EQUALTO will be returned.  Otherwise if paramValue1 is
   less that paramValue2 then LESSTHAN will be returned.  If paramValue1 is
   greater that paramValue2 then GREATERTHAN will be returned.               *)

function SubstringCompare(var paramValue1;
                          var paramValue2) : Comparison;


(* This routine will check to see if the substring passed in as paramValue1
   is contained in the string passed in as paramValue2.  It will return TRUE
   if paramValue1 is contained in paramValue2 and FALSE otherwise.           *)

function ContainsSubstring(var paramValue1;
                           var paramValue2) : Boolean;


(* This routine will check to see if the substring passed in as paramValue1
   is contained in the string passed in as paramValue2 at the location in
   paramValue2 specified by position.  In other words, it looks for a partial
   string match at one particular location within the target string.  It will
   return TRUE if paramValue1 is contained in paramValue2 at the specified
   position and FALSE otherwise.                                              *)

function ContainsSubstringAtPosition(var paramValue1;
                                     var paramValue2;
                                     position : Byte) : Boolean;

(*\*)
(* This routine will check to see if the substring passed in as paramValue1
  starts the string passed in as paramValue2.  It will return TRUE if
  paramValue1 starts paramValue2 and FALSE otherwise.                        *)


function StartsWithSubstring(var paramValue1;
                             var paramValue2) : Boolean;


(* This routine will check to see if the substring passed in as paramValue1
  ends the string passed in as paramValue2.  It will return TRUE if
  paramValue1 ends paramValue2 and FALSE otherwise.                          *)

function EndsWithSubstring(var paramValue1;
                           var paramValue2) : Boolean;

(*!*)
(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)

implementation

(* This routine will compare two values and return the result of the comparison.
   The result is of type Comparison and LESSTHAN, EQUALTO, or GREATERTHAN will
   be returned.  The values compared must be of the same type.  Legal types are
   those enumerated in the type ValueType.  The type of the values is passed in
   as a parameter along with the values.

   note : the values must reside in a variable since a var parameter is used.
   This is necessary since the address is needed to facilitate the use of this
   routine with multiple types.                                              *)

function CompareValues(var paramValue1;
                       var paramValue2;
                       vType : ValueType) : Comparison;

var
    byteValue1        : Byte     absolute paramValue1;
    byteValue2        : Byte     absolute paramValue2;
    shortIntValue1    : ShortInt absolute paramValue1;
    shortIntValue2    : ShortInt absolute paramValue2;
    integerValue1     : Integer  absolute paramValue1;
    integerValue2     : Integer  absolute paramValue2;
    longIntValue1     : LongInt  absolute paramValue1;
    longIntValue2     : LongInt  absolute paramValue2;
    wordValue1        : Word     absolute paramValue1;
    wordValue2        : Word     absolute paramValue2;
    stringValue1      : String   absolute paramValue1;
    stringValue2      : String   absolute paramValue2;
    realValue1        : Real     absolute paramValue1;
    realValue2        : Real     absolute paramValue2;
    singleValue1      : Single   absolute paramValue1;
    singleValue2      : Single   absolute paramValue2;
    doubleValue1      : Double   absolute paramValue1;
    doubleValue2      : Double   absolute paramValue2;
    extendedValue1    : Extended absolute paramValue1;
    extendedValue2    : Extended absolute paramValue2;
    compValue1        : Comp     absolute paramValue1;
    compValue2        : Comp     absolute paramValue2;
    byteArrayValue1   : ByteArray absolute paramValue1;
    byteArrayValue2   : ByteArray absolute paramValue2;

    cnt : ByteArrayRange;

    begin
    case vType of
        BYTEVALUE :
            begin
            if byteValue1 < byteValue2 then CompareValues := LESSTHAN
            else if byteValue1 = byteValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        SHORTINTVALUE :
            begin
            if shortIntValue1 < shortIntValue2 then CompareValues := LESSTHAN
            else if shortIntValue1 = shortIntValue2 then CompareValues :=EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        INTEGERVALUE :
            begin
            if integerValue1 < integerValue2 then CompareValues := LESSTHAN
            else if integerValue1 = integerValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        LONGINTVALUE :
            begin
            if longIntValue1 < longIntValue2 then CompareValues := LESSTHAN
            else if longIntValue1 = longIntValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        WORDVALUE :
            begin
            if wordValue1 < wordValue2 then CompareValues := LESSTHAN
            else if wordValue1 = wordValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        STRINGVALUE:
            begin
            if stringValue1 < stringValue2 then CompareValues := LESSTHAN
            else if stringValue1 = stringValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        REALVALUE :
            begin
            if realValue1 < realValue2 then CompareValues := LESSTHAN
            else if realValue1 = realValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
(*   The following types are only for 8087 - and are compiled only if the unit
     is compiled using {$N+}                                                 *)

{$IFOPT N+}
        SINGLEVALUE :
            begin
            if singleValue1 < singleValue2 then CompareValues := LESSTHAN
            else if singleValue1 = singleValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        DOUBLEVALUE :
            begin
            if doubleValue1 < doubleValue2 then CompareValues := LESSTHAN
            else if doubleValue1 = doubleValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        EXTENDEDVALUE :
            begin
            if extendedValue1 < extendedValue2 then CompareValues := LESSTHAN
            else if extendedValue1 = extendedValue2 then CompareValues :=EQUALTO
            else CompareValues := GREATERTHAN;
            end;
        COMPVALUE :
            begin
            if compValue1 < compValue2 then CompareValues := LESSTHAN
            else if compValue1 = compValue2 then CompareValues := EQUALTO
            else CompareValues := GREATERTHAN;
            end;
{$ENDIF}

        (* the following type was added in version 1.4 *)
        BYTEARRAYVALUE :
            begin
            cnt := 1;
            while TRUE do
                begin
                if byteArrayValue1[0] < cnt then
                    begin
                    if byteArrayValue2[0] < cnt then
                        begin
                        CompareValues := EQUALTO;
                        end
                    else
                        begin
                        CompareValues := LESSTHAN;
                        end;
                    Exit;
                    end;
                if byteArrayValue2[0] < cnt then
                    begin
                    CompareValues := GREATERTHAN;
                    Exit;
                    end;
                if byteArrayValue1[cnt] < byteArrayValue2[cnt] then
                    begin
                    CompareValues := LESSTHAN;
                    Exit;
                    end;
                if byteArrayValue1[cnt] > byteArrayvalue2[cnt] then
                    begin
                    CompareValues := GREATERTHAN;
                    Exit;
                    end;
                if cnt = MAXBYTE then
                    begin
                    CompareValues := EQUALTO;
                    Exit;
                    end;
                Inc(cnt);
                end;
            end;
      end;                                        (* end of case statement *)
    end;                                     (* end of CompareValues routine *)

(*\*)
(* This routine will compare two values of type STRINGVALUE and look for a
   partial match.  The first parameter (paramValue1) contains a substring which
   will be searched for in paramValue2.  The search is only to see if
   paramValue2 starts with substring paramValue1.  If paramValue2 starts with
   paramValue1 then EQUALTO will be returned.  Otherwise if paramValue1 is
   less that paramValue2 then LESSTHAN will be returned.  If paramValue1 is
   greater that paramValue2 then GREATERTHAN will be returned.               *)

function SubstringCompare(var paramValue1;
                          var paramValue2) : Comparison;

var
    stringValue1 : String   absolute paramValue1;
    stringValue2 : String   absolute paramValue2;

    begin
    if Pos(stringValue2,stringValue1) = 1 then
        begin
        SubstringCompare := EQUALTO;
        end
    else
        begin
        if stringValue1 < stringValue2 then
            begin
            SubstringCompare := LESSTHAN;
            end
        else
            begin
            SubstringCompare := GREATERTHAN;
            end;
        end;
    end;                                  (* end of SubstringCompare routine *)

(*\*)
(* This routine will check to see if the substring passed in as paramValue1
   is contained in the string passed in as paramValue2.  It will return TRUE
   if paramValue1 is contained in paramValue2 and FALSE otherwise.           *)

function ContainsSubstring(var paramValue1;
                           var paramValue2) : Boolean;

var
    stringValue1 : String   absolute paramValue1;
    stringValue2 : String   absolute paramValue2;

    begin
    if Pos(stringValue1,stringValue2) > 0 then
        begin
        ContainsSubstring := TRUE;
        end
    else
        begin
        ContainsSubstring := FALSE;
        end;
    end;                                 (* end of ContainsSubstring routine *)


(* This routine will check to see if the substring passed in as paramValue1
   is contained in the string passed in as paramValue2 at the location in
   paramValue2 specified by position.  In other words, it looks for a partial
   string match at one particular location within the target string.  It will
   return TRUE if paramValue1 is contained in paramValue2 at the specified
   position and FALSE otherwise.                                              *)

function ContainsSubstringAtPosition(var paramValue1;
                                     var paramValue2;
                                     position : Byte) : Boolean;

var
    stringValue1 : String   absolute paramValue1;
    stringValue2 : String   absolute paramValue2;
    tempString   : String;

    begin
    tempString := Copy(stringValue2,position,Length(stringValue1));
    if stringValue1 = tempString then
        begin
        ContainsSubstringAtPosition := TRUE;
        end
    else
        begin
        ContainsSubstringAtPosition := FALSE;
        end;
    end;                       (* end of ContainsSubstringAtPosition routine *)

(*\*)
(* This routine will check to see if the substring passed in as paramValue1
  starts the string passed in as paramValue2.  It will return TRUE if
  paramValue1 starts paramValue2 and FALSE otherwise.                        *)

function StartsWithSubstring(var paramValue1;
                             var paramValue2) : Boolean;

var
    stringValue1 : String   absolute paramValue1;
    stringValue2 : String   absolute paramValue2;

    begin
    if Pos(stringValue1,stringValue2) = 1 then
        begin
        StartsWithSubstring := TRUE;
        end
    else
        begin
        StartsWithSubstring := FALSE;
        end;
    end;                                (* end of StartsWithSubstring routine *)


(* This routine will check to see if the substring passed in as paramValue1
  ends the string passed in as paramValue2.  It will return TRUE if
  paramValue1 ends paramValue2 and FALSE otherwise.                          *)

function EndsWithSubstring(var paramValue1;
                           var paramValue2) : Boolean;

var
    stringValue1 : String   absolute paramValue1;
    stringValue2 : String   absolute paramValue2;
    tempString   : String;

    begin
    tempString := Copy(stringValue2,
                       (Length(stringValue2) - Length(stringValue1)) + 1,
                       Length(stringValue1));
    if stringValue1 = tempString then
        begin
        EndsWithSubstring := TRUE;
        end
    else
        begin
        EndsWithSubstring := FALSE;
        end;
    end;                                 (* end of EndsWithSubstring routine *)

end.                                                  (* end of Compare unit *)