utility.pas

utility!

var
	Buf : array[0..128] of Char;
	Len : Integer;
begin
	Len:=GetEnvironmentVariable(PChar(VarName), @Buf, SizeOf(Buf));
	if Len > 0 then
		Result:=string(Buf)
	else
		Result:='';
end;

function ExpandEnvironmentStr (const Str : string) : string;
var
  Len : Integer;
  Buffer : array[Byte] of Char;
begin
  Len:=ExpandEnvironmentStrings(PChar(Str), Buffer, SizeOf(Buffer));
  if Len = 0 then
    raise EConvertError.CreateFmt(
      'Error %d calling ExpandEnvironmentStrings', [GetLastError]);
  Result:=string(Buffer);
end;

function GetUserNameStr : string;
var
  Buffer : array[0..127] of Char;
  Len : Integer;
begin
  Len:=SizeOf(Buffer);
{
  if GetUserName(@Buffer, Len) then
    Result:=string(Buffer)
  else
}
    Result:='';
end;

function GetComputerNameStr : string;
var
  Buffer : array[0..MAX_COMPUTERNAME_LENGTH - 1] of Char;
  Len : Integer;
begin
  Len:=SizeOf(Buffer);
{
  if GetComputerName(@Buffer, Len) then
    Result:=string(Buffer)
  else
}  
    Result:='';
end;

function GetTempFileNameStr (const Path, Prefix : string;
  Unique : Longint) : string;
var
  Buffer : array[0..MAX_PATH - 1] of Char;
begin
  if GetTempFileName(PChar(Path), PChar(Prefix), Unique, @Buffer) <> 0 then
    Result:=string(Buffer)
  else
    Result:=''
end;

function GetTempPathStr : string;
var
  Buffer : array[0..MAX_PATH - 1] of Char;
begin
  if GetTempPath(SizeOf(Buffer) - 1, @Buffer) <> 0 then
    Result:=string(Buffer)
  else
    Result:=''
end;

function GetSystemDirectoryStr : string;
var
  Buffer : array[0..MAX_PATH - 1] of Char;
begin
  if GetSystemDirectory(@Buffer, SizeOf(Buffer) - 1) <> 0 then
    Result:=string(Buffer)
  else
    Result:=''
end;

function LongSub (A, B : Longint) : Longint;
asm
  mov eax, A
  mov ebx, B
  sub eax, ebx
end;

function NullTicks : TTicks;
asm
  mov eax, 0
end;

function GetTicks; external 'kernel32.dll' name 'GetTickCount';

function TicksSub (A, B : TTicks) : TTicks;
asm
  mov eax, A
  mov ebx, B
  sub eax, ebx
end;

function TicksToInt (Ticks : TTicks) : Integer;
asm
  mov eax, Ticks
end;

function TicksToSec (Ticks : TTicks) : Integer;
begin
  Result:=TicksToInt(Ticks) div 1000;
end;

function StrGetWord (const S : string; N : Integer;
  const Delims : TCharSet; const Options : TWordOptions) : string;
var
  I, I0 : Integer;
  QuoteChar : string;
begin
  I0:=1;
  I:=1;
  if woNoSkipQuotes in Options then
    QuoteChar:=''
  else
    QuoteChar:='"';
  if S <> '' then
    while I <= Length(S) + 1 do
      begin
        if (I > Length(S)) or (S[I] in Delims) then
          begin
            if N > 0 then
              Dec(N);
            if N = 0 then
              begin
                Result:=Copy(S, I0, I - I0);
                if Result <> '' then
                  Exit;
              end;
            if woNoConsecutiveDelims in Options then
              I0:=I + 1
            else
              begin
                while (I <= Length(S)) and (S[I] in Delims) do
                  Inc(I);
                I0:=I;
              end;
          end;
        if S[I] = QuoteChar then
          begin
            Inc(I);
            while (I <= Length(S)) and (S[I] <> QuoteChar) do
              Inc(I);
          end;
        Inc(I);
      end;
  Result:='';
end;

function StrWordCount (const S : string; const Delims : TCharSet;
  const Options : TWordOptions) : Integer;
var
  I : Integer;
  QuoteChar : string;
begin
  Result:=0;
  I:=1;
  if woNoSkipQuotes in Options then
    QuoteChar:=''
  else
    QuoteChar:='"';
  if S <> '' then
    while I <= Length(S) + 1 do
      begin
        if (I > Length(S)) or (S[I] in Delims) then
          begin
            Inc(Result);
            if not (woNoConsecutiveDelims in Options) then
              while (I <= Length(S)) and (S[I] in Delims) do
                Inc(I);
          end;
        if S[I] = QuoteChar then
          begin
            Inc(I);
            while (I <= Length(S)) and (S[I] <> QuoteChar) do
              Inc(I);
          end;
        Inc(I);
      end;
end;

function StrWordPos (const S : string; N : Integer;
  const Delims : TCharSet; const Options : TWordOptions) : Integer;
var
  I : Integer;
  QuoteChar : string;
begin
  Result:=1;
  I:=1;
  if woNoSkipQuotes in Options then
    QuoteChar:=''
  else
    QuoteChar:='"';
  if S <> '' then
    while (N > 0) and (I <= Length(S)) do
      begin
        if S[I] in Delims then
          begin
            Dec(N);
            if N = 0 then
              Exit;
            if not (woNoConsecutiveDelims in Options) then
              while (I <= Length(S)) and (S[I] in Delims) do
                Inc(I);
            Result:=I;
          end
        else if S[I] = QuoteChar then
          begin
            Inc(I);
            while (I <= Length(S)) and (S[I] <> '"') do
              Inc(I);
          end;
        Inc(I);
      end;
end;

function UnquoteStr (const Str : string) : string;
begin
  if (Length(Str) >= 2) and (Str[1] = '"') and (Str[Length(Str)] = '"') then
    Result:=Copy(Str, 2, Length(Str) - 2)
  else
    Result:=Str;
end;

function StrCompareWildCards (const A, B : string) : Boolean;
var
	PosA, PosB : Integer;
begin
	PosA:=1;
	PosB:=1;
	Result:=True;

	if (Length(A) = 0) and (Length(B) = 0) then
		Result:=True
	else
		if Length(A) = 0 then
			begin
        if B[1] = '*' then
  				Result:=True
	  		else
		  		Result:=False
      end
		else if Length(B) = 0 then
			begin
        if A[1] = '*' then
  				Result:=True
	  		else
		  		Result:=False;
      end;
        
	while (Result = True) and (PosA <= Length(A)) and (PosB <= Length(B)) do
		if (A[PosA] = '?') or (B[PosB] = '?') then
			begin
				Inc(PosA);
				Inc(PosB);
			end
		else if A[PosA] = '*' then
			begin
				Inc(PosA);
				if PosA <= Length(A) then
					begin
						while (PosB <= Length(B)) and not StrCompareWildCards(
              Copy(A, PosA, Length(A) - PosA + 1),
              Copy(B, PosB, Length(B) - PosB + 1)) do
							Inc(PosB);

						if PosB > Length(B) then
							Result:=False
						else
							begin
								PosA:=Succ(Length(A));
								PosB:=Succ(Length(B));
							end
					end
				else
					PosB:=Succ(Length(B));
			end
		else if B[PosB] = '*' then
			begin
				Inc(PosB);
				if PosB <= Length(B) then
					begin
						while (PosA <= Length(A)) and not StrCompareWildCards(
              Copy(A, PosA, Length(A) - PosA + 1),
              Copy(B, PosB, Length(B) - PosB + 1)) do
							Inc(PosA);

						if PosA > Length(A) then
							Result:=False
						else
							begin
								PosA:=Succ(Length(A));
								PosB:=Succ(Length(B));
							end
					end
				else
					PosA:=Succ(Length(A));
			end
		else if UpCase(A[PosA]) = UpCase(B[PosB]) then
			begin
				Inc(PosA);
				Inc(PosB);
			end
		else
			Result:=False;

	if PosA > Length(A) then
		begin
			while (PosB <= Length(B)) and (B[PosB] = '*') do
				Inc(PosB);

			if PosB <= Length(B) then
				Result:=False;
		end;

	if PosB > Length(B) then
		begin
			while (PosA <= Length(A)) and (A[PosA] = '*') do
				Inc(PosA);
			if PosA <= Length(A) then
				Result:=False;
		end;
end;

function ReplaceString (const Str, SubStr, NewStr : string) : string;
var
  I : Integer;
begin
  Result:=Str;
  while True do
    begin
      I:=Pos(SubStr, Result);
      if I > 0 then
        begin
          Delete(Result, I, Length(SubStr));
          Insert(NewStr, Result, I);
        end
      else
        Break;
    end;
end;

end.