home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / A / BYTETURB.ARC / STRINGS.LIB < prev    next >
Text File  |  1989-09-27  |  2KB  |  96 lines
  1.  
  2.  
  3. {$R-} { turn off range checking (if on) }
  4. {$V-} { turn off string parm length checking }
  5.  
  6. {
  7.         procedures and functions in this library
  8.  
  9.   LowToUp            converts string to uppercase
  10.   Strip              removes any leading characters
  11.   Parse              gets next word out of string
  12.   Replace            replaces all instance of one substring with another
  13.  
  14. }
  15.  
  16. type
  17.   bigstr             = string[255];
  18.   setofchar          = set of char;
  19.  
  20. procedure lowtoup(var tstr : bigstr);
  21. {
  22.        purpose       converts TStr to all upper case
  23.        last update   23 Jun 85
  24. }
  25. var
  26.   len,indx           : integer;
  27. begin
  28.   len := length(tstr);
  29.   for indx := 1 to len do
  30.     tstr[indx] := upcase(tstr[indx])
  31. end; { of proc LowToUp }
  32.  
  33. procedure strip(var line : bigstr; var len : integer; break : setofchar);
  34. {
  35.        purpose       pull out all chars in Break from start of Line
  36.        last update   09 Jul 85
  37. }
  38. var
  39.   indx               : integer;
  40. begin
  41.   len := length(line);
  42.   if len > 0 then begin
  43.     indx := 0;
  44.     while (line[indx+1] in break) and (indx < len) do
  45.       indx := indx + 1;
  46.     delete(line,1,indx);
  47.     len := len - indx;
  48.   end
  49. end; { of proc Strip }
  50.  
  51. procedure parse(var line,word : bigstr; break : setofchar);
  52. {
  53.        purpose       removes first word in Line and returns it in Word
  54.        last update   23 Jun 85
  55. }
  56. var
  57.   len,indx           : integer;
  58. begin
  59.   word := '';
  60.   strip(line,len,break);
  61.   if len = 0
  62.     then exit;
  63.   indx := 0;
  64.   while not (line[indx+1] in break) and (indx < len) do
  65.     indx := indx + 1;
  66.   word := copy(line,1,indx);
  67.   delete(line,1,indx);
  68.   strip(line,len,break)
  69. end; { of proc Parse }
  70.  
  71. procedure replace(var target : bigstr; oldstr,newstr : bigstr; maxlen : byte);
  72. {
  73.        purpose       look for all instances of OldStr and replace with NewStr
  74.        last update   09 Jul 85
  75. }
  76. var
  77.   tarlen,oldlen,inclen,indx
  78.                      : integer;
  79. begin
  80.   tarlen := length(target);
  81.   oldlen := length(oldstr);
  82.   inclen := length(newstr) - oldlen;
  83.   indx := pos(oldstr,target);
  84.   while indx > 0 do begin
  85.     if tarlen + inclen <= maxlen then begin
  86.       delete(target,indx,oldlen);
  87.       insert(newstr,target,indx);
  88.       tarlen := tarlen + inclen;
  89.       indx := pos(oldstr,target)
  90.     end
  91.     else indx := 0
  92.   end
  93. end; { of proc Replace }
  94.  
  95.  tarlen := tarlen + inclen;
  96.       indx := pos(oldstr,t