home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / UTILS / STRINGS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-02-15  |  13KB  |  503 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira System Library 1.0                           }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit Strings;
  10.  
  11. interface
  12.  
  13. uses Classes;
  14.  
  15. const
  16.   Uppers = ['A'..'Z'];
  17.   Lowers = ['a'..'z'];
  18.   Alphas = Uppers + Lowers;
  19.   Digits = ['0'..'9'];
  20.   AlphaDigits = Alphas + Digits;
  21.  
  22.   OneItem : array[Boolean] of string[2] = ('s', '');
  23.  
  24. type
  25.   TAttrStr = string[5];
  26.  
  27.   TUniqueStrings = class(TStringList)
  28.     constructor Create;
  29.   end;
  30.  
  31. function LowCase(c : Char) : Char;
  32. { converts a character to lower case }
  33.  
  34. function InString(c: char; const s: string) : Boolean;
  35. { Returns true if a character is present in a string.
  36.   Probably faster than Pos. }
  37.  
  38. function CharCount(c: Char; const S: string): Integer;
  39. { Returns the number of occurences of c in S }
  40.  
  41. function Blank(const s: string): boolean;
  42. { Returns true if the string is empty or consists of spaces }
  43.  
  44. function MakePath(const s: string): string;
  45. { Adds a trailing backslash to a directory name, if necessary }
  46.  
  47. function MakeDirname(const s: string): string;
  48. { Removes a trailing backslash from a directory name, if necessary }
  49.  
  50. function ExtractFileDir(const s: string): string;
  51. { Calls MakeDirname after calling ExtractFilePath }
  52.  
  53. function FormatByte(size : Longint): string;
  54. { Formats a number (assumed to be bytes) to display as bytes,
  55.   KB or MB, for example "245 bytes", "1.60KB", "44.10MB" }
  56.  
  57. function GetStrKey(const s: string): string;
  58. function GetStrValue(const s: string): string;
  59. { Returns the left and right sides, respectively, of a string with the
  60.   structure Key=Value }
  61.  
  62. function SetStrValue(const s, value: string): string;
  63. { If s contains an '=', the portion to the right of '=' is set
  64.   to the value }
  65.  
  66. function FillString(c: char; n: Byte): string;
  67. { Returns a string of length n containing only the specified character }
  68.  
  69. function Unformat(const source, pattern: string; const args: array of const): Integer;
  70. { The opposite of Format, Unformat splits up a formatted source string
  71.   into substrings and Integers.  It is an alternative to parsing when
  72.   the format is known to be fixed.  The pattern parameter contains the format
  73.   string, which is a combination of plain characters and format specifiers.
  74.  
  75.   The following specifiers are supported:
  76.  
  77.   %s   indicates that a string value is required
  78.   %d   indicates that an integer value is required
  79.   %S   indicates that a string value should be ignored
  80.   %D   indicates that an integer value should be ignored
  81.  
  82.   Unformat compares the source with the pattern, and plain characters
  83.   that do not match will raise an EConvertError.  When a format specifier
  84.   is encountered in the pattern, an argument is fetched and used to
  85.   store the result that is obtained from the source.  Then the comparison
  86.   continues.
  87.  
  88.   For each %s, the args list must contain a pointer to a string variable,
  89.   followed by an integer specifying the maximum length of the string.
  90.   For each %d, the args list must contain a pointer to an integer variable.
  91.  
  92.   When the end of the source string is reached, the function returns
  93.   without modifying the remaining arguments, so you might wish to initialize
  94.   your variables to "default" values before the function call.
  95.  
  96.   Unformat returns the number of values it has extracted.
  97.  
  98.   Examples:
  99.  
  100.   var
  101.     s1, s2: string[31];
  102.     i : Integer;
  103.  
  104.   Unformat('[abc]123(def)', '[%s]%d(%s)', [@s1, 31, @i, @s2, 31]);
  105.     (* s1 = 'abc', i = 123, s2 = 'def' *)
  106.  
  107.   Unformat('Hello, Universe!!!', '%s, %s%d', [@s1, 31, @s2, 31, @i]);
  108.     (* s1 = 'Hello', s2 = 'Universe!!!', i is untouched *)
  109.  
  110.   Unformat('How much wood could a woodchuck chuck...',
  111.            '%S %S %s could a %S %s...', [@s1, 31, @s2, 31]);
  112.     (* s1 = 'wood', s2 = 'chuck' *)
  113. }
  114.  
  115.  
  116. function FileParams(files: TStrings): string;
  117. { Assumes that the strings parameter contains a list of filename, and
  118.   concatenates the names to form a single string suitable for passing
  119.   as a command line parameter.  Filenames with no extension have an
  120.   extra '.' appended to ensure correct interpretation }
  121.  
  122. function GetWord(var s: OpenString): string;
  123. { Skips spaces and returns the next word in a string.  The word
  124.   is deleted from the string }
  125.  
  126. function StringAsPChar(var s: OpenString): PChar;
  127. { Modifies a string so that it can be used as a PChar without additional
  128. }
  129.  
  130. function AttrToStr(attr : Integer): TAttrStr;
  131. function LTrim(const s: string): string;
  132. function RTrim(const s: string): string;
  133. function Trim(const s: string): string;
  134.  
  135.  
  136.  
  137. implementation
  138.  
  139. uses SysUtils, MiscUtil, WinTypes;
  140.  
  141. constructor TUniqueStrings.Create;
  142. begin
  143.   inherited Create;
  144.   Sorted := True;
  145.   Duplicates := dupIgnore;
  146. end;
  147.  
  148.  
  149. function LowCase(c : Char) : Char; assembler;
  150. asm
  151.       MOV    AL, c
  152.       CMP    AL, 'A'
  153.       JB     @Finish
  154.       CMP    AL, 'Z'
  155.       JA     @Finish
  156.       ADD    AL, 32
  157. @Finish:
  158. end;
  159.  
  160.  
  161. function InString(c: Char; const s: string): Boolean; assembler;
  162. asm
  163.       XOR     AH,AH
  164.       LES     DI,s
  165.       MOV     AL,ES:[DI]
  166.       INC     DI
  167.       MOV     CH,AH
  168.       MOV     CL,AL
  169.       MOV     AL,c
  170.       CLD
  171.       REPNE   SCASB
  172.       JNE     @@1
  173.       INC     AH
  174. @@1:  MOV     AL,AH
  175. end;
  176.  
  177.  
  178. function CharCount(c: Char; const S: string): Integer; assembler;
  179. asm
  180.       XOR     AH,AH
  181.       LES     DI,S
  182.       MOV     AL,ES:[DI]
  183.       INC     DI
  184.       MOV     CX, AX
  185.       MOV     AL,c
  186.       CLD
  187. @@1:  REPNE   SCASB
  188.       JNE     @@2
  189.       INC     AH
  190.       JMP     @@1
  191. @@2:  MOV     AL,AH
  192.       XOR     AH,AH
  193. end;
  194.  
  195.  
  196. function Blank(const s: string): boolean; assembler;
  197. asm
  198.       LES     DI, s
  199.       SUB     CX, CX
  200.       MOV     CL, BYTE PTR ES:[DI]
  201.       JCXZ    @@1
  202.       INC     DI
  203.       CLD
  204.       MOV     AL, 32
  205.       REP     SCASB
  206.       JZ      @@1
  207.       MOV     AL, False
  208.       JMP     @@2
  209. @@1:  MOV     AL, True
  210. @@2:
  211. end;
  212.  
  213.  
  214. function MakePath(const s: string): string;
  215. begin
  216.   Result := s;
  217.   if Result[Length(Result)] <> '\' then AppendStr(Result, '\');
  218. end;
  219.  
  220.  
  221. function MakeDirname(const s: string): string;
  222. begin
  223.   Result := s;
  224.   if (Length(Result) <> 3) and (Result[Length(Result)] = '\') then
  225.     Dec(Result[0]);
  226. end;
  227.  
  228. function ExtractFileDir(const s: string): string;
  229. begin
  230.   Result := ExtractFilePath(s);
  231.   if (Length(Result) <> 3) and (Result[Length(Result)] = '\') then
  232.     Dec(Result[0]);
  233. end;
  234.  
  235.  
  236.  
  237.  
  238. function FillString(c: char; n: Byte): string; assembler;
  239. asm
  240.       MOV CL, n
  241.       XOR CH, CH
  242.       LES DI, @result
  243.       MOV BYTE PTR ES:[DI], CL
  244.       INC DI
  245.       MOV AL, c
  246.       CLD
  247.       REP STOSB
  248. end;
  249.  
  250.  
  251. function GetStrKey(const s: string): string;
  252. var i: Integer;
  253. begin
  254.   Result := s;
  255.   i := Pos('=', Result);
  256.   if i > 0 then Result[0] := Chr(i-1);
  257. end;
  258.  
  259.  
  260. function GetStrValue(const s: string): string;
  261. var i: Integer;
  262. begin
  263.   i := Pos('=', s);
  264.   if i = 0 then Result := '' else Result := Copy(s, i+1, Length(s)-i);
  265. end;
  266.  
  267.  
  268. function SetStrValue(const s, value: string): string;
  269. var i: Integer;
  270. begin
  271.   i := Pos('=', s);
  272.   if i = 0 then Result := s + '=' + value
  273.   else Result := Copy(s, 1, i-1) + '=' + value;
  274. end;
  275.  
  276.  
  277. function FormatByte(size : Longint): string;
  278. begin
  279.    {
  280.    if size < 1024 then
  281.       if size = 1 then Result := '1 byte'
  282.       else Result := IntToStr(size) + ' bytes'
  283.    else if size < 1048576 then
  284.       Result := FloatToStrF(size / 1024, ffNumber, 7, 2) + 'KB'
  285.    else
  286.       Result := FloatToStrF(size / 1048576, ffNumber, 7, 2) + 'MB';
  287.    }
  288.    if size < 1024 then
  289.       if size = 1 then Result := '1 byte'
  290.       else Result := Format('%d bytes', [size])
  291.    else if size < 1048576 then
  292.       Result := Format('%.2n KB', [size / 1024])
  293.    else
  294.       Result := Format('%.2n MB', [size / 1048576]);
  295. end;
  296.  
  297.  
  298. function Unformat(const source, pattern: string; const args: array of const): Integer;
  299. var
  300.   i, j, argindex, start, finish, maxlen: Integer;
  301.   c : Char;
  302. begin
  303.   Result := 0;
  304.   argindex := 0;
  305.   i := 1;
  306.   j := 1;
  307.   while (i < Length(pattern)) and (j <= Length(source)) do begin
  308.  
  309.     if pattern[i] = '%' then
  310.       case pattern[i+1] of
  311.        'D' : begin
  312.                Inc(i, 2);
  313.                while (j <= Length(source)) and
  314.                  ((source[j] in Digits) or (source[j] = '-')) do Inc(j);
  315.                Inc(Result);
  316.              end;
  317.  
  318.        'S' : begin
  319.                Inc(i, 2);
  320.                if i > Length(pattern) then break
  321.                else begin
  322.                  c := pattern[i];
  323.                  while (j <= Length(source)) and (source[j] <> c) do
  324.                    Inc(j);
  325.                end;
  326.                Inc(Result);
  327.              end;
  328.  
  329.        'd' : begin
  330.                if argindex > High(args) then
  331.                  raise EConvertError.Create('Not enough arguments');
  332.                Inc(i, 2);
  333.                start := j;
  334.                while (j <= Length(source)) and
  335.                  ((source[j] in Digits) or (source[j] = '-')) do
  336.                  Inc(j);
  337.                finish := j;
  338.                if finish > start then
  339.                  PInteger(args[argindex].VPointer)^ :=
  340.                    StrToInt(Copy(source, start, finish - start));
  341.                Inc(argindex);
  342.                Inc(Result);
  343.              end;
  344.  
  345.        's' : begin
  346.                if argindex > High(args)-1 then
  347.                  raise EConvertError.Create('Not enough arguments');
  348.  
  349.                if args[argindex+1].VType <> vtInteger then
  350.                    raise EConvertError.Create('No string size specified');
  351.  
  352.                maxlen := args[argindex+1].VInteger;
  353.  
  354.                Inc(i, 2);
  355.                if i > Length(pattern) then begin
  356.                  args[argindex].VString^ :=
  357.                    Copy(source, j, Min(Length(source) + 1 - j, maxlen));
  358.                  Inc(argindex);
  359.                  break;
  360.                end
  361.                else begin
  362.                  c := pattern[i];
  363.                  start := j;
  364.                  while (j <= Length(source)) and (source[j] <> c) do
  365.                    Inc(j);
  366.                  finish := j;
  367.  
  368.                  args[argindex].VString^ := Copy(source, start,
  369.                    Min(finish - start, maxlen));
  370.                  Inc(argindex, 2);
  371.                end;
  372.                Inc(Result);
  373.              end;
  374.       else Inc(i);
  375.       end
  376.     else
  377.       if pattern[i] <> source[j] then
  378.         raise EConvertError.Create('Pattern mismatch!')
  379.       else begin
  380.         Inc(i);
  381.         Inc(j);
  382.       end;
  383.   end;
  384. end;
  385.  
  386.  
  387. function FileParams(files: TStrings): string;
  388. var
  389.   i: Integer;
  390. begin
  391.   Result := '';
  392.   i := 0;
  393.   while (i < files.Count) and (Length(Result) < 255) do begin
  394.     if Pos('.', files[i]) = 0 then AppendStr(Result, files[i] + '. ')
  395.     else AppendStr(Result, files[i] + ' ');
  396.     Inc(i);
  397.   end;
  398. end;
  399.  
  400.  
  401. function GetWord(var s: string): string;
  402. var i: Integer;
  403. begin
  404.   i := Pos(' ', s);
  405.   if i = 0 then begin
  406.     if Length(s) > 0 then begin
  407.       Result := s;
  408.       s := '';
  409.     end
  410.     else Result := '';
  411.   end
  412.   else begin
  413.     Result := Copy(s, 1, i-1);
  414.     while (i <= Length(s)) and (s[i] = ' ') do Inc(i);
  415.     Delete(s, 1, i-1);
  416.   end;
  417. end;
  418.  
  419.  
  420. function StringAsPChar(var s: OpenString): PChar;
  421. begin
  422.   Result := @s[1];
  423.   if Length(s) = High(s) then Dec(s[0]);
  424.   s[Length(s) + 1] := #0;
  425. end;
  426.  
  427.  
  428. function AttrToStr(attr : Integer): TAttrStr; assembler;
  429. asm
  430.      LES  DI, @Result
  431.      MOV  BX, DI
  432.      XOR  AX, AX
  433.      INC  DI
  434.      MOV  CX, attr
  435.  
  436.      MOV  DX, CX
  437.      AND  DX, faArchive
  438.      JZ   @@1
  439.      MOV  AL, 'a'
  440.      STOSB
  441.      INC  AH
  442.  
  443. @@1: MOV  DX, CX
  444.      AND  DX, faReadOnly
  445.      JZ   @@2
  446.      MOV  AL, 'r'
  447.      STOSB
  448.      INC  AH
  449.  
  450. @@2: MOV  DX, CX
  451.      AND  DX, faHidden
  452.      JZ   @@3
  453.      MOV  AL, 'h'
  454.      STOSB
  455.      INC  AH
  456.  
  457. @@3: MOV  DX, CX
  458.      AND  DX, faSysfile
  459.      JZ   @@4
  460.      MOV  AL, 's'
  461.      STOSB
  462.      INC  AH
  463.  
  464. @@4: MOV  DX, CX
  465.      AND  DX, faDirectory
  466.      JZ   @@5
  467.      MOV  AL, 'd'
  468.      STOSB
  469.      INC  AH
  470. @@5:
  471.      MOV  BYTE PTR ES:[BX], AH
  472. end;
  473.  
  474.  
  475. function LTrim(const s: string): string;
  476. var
  477.   i: Integer;
  478. begin
  479.   i := 1;
  480.   while (i <= Length(s)) and (s[i] = ' ') do Inc(i);
  481.   Result := Copy(s, i, 255);
  482. end;
  483.  
  484.  
  485. function RTrim(const s: string): string;
  486. var
  487.   i: Integer;
  488. begin
  489.   i := Length(s);
  490.   while (s[i] = ' ') do Dec(i);
  491.   Result := Copy(s, 1, i);
  492. end;
  493.  
  494.  
  495. function Trim(const s: string): string;
  496. begin
  497.   Result := LTrim(RTrim(s))
  498. end;
  499.  
  500.  
  501.  
  502. end.
  503.