home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / handson / archive / Issue149 / delphi / copydelp.exe / StrPrj / STRUTILS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1998-11-27  |  5.3 KB  |  182 lines

  1. unit Strutils;
  2. { string handling procedures for Pascal-style strings -
  3.   compatible with all versions of Delphi }
  4.  
  5. interface
  6. uses Classes;   { this unit defines TStringList }
  7.  
  8. const
  9.    TAB = #08;
  10.    CR  = #13;
  11.    LF  = #10;
  12.    CRLF = CR + LF;
  13.    SEPARATORS = [' ', '.', ',', '!', '?',';',':', TAB ];
  14.    LOWCHARS = ['a'..'z'];
  15.    UPCHARS = ['A'..'Z'];
  16.  
  17. type
  18.    charSet = set of char;
  19.  
  20. function LowCase( c : char ) : char;
  21.     { return lowercase version of char c                }
  22. function ChangeCase( const s : string ) : string;
  23.     { return toggled-case version of string s           }
  24. function removeLeadChars( const s : string;  chars : charSet  ) : string;
  25.     { trim chars from Left of String s                  }
  26. function removeTrailingChars( const s : string; chars : charSet ) : string;
  27.     { trim chars from Right of String s                 }
  28. function trimLeftStr( const s : string ) : string;
  29.    { remove leading SEPARATORS from string 's'          }
  30. function trimRightStr( const s : string ) : string;
  31.    { remove trailing SEPARATORS from string 's'         }
  32. function trimEndsStr( const s : string ) : string;
  33.    { trim SEPARATORS from both left and right of string }
  34. procedure firstrestStr( const s : string; var first, rest : string );
  35.    { parse s into 1st word first and remainder rest     }
  36. function encrypt( const s : string; cryptint : integer ) : string;
  37.    { encrypt a string by doing maths using cryptint     }
  38. function decrypt( const s : string; cryptint : integer ) : string;
  39.    { decrypt a string by doing maths using cryptint     }
  40. procedure parse( const s : string; slist : TStringList );
  41.    { parse string, s, into individual words in slist    }
  42.  
  43. implementation
  44.  
  45. function LowCase( c : char ) : char;
  46. begin
  47.   if (c in UPCHARS) then
  48.      Result := Chr(Ord(c) + 32)
  49.   else Result := c;
  50. end;
  51.  
  52. function ChangeCase( const s : string ) : string;
  53. { changes all lowercase chars to uppercase and vice versa }
  54. var
  55.    i : integer;
  56.    s2 : string;
  57. begin
  58.    s2 := '';
  59.    for i := 1 to Length( s ) do
  60.       if (s[i] in LOWCHARS) then
  61.          s2 := s2 + UpCase( s[i] )
  62.       else s2 := s2 + LowCase( s[i] );
  63.    Result := s2;
  64. end;
  65.  
  66. function removeLeadChars( const s : string;  chars : charSet  ) : string;
  67.    { trims string 's' by removing chars in charSet 'chars'
  68.    e.g. charSet might be [' ', '.' ]. So if s = ' .hello'
  69.    this function would return: 'hello'.
  70.  
  71.    N.B. The Constant MAXINT is used to define the string
  72.    length to the Copy function since, as Delphi Help states:
  73.      "If Count specifies more characters than are available,
  74.      the only the characters from S[Index] to the end of S are returned."
  75.    MAXINT contains the largest possible Integer}
  76. var
  77.    i : integer;
  78. begin
  79.    i := 1;
  80.    if not (Length(s) = 0) then
  81.    while (s[i] in chars) do
  82.        inc(i);
  83.    Result := Copy( s, i, MAXINT );
  84. end;
  85.  
  86. function removeTrailingChars( const s : string; chars : charSet ) : string;
  87. var
  88.    i : integer;
  89. begin
  90.    i := length(s);
  91.        { count backward from end of characters found in charSet }
  92.    if not (Length(s) = 0) then
  93.    while (s[i] in chars) and (i <> 0 ) do
  94.        dec(i);
  95.        { then return a copy of the string minus the unwanted trailing chars }
  96.    Result := copy(s, 1, i);
  97. end;
  98.  
  99.  
  100. function trimLeftStr( const s : string ) : string;
  101. { remove leading separators from string 's' }
  102. begin
  103.    trimLeftStr := removeLeadChars( s, SEPARATORS );
  104. end;
  105.  
  106. function trimRightStr( const s : string ) : string;
  107. { remove trailing separators from string 's' }
  108. begin
  109.    trimRightStr := removeTrailingChars( s, SEPARATORS );
  110. end;
  111.  
  112. function trimEndsStr( const s : string ) : string;
  113. { trim separators from both left and right of string }
  114. begin
  115.    trimEndsStr := trimLeftStr(trimRightStr(s));
  116. end;
  117.  
  118. procedure firstrestStr( const s : string; var first, rest : string );
  119. { Given a string, 's', parse out the first word as 'first' and
  120.   leave the remainder of the string untouched as 'rest' }
  121. var
  122.    i : integer;
  123.    s2 : string;
  124. begin
  125.    i := 1;
  126.    first := '';
  127.    rest := '';
  128.    s2 := trimLeftStr( s );
  129.    if not (Length(s2) = 0) then
  130.    while not (s2[i] in SEPARATORS) and not (i > Length( s2 ) ) do
  131.        inc(i);
  132.    first := copy( s2, 1, i-1 );
  133.    rest := copy(s2, i, MAXINT );
  134. end;
  135.  
  136. function encrypt( const s : string; cryptint : integer ) : string;
  137. var
  138.    i : integer;
  139.    s2 : string;
  140. begin
  141.   s2 := '';
  142.   if not ( Length(s) = 0 ) then
  143.   for i := 1 to Length( s ) do
  144.     s2 := s2 + Chr(Ord( s[i] ) + cryptint );
  145.   Result := s2;
  146. end;
  147.  
  148. function decrypt( const s : string; cryptint : integer ) : string;
  149. var
  150.    i : integer;
  151.    s2 : string;
  152. begin
  153.   s2 := '';
  154.   if not ( Length(s) = 0 ) then
  155.   for i := 1 to Length( s ) do
  156.      s2 := s2 + Chr(Ord( s[i] ) - cryptint );
  157.   Result := s2;
  158. end;
  159.  
  160. procedure parse( const s : string; slist : TStringList );
  161. { parse s into a series of tokens (e.g. individual words) and
  162.   return these in slist.
  163.  
  164.   IMPORTANT: It is the responsibility of the calling
  165.   code to create a valid TStringList object and to free
  166.   it upon completion! }
  167. var
  168.    s2, f, r : string;
  169. begin
  170.    s2 := TrimEndsStr(s);
  171.      { loop through string, until there are no more words to be parsed }
  172.    while s2 <> '' do
  173.    begin
  174.      firstrestStr(s2, f, r );   { parse 1st word, f, from string }
  175.      slist.Add(f);
  176.      s2 := r;
  177.    end;
  178. end;
  179.  
  180.  
  181. end.
  182.