utility.pas

utility!

{++

u t i l i t y . p a s
Copyright (c) 1995-1997 by Alexander Staubo, all rights reserved.

Abstract:

  Utility functions.

  Additional notes:

  - The string functions are not optimized.

  - StreamReadLn is quite slow unless used on a buffered stream.

--}

{$WEAKPACKAGEUNIT ON}
{$I+}
{$IFNDEF Win32}
  !!  // 32-bit compilation only.
{$ENDIF}

unit Utility;

interface

uses
	SysUtils, Classes;

{ Types }

type
  TCharSet = set of Char;

{ Exception classes }

  EApiError =
    class(Exception)
    protected
      FErrorCode : Longint;
    public
      constructor Create (ErrorCode : Longint); 
      constructor CreateMsg (ErrorCode : Longint; const Message : string);
      property ErrorCode : Longint read FErrorCode write FErrorCode;
    end;

{ System functions }

procedure ApiCheck (Result : Boolean);
  { If Error is True, this function raises an EApiError with the last error
    code and message }

procedure ApiError (ErrorCode : Longint);
  { Raises an EApiError with the specified system error code }

{ File utility functions }

function AddFileExt (const S, Ext : string) : string;
	{ Add extension to file name if the file name does not already contain an
    extension. Ext must not contain period character }

function ForceFileExt (const S, Ext : string) : string;
	{ Add extension to file name, deleting old extension. Equivalent to the
    ChangeFileExt procedure in SysUtils, except Ext must not contain period }

function AssurePath (const Path : string) : Boolean;
  { Assure that all directories in path exist. Equivalent to the
    ForceDirectories function in the Borland FileCtrl unit }

{ File string functions }

function AddBkSlash (const S : string) : string;
	{ Returns S with backslash added}

function RemBkSlash (const S : string) : string;
	{ Returns S with backslash removed}

{ Stream utilities }

procedure StreamWriteString (Stream : TStream; const Str : string);
  { Write string Str to stream }

function StreamReadString (Stream : TStream) : string;
  { Read string from stream }

function StreamReadLn (Stream : TStream) : string;
  { Read crlf-terminated line from stream }

procedure StreamWriteLn (Stream : TStream; Str : string);
  { Write crlf-terminated line to stream }

procedure StreamWrite (Stream : TStream; Str : string);
  { Write string to stream }

procedure StreamReadStrings (Stream : TStream; Strings : TStrings);
  { Read list of strings written with StreamWriteStrings from stream }

procedure StreamWriteStrings (Stream : TStream; Strings : TStrings);
  { Write list of strings to stream }

{ System functions }

function GetEnvironmentVarStr (const VarName : string) : string;
  { Read variable from environment block of the calling process }
  
function ExpandEnvironmentStr (const Str : string) : string;
  { Expands variables in Str to their equivalent environment variable values }

function GetUserNameStr : string;
  { Retrieve the user name of the current thread. This is the name of the user
    currently logged onto the system.  }

function GetComputerNameStr : string;
  { Retrieve the computer name of the current system. This name is established
    at system startup, when it is initialized from the registry }

function GetTempFileNameStr (const Path, Prefix : string;
  Unique : Longint) : string;
  { Generate a unique temporary file name. If successful, the file is also
    created with zero length. The resulting file name is the concatenation of
    specified path and prefix strings, a hexadecimal string formed from a
    specified integer, and the .TMP extension. If Unique is zero, a random
    number is used for the integer value; otherwise this value is used }

function GetTempPathStr : string;
  { Retrieve the path of the directory designated for temporary files }

function GetSystemDirectoryStr : string;
  { Retrieve system directory }

{ Miscellaneous low-level functions }

function LongSub (A, B : Longint) : Longint;
  { Evaluates the unsigned integer expression A-B, returning the result }

{ Timing functions. The tick routines avoid problems with 32-bit integers in
  Delphi, providing a separate type for storing the tick value }

type
  TTicks =
    record
      L, H : Word;
    end;

function NullTicks : TTicks;
  { Returns an empty tick value }

function GetTicks : TTicks; stdcall;
  { Get current tick count. Maps to GetTickCount }

function TicksSub (A, B : TTicks) : TTicks;
  { Subtract B ticks from A }

function TicksToInt (Ticks : TTicks) : Integer;
  { Convert ticks to integer }

function TicksToSec (Ticks : TTicks) : Integer;
  { Convert ticks to seconds }

{ String utilities }

type
  TWordOptions = set of
    (
      woNoSkipQuotes,
      woNoConsecutiveDelims
    );

function StrGetWord (const S : string; N : Integer;
  const Delims : TCharSet; const Options : TWordOptions) : string;
  { Extracts word number N from string S. Delims specify the characters used to
    delimit words }

function StrWordCount (const S : string; const Delims : TCharSet;
  const Options : TWordOptions) : Integer;
  { Returns number of words in S }

function StrWordPos (const S : string; N : Integer;
  const Delims : TCharSet; const Options : TWordOptions) : Integer;
  { Returns the character position of a word in S }

function UnquoteStr (const Str : string) : string;
  { Removes double quotes ("") from string Str }

function StrCompareWildCards (const A, B : string) : Boolean;
  { Compares two strings using Unix-like wild cards. Both A and B may contain
    the wild cards * and ? }

function ReplaceString (const Str, SubStr, NewStr : string) : string;
  { Replace occurences of SubStr in Str with NewStr }

implementation

uses
	Windows;

{ Resource strings }

{$I strconst.inc}

{ EApiError }

constructor EApiError.Create (ErrorCode : Longint);
begin
  inherited CreateFmt(strApiError, [ErrorCode, SysErrorMessage(ErrorCode)]);
end;

constructor EApiError.CreateMsg (ErrorCode : Longint; const Message : string);
begin
  inherited CreateFmt(Message, [ErrorCode]);
end;

{ Functions }

procedure ApiCheck (Result : Boolean);
begin
  if not Result then
    ApiError(GetLastError);
end;

procedure ApiError (ErrorCode : Longint);
begin
  raise EApiError.Create(ErrorCode);
end;

function AddFileExt (const S, Ext : string) : string;
begin
	if Pos('.', S) > 0 then
		Result:=S
	else
		Result:=S + '.' + Ext;
end;

function ForceFileExt (const S, Ext : string) : string;
begin
  if S <> '' then
    Result:=ChangeFileExt(S, '') + '.' + Ext
  else
    Result:='';
end;

function AssurePath (const Path : string) : Boolean;
begin
	if (Path = '') or ((Length(Path) = 2) and (Path[2] = ':') and
    (UpCase(Path[1]) in ['A'..'Z'])) then
		Result:=True
	else
    begin
      Result:=False;
      if AssurePath(RemBkSlash(ExtractFilePath(RemBkSlash(Path)))) then
        begin
          try
            MkDir(RemBkSlash(Path));
          except
            on E : EInOutError do
              if (E.ErrorCode <> 0) and
                 (E.ErrorCode <> ERROR_ACCESS_DENIED) and
                 (E.ErrorCode <> ERROR_ALREADY_EXISTS) then
                Exit;
            end;
          Result:=True;
        end
    end;
end;

function AddBkSlash (const S : string) : string;
begin
	if (S = '') or (S[Length(S)] = '\') then
  	Result:=S
  else
  	Result:=S + '\';
end;

function RemBkSlash (const S : string) : string;
begin
	if (S <> '') and (S[Length(S)] = '\') then
  	Result:=Copy(S, 1, Length(S) - 1)
  else
  	Result:=S;
end;

procedure StreamWriteString (Stream : TStream; const Str : string);
var
	Len : Longint;
begin
	Len:=Length(Str);
	Stream.Write(Len, SizeOf(Len));
	Stream.Write(Str[1], Len);
end;

function StreamReadString (Stream : TStream) : string;
var
	Len : Longint;
begin
	Stream.Read(Len, SizeOf(Len));
	SetLength(Result, Len);
	Stream.Read(Result[1], Len);
end;

function StreamReadLn (Stream : TStream) : string;
var
	C : Char;
begin
	Result:='';
	while True do
		begin
			if Stream.Read(C, SizeOf(C)) = 0 then
				Break;

			if C <> #13 then
				if C = #10 then
					Break
				else
					Result:=Result + C;
		end;
end;

procedure StreamWriteLn (Stream : TStream; Str : string);
begin
	Str:=Str + ^M^J;
	Stream.Write(Str[1], Length(Str));
end;

procedure StreamWrite (Stream : TStream; Str : string);
begin
	Stream.Write(Str[1], Length(Str));
end;

procedure StreamReadStrings (Stream : TStream; Strings : TStrings);
var
  I, N : Integer;
begin
  I:=0;
  Stream.Read(I, SizeOf(I));
  Strings.Clear;
  for N:=0 to I - 1 do
    Strings.Add(StreamReadString(Stream));
end;

procedure StreamWriteStrings (Stream : TStream; Strings : TStrings);
var
  I, N : Integer;
begin
  if Strings <> nil then
    I:=Strings.Count
  else
    I:=0;
  Stream.Write(I, SizeOf(I));
  for N:=0 to I - 1 do
    StreamWriteString(Stream, Strings.Strings[N]);
end;

function GetEnvironmentVarStr (const VarName : string) : string;