home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / unity / d2345 / MASUTILS.ZIP / masutils.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-27  |  7KB  |  262 lines
  1. {***************************************************************
  2.  *
  3.  * Unit Name: masutils
  4.  * Purpose  : Utility routines
  5.  * Author   : Mats Asplund / Mas Prod.
  6.  *
  7.  * History  : 2001-06-26  Added CheckIfHex
  8.  *
  9.  ****************************************************************}
  10.  
  11. unit masutils;
  12.  
  13. interface
  14.  
  15. uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  16.      Registry;
  17.  
  18.  
  19. procedure CutOutStrs(Str, DelCh: string; var SStrs: TStringList);
  20. function HexToInt(HexStr: string): Integer;
  21. function CheckifHex(Str: string; ShowMsg: boolean): boolean;
  22. function GetAssociation(const FileName: string): string;
  23. function FindFile(const filespec: TFileName): TStringList;
  24. function Like(AString, Pattern: string; CaseSensitive: boolean): boolean;
  25. function IsDigit(ch: char): boolean;
  26. function IsUpper(ch: char): boolean;
  27. function IsLower(ch: char): boolean;
  28. function ToUpper(ch: char): char;
  29. function ToLower(ch: char): char;
  30. function Proper(const s: string): string;
  31.  
  32. implementation
  33.  
  34. //------------------------------------------------------------------------------
  35. procedure CutOutStrs(Str, DelCh: string; var SStrs: TStringList);
  36. begin
  37.   SStrs.Clear;
  38.   if Pos(DelCh, Str) = 0 then
  39.   begin
  40.     SStrs.Add(Str);
  41.     Exit;
  42.   end;
  43.   while Pos(DelCh, Str) <> 0 do
  44.   begin
  45.     SStrs.Add(Copy(Str, 1, Pos(DelCh, Str)-1));
  46.       Str:= Copy(Str, Pos(DelCh, Str)+1, Length(Str));
  47.   end;
  48.   SStrs.Add(Str);
  49. end;
  50. //------------------------------------------------------------------------------
  51. const Hex: array['A'..'F'] of Integer = (10, 11, 12, 13, 14, 15);
  52.  
  53. function HexToInt(HexStr: string): Integer;
  54. var
  55.   Int, n: Integer;
  56. begin
  57.   Int:= 0;
  58.   for n:= 1 to Length(HexStr) do
  59.   begin
  60.     if (HexStr[n] in ['0'..'9']) or (HexStr[n] in ['A'..'F']) then
  61.     begin
  62.       if HexStr[n] < 'A' then Int:= Int * 16 + Ord(HexStr[n]) - 48
  63.       else Int:= Int * 16 + Hex[HexStr[n]];
  64.     end
  65.     else
  66.     begin
  67.       Result:=-1;
  68.       Exit;
  69.     end;
  70.   end;
  71.   Result:= Int;
  72. end;
  73. //------------------------------------------------------------------------------
  74. function GetAssociation(const FileName: string): string;
  75. var
  76.   FileClass: string;
  77.   Reg: TRegistry;
  78. begin
  79.   Result := '';
  80.   Reg := TRegistry.Create(KEY_EXECUTE);
  81.   Reg.RootKey := HKEY_CLASSES_ROOT;
  82.   FileClass := '';
  83.   if Reg.OpenKeyReadOnly(ExtractFileExt(FileName)) then
  84.   begin
  85.     FileClass := Reg.ReadString('');
  86.     Reg.CloseKey;
  87.   end;
  88.   if FileClass <> '' then begin
  89.     if Reg.OpenKeyReadOnly(FileClass + '\Shell\Open\Command') then
  90.     begin
  91.       Result := Reg.ReadString('');
  92.       Reg.CloseKey;
  93.     end;
  94.   end;
  95.   Reg.Free;
  96. end;
  97. //------------------------------------------------------------------------------
  98. //FindFile
  99. //This function we show below receives as parameters a file
  100. //specification (like for example 'C:\My Documents\*.xls'
  101. //or 'C:\*' if you want to search the entire hard disk.)
  102. //and optionally a set of attributes (exactly as Delphi's
  103. //FindFirst function), and it returs a StringList with the
  104. //full pathnames of the found files. You should free the
  105. //StringList after using it.
  106.  
  107. function FindFile(const filespec: TFileName): TStringList;
  108. var
  109.   spec: string;
  110.   list: TStringList;
  111.  
  112. procedure RFindFile(const folder: TFileName);
  113. var
  114.   SearchRec: TSearchRec;
  115. begin
  116.   // Locate all matching files in the current
  117.   // folder and add their names to the list
  118.   if FindFirst(folder + spec, faAnyFile, SearchRec) = 0 then begin
  119.     try
  120.       repeat
  121.         if (SearchRec.Attr and faDirectory = 0) or
  122.            (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  123.           list.Add(folder + SearchRec.Name);
  124.       until FindNext(SearchRec) <> 0;
  125.     except
  126.       FindClose(SearchRec);
  127.       raise;
  128.     end;
  129.     FindClose(SearchRec);
  130.   end;
  131.   // Now search the subfolders
  132.   if FindFirst(folder + '*', faAnyFile, SearchRec) = 0 then
  133.   begin
  134.     try
  135.       repeat
  136.         if ((SearchRec.Attr and faDirectory) <> 0) and
  137.            (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  138.           RFindFile(folder + SearchRec.Name + '\');
  139.       until FindNext(SearchRec) <> 0;
  140.     except
  141.       FindClose(SearchRec);
  142.       raise;
  143.     end;
  144.     FindClose(SearchRec);
  145.   end;
  146. end; // procedure RFindFile inside of FindFile
  147.  
  148. begin // function FindFile
  149.   list := TStringList.Create;
  150.   try
  151.     spec := ExtractFileName(filespec);
  152.     RFindFile(ExtractFilePath(filespec));
  153.     Result := list;
  154.   except
  155.     list.Free;
  156.     raise;
  157.   end;
  158. end;
  159. //--------------------------------------------------------------------------------
  160. function Like(AString, Pattern: string; CaseSensitive: boolean): boolean;
  161. var
  162.   i, n, n1, n2: integer;
  163.   p1, p2: pchar;
  164. label
  165.   match, nomatch;
  166. begin
  167.   if not Casesensitive then
  168.   begin
  169.     AString := UpperCase(AString);
  170.     Pattern := UpperCase(Pattern);
  171.   end;
  172.   n1 := Length(AString);
  173.   n2 := Length(Pattern);
  174.   if n1 < n2 then n := n1 else n := n2;
  175.   p1 := pchar(AString);
  176.   p2 := pchar(Pattern);
  177.   for i := 1 to n do begin
  178.     if p2^ = '*' then goto match;
  179.     if (p2^ <> '?') and (p2^ <> p1^) then goto nomatch;
  180.     inc(p1); inc(p2);
  181.   end;
  182.   if n1 > n2 then begin
  183. nomatch:
  184.     Result := False;
  185.     exit;
  186.   end else if n1 < n2 then begin
  187.     for i := n1 + 1 to n2 do begin
  188.       if not (p2^ in ['*','?']) then goto nomatch;
  189.       inc(p2);
  190.     end;
  191.   end;
  192. match:
  193.   Result := True;
  194. end;
  195. //--------------------------------------------------------------------------------
  196. {To determine if the character is a digit.}
  197. function IsDigit(ch: char): boolean;
  198. begin
  199.   Result := ch in ['0'..'9'];
  200. end;
  201.  
  202. {To determine if the character is an uppercase letter.}
  203. function IsUpper(ch: char): boolean;
  204. begin
  205.   Result := ch in ['A'..'Z'];
  206. end;
  207.  
  208. {To determine if the character is an lowercase letter.}
  209. function IsLower(ch: char): boolean;
  210. begin
  211.   Result := ch in ['a'..'z'];
  212. end;
  213.  
  214. {Changes a character to an uppercase letter.}
  215. function ToUpper(ch: char): char;
  216. begin
  217.   Result := chr(ord(ch) and $DF);
  218. end;
  219.  
  220. {Changes a character to a lowercase letter.}
  221. function ToLower(ch: char): char;
  222. begin
  223.   Result := chr(ord(ch) or $20);
  224. end;
  225.  
  226. { Capitalizes first letter of every word in s }
  227. function Proper(const s: string): string;
  228. var
  229.   i: Integer;
  230.   CapitalizeNextLetter: Boolean;
  231. begin
  232.   Result := LowerCase(s);
  233.   CapitalizeNextLetter := True;
  234.   for i := 1 to Length(Result) do
  235.   begin
  236.     if CapitalizeNextLetter and IsLower(Result[i]) then
  237.       Result[i] := ToUpper(Result[i]);
  238.     CapitalizeNextLetter := Result[i] = ' ';
  239.   end;
  240. end;
  241. //--------------------------------------------------------------------------------
  242. function CheckifHex(Str: string; ShowMsg: boolean): boolean;
  243. var
  244.   n: integer;
  245.   ChrStr: PChar;
  246.   FStr: string;
  247. begin
  248.   Result:= true;
  249.   ChrStr:= PChar(Str);
  250.     for n:= 0 to Length(Str) - 1 do
  251.       if not (ChrStr[n] in ['0'..'9', 'a'..'f', 'A'..'F']) then
  252.       begin
  253.         FStr:= FStr + ' ' + IntToStr(n+1);
  254.         Result:= false;
  255.       end;
  256.   if ShowMsg and not Result then ShowMessage('Wrong character(-s) in position: ' + FStr);
  257. end;
  258. //--------------------------------------------------------------------------------
  259.  
  260. end.
  261.  
  262.