home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST0425.ASM < prev    next >
Encoding:
Assembly Source File  |  1989-07-31  |  3.9 KB  |  157 lines
  1. {$S-,R-,V-}
  2. Unit Tools;
  3.  
  4. Interface
  5.  
  6. Uses
  7.   DOS;
  8.  
  9. Const
  10.   _EQUAL_          = 0;
  11.  
  12.  
  13. Type
  14.   Str3 = String[3];
  15.   Str80 = String[80];
  16.   Path = String[70];
  17.  
  18. Function UpperCase( S : String ) : String;
  19.  
  20. Function CompMem( Var Block1,Block2; Size : Word ) : Word;
  21. {
  22.  return 0 if Block1 and Block2 are equal for Size bytes
  23.  if not equal, return the position of first non matching byte
  24.  the first byte is considered to be 1
  25. }
  26.  
  27. Function ExpandTabs( Var S : String ) : String;
  28. { expands each tab into a single space. Used before parsing }
  29.  
  30. Function Trim( Var S : String ) : String;
  31. { FAST assembly language Trim routine, trims leading and trailing }
  32.  
  33. Function SearchBlock( Var FindStr; FindSize : Word; Var Block;
  34.             BlockSize : Word ) : Word;
  35. { generic Block search routine.  Takes untyped VAR parameters }
  36.  
  37. Procedure ReplaceString( StrToFind,StrToRep : Str80; Var S : String );
  38. { Finds StrToFind and replaces it with StrToRep in string S. }
  39. { ignores case when searching for the string to replace.     }
  40.  
  41. Function RightStr( S : String; Number : Word ) : String;
  42. { returns all characters to the right of character Number }
  43.  
  44. Function ParseWord( Var S : String; DelimChar : Char ) : String;
  45. { parses input string S up to the first occurance of DelimChar. }
  46. { The parsed string is returned, and chopped out of the string S}
  47. { see WordOnLine implementation for sample use of ParseWord     }
  48.  
  49. Function WordOnLine( Var The_Word,The_Line : String ) : Boolean;
  50. { returns TRUE if The_Word appears on The_Line }
  51.  
  52. Function FileExt( PName : Path; Extension : Str3 ) : Path;
  53. { force a file extension }
  54.  
  55. Function InKey( Var ScanCode : Byte ) : Char;
  56. { return character and scancode with a single call }
  57.  
  58. Implementation
  59.  
  60. { the external Assembly language routines: }
  61.  
  62. {$L UCASE.OBJ}
  63. {$L MEMCOMP.OBJ}
  64. {$L EXPTABS.OBJ}
  65. {$L TRIM.OBJ}
  66. {$L SEARCH.OBJ}
  67. {$L PARSE.OBJ}
  68. {$L INKEY.OBJ}
  69. {$L RIGHTSTR.OBJ}
  70.  
  71. Function UpperCase( S : String ) : String; External;
  72.  
  73. Function CompMem( Var Block1,Block2; Size : Word ) : Word; External;
  74.  
  75. Function ExpandTabs( Var S : String ) : String; External;
  76.  
  77. Function Trim( Var S : String ) : String; External;
  78.  
  79. Function SearchBlock( Var FindStr; FindSize : Word; Var Block;
  80.             BlockSize : Word ) : Word; External;
  81.  
  82. Function ParseWord( Var S : String; DelimChar : Char ) : String; External;
  83.  
  84. Function InKey( Var ScanCode : Byte ) : Char; External;
  85.  
  86. Function RightStr( S : String; Number : Word ) : String; External;
  87.  
  88. Procedure ReplaceString( StrToFind,StrToRep : Str80; Var S : String );
  89.  
  90. Var
  91.   L,P : Word;
  92.   SS : String; {scratch string }
  93.   STF,STR : Str80;
  94.  
  95. Begin
  96.   SS := UpperCase( S ); {use the scratch string }
  97.   STF := UpperCase( StrToFind );
  98.   STR  := UpperCase( StrToRep );
  99.   L := Length( SS );
  100.   P := SearchBlock( STF[1],Length(STF),SS[1],L );
  101.  
  102.   If P > 0 Then
  103.   Begin
  104.     Delete(S,P,Length(StrToFind));
  105.     If Length( StrToRep ) > 0 Then
  106.       Insert( StrToRep,S,P );
  107.   End;
  108.  
  109. End;
  110.  
  111. Function WordOnLine( Var The_Word,The_Line : String ) : Boolean;
  112. { returns TRUE if The_Word appears on The_Line }
  113.  
  114. Var
  115.   S : String; {scratch string }
  116.   Wrd : Str80;  { the parsed word }
  117.  
  118. Begin
  119.   S := Trim( The_Line );
  120.   While( Length( S ) > 0 ) Do
  121.   Begin
  122.     Wrd := ParseWord( S,' ' );
  123.     S := Trim( S );
  124.     If CompMem( Wrd,The_Word,
  125.                Succ( Length( Wrd ) ) ) = _EQUAL_ Then
  126.     Begin
  127.       WordOnLine := TRUE;
  128.       Exit;
  129.     End;
  130.   End;
  131.   WordOnLine := FALSE;
  132. End;
  133.  
  134. Function FileExt( PName : Path; Extension : Str3 ) : Path;
  135.  
  136. Var
  137.   Position,L       : Word;
  138.  
  139.   PathName         : Path;
  140.  
  141. Const
  142.   Period           : String[1] = '.';
  143.  
  144. Begin
  145.   PathName := PName;
  146.   Position := Pos( Period,PathName );
  147.   If Position > 0 Then
  148.   Begin
  149.     L := Length( PathName );
  150.     PathName[0] := Char( L - Succ( L - Position ) );
  151.   End;
  152.   FileExt := PathName + '.' + Extension;
  153. End;
  154.  
  155. End.
  156.  
  157.