Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/unity/d2345/MASUTILS.ZIP/masutils.pas

Pascal/Delphi Source File | 2001-06-27 | 7.1 KB | 262 lines

{***************************************************************
 *
 * Unit Name: masutils
 * Purpose  : Utility routines
 * Author   : Mats Asplund / Mas Prod.
 *
 * History  : 2001-06-26  Added CheckIfHex
 *
 ****************************************************************}

unit masutils;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     Registry;


procedure CutOutStrs(Str, DelCh: string; var SStrs: TStringList);
function HexToInt(HexStr: string): Integer;
function CheckifHex(Str: string; ShowMsg: boolean): boolean;
function GetAssociation(const FileName: string): string;
function FindFile(const filespec: TFileName): TStringList;
function Like(AString, Pattern: string; CaseSensitive: boolean): boolean;
function IsDigit(ch: char): boolean;
function IsUpper(ch: char): boolean;
function IsLower(ch: char): boolean;
function ToUpper(ch: char): char;
function ToLower(ch: char): char;
function Proper(const s: string): string;

implementation

//------------------------------------------------------------------------------
procedure CutOutStrs(Str, DelCh: string; var SStrs: TStringList);
begin
  SStrs.Clear;
  if Pos(DelCh, Str) = 0 then
  begin
    SStrs.Add(Str);
    Exit;
  end;
  while Pos(DelCh, Str) <> 0 do
  begin
    SStrs.Add(Copy(Str, 1, Pos(DelCh, Str)-1));
      Str:= Copy(Str, Pos(DelCh, Str)+1, Length(Str));
  end;
  SStrs.Add(Str);
end;
//------------------------------------------------------------------------------
const Hex: array['A'..'F'] of Integer = (10, 11, 12, 13, 14, 15);

function HexToInt(HexStr: string): Integer;
var
  Int, n: Integer;
begin
  Int:= 0;
  for n:= 1 to Length(HexStr) do
  begin
    if (HexStr[n] in ['0'..'9']) or (HexStr[n] in ['A'..'F']) then
    begin
      if HexStr[n] < 'A' then Int:= Int * 16 + Ord(HexStr[n]) - 48
      else Int:= Int * 16 + Hex[HexStr[n]];
    end
    else
    begin
      Result:=-1;
      Exit;
    end;
  end;
  Result:= Int;
end;
//------------------------------------------------------------------------------
function GetAssociation(const FileName: string): string;
var
  FileClass: string;
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create(KEY_EXECUTE);
  Reg.RootKey := HKEY_CLASSES_ROOT;
  FileClass := '';
  if Reg.OpenKeyReadOnly(ExtractFileExt(FileName)) then
  begin
    FileClass := Reg.ReadString('');
    Reg.CloseKey;
  end;
  if FileClass <> '' then begin
    if Reg.OpenKeyReadOnly(FileClass + '\Shell\Open\Command') then
    begin
      Result := Reg.ReadString('');
      Reg.CloseKey;
    end;
  end;
  Reg.Free;
end;
//------------------------------------------------------------------------------
//FindFile
//This function we show below receives as parameters a file
//specification (like for example 'C:\My Documents\*.xls'
//or 'C:\*' if you want to search the entire hard disk.)
//and optionally a set of attributes (exactly as Delphi's
//FindFirst function), and it returs a StringList with the
//full pathnames of the found files. You should free the
//StringList after using it.

function FindFile(const filespec: TFileName): TStringList;
var
  spec: string;
  list: TStringList;

procedure RFindFile(const folder: TFileName);
var
  SearchRec: TSearchRec;
begin
  // Locate all matching files in the current
  // folder and add their names to the list
  if FindFirst(folder + spec, faAnyFile, SearchRec) = 0 then begin
    try
      repeat
        if (SearchRec.Attr and faDirectory = 0) or
           (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          list.Add(folder + SearchRec.Name);
      until FindNext(SearchRec) <> 0;
    except
      FindClose(SearchRec);
      raise;
    end;
    FindClose(SearchRec);
  end;
  // Now search the subfolders
  if FindFirst(folder + '*', faAnyFile, SearchRec) = 0 then
  begin
    try
      repeat
        if ((SearchRec.Attr and faDirectory) <> 0) and
           (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
          RFindFile(folder + SearchRec.Name + '\');
      until FindNext(SearchRec) <> 0;
    except
      FindClose(SearchRec);
      raise;
    end;
    FindClose(SearchRec);
  end;
end; // procedure RFindFile inside of FindFile

begin // function FindFile
  list := TStringList.Create;
  try
    spec := ExtractFileName(filespec);
    RFindFile(ExtractFilePath(filespec));
    Result := list;
  except
    list.Free;
    raise;
  end;
end;
//--------------------------------------------------------------------------------
function Like(AString, Pattern: string; CaseSensitive: boolean): boolean;
var
  i, n, n1, n2: integer;
  p1, p2: pchar;
label
  match, nomatch;
begin
  if not Casesensitive then
  begin
    AString := UpperCase(AString);
    Pattern := UpperCase(Pattern);
  end;
  n1 := Length(AString);
  n2 := Length(Pattern);
  if n1 < n2 then n := n1 else n := n2;
  p1 := pchar(AString);
  p2 := pchar(Pattern);
  for i := 1 to n do begin
    if p2^ = '*' then goto match;
    if (p2^ <> '?') and (p2^ <> p1^) then goto nomatch;
    inc(p1); inc(p2);
  end;
  if n1 > n2 then begin
nomatch:
    Result := False;
    exit;
  end else if n1 < n2 then begin
    for i := n1 + 1 to n2 do begin
      if not (p2^ in ['*','?']) then goto nomatch;
      inc(p2);
    end;
  end;
match:
  Result := True;
end;
//--------------------------------------------------------------------------------
{To determine if the character is a digit.}
function IsDigit(ch: char): boolean;
begin
  Result := ch in ['0'..'9'];
end;

{To determine if the character is an uppercase letter.}
function IsUpper(ch: char): boolean;
begin
  Result := ch in ['A'..'Z'];
end;

{To determine if the character is an lowercase letter.}
function IsLower(ch: char): boolean;
begin
  Result := ch in ['a'..'z'];
end;

{Changes a character to an uppercase letter.}
function ToUpper(ch: char): char;
begin
  Result := chr(ord(ch) and $DF);
end;

{Changes a character to a lowercase letter.}
function ToLower(ch: char): char;
begin
  Result := chr(ord(ch) or $20);
end;

{ Capitalizes first letter of every word in s }
function Proper(const s: string): string;
var
  i: Integer;
  CapitalizeNextLetter: Boolean;
begin
  Result := LowerCase(s);
  CapitalizeNextLetter := True;
  for i := 1 to Length(Result) do
  begin
    if CapitalizeNextLetter and IsLower(Result[i]) then
      Result[i] := ToUpper(Result[i]);
    CapitalizeNextLetter := Result[i] = ' ';
  end;
end;
//--------------------------------------------------------------------------------
function CheckifHex(Str: string; ShowMsg: boolean): boolean;
var
  n: integer;
  ChrStr: PChar;
  FStr: string;
begin
  Result:= true;
  ChrStr:= PChar(Str);
    for n:= 0 to Length(Str) - 1 do
      if not (ChrStr[n] in ['0'..'9', 'a'..'f', 'A'..'F']) then
      begin
        FStr:= FStr + ' ' + IntToStr(n+1);
        Result:= false;
      end;
  if ShowMsg and not Result then ShowMessage('Wrong character(-s) in position: ' + FStr);
end;
//--------------------------------------------------------------------------------

end.