dpp_utils.pas

East make Tray Icon in delphi

    SetLength(Content, Len);
    if Len > 0 then Stream.ReadBuffer(Content[1], Len);
  finally
    Stream.Free;
  end;
end;

// *****************************************************************************

function GetPreProcessedFilename(const Filename: string; IncludeIndex: Integer = 0): string;
var Ext, NewExt: string;
begin
  if IncludeIndex = 0 then NewExt := '.i' else NewExt := Format('.i%d', [IncludeIndex]);

  Ext := ExtractFileExt(Filename);
  Result := ChangeFileExt(Filename, NewExt) + Ext;
end;

// *****************************************************************************

function TestFilenames(const Paths, Filename: string; ExTestMethod: TExTestMethod): string;
var
  List: TStrings;
  i: Integer;
begin
  List := TStringList.Create;
  try
    PathListToStrings(Paths, List); // does never return empty list items
    for i := 0 to List.Count - 1 do
    begin
      Result := List.Strings[i];
      if Result[Length(Result)] <> PathDelim then
        Result := Result + PathDelim + Filename
      else
        Result := Result + Filename;
      if Assigned(ExTestMethod) then if ExTestMethod(Result) then Exit;
      if FileExistsX(Result) then Exit;
    end;
  finally
    List.Free;
  end;
  Result := '';
end;

// *****************************************************************************

function FollowRelativePath(BaseDir, Filename: string): string;
var
  ps: Integer;
  s: string;
begin
  Result := Filename;
  if Filename = '' then Exit;
  if Filename[1] = PathDelim then
    Result := ExtractFileDrive(BaseDir) + Filename
  else
  begin
    BaseDir := ExcludeTrailingPathDelimiter(BaseDir);
    ps := PosChar(PathDelim, Filename);
    while ps > 0 do
    begin
      s := Copy(Filename, 1, ps - 1);
      Delete(Filename, 1, ps);
      if s = '..' then
        BaseDir := ExtractFileDir(BaseDir)
      else if s <> '.' then
        BaseDir := BaseDir + PathDelim + s;
      ps := PosChar(PathDelim, Filename);
    end;
  end;
  if Pointer(Filename) <> nil then // <= => Length(Filename) > 0 then
    Result := BaseDir + PathDelim + Filename
  else
    Result := BaseDir;
end;

// *****************************************************************************

procedure StringToFile(const Filename, Content: string);
var Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    if Length(Content) > 0 then
      Stream.WriteBuffer(Content[1], Length(Content));
  finally
    Stream.Free;
  end;
end;

// *****************************************************************************

function CompareFileNames(const FileName1, FileName2: string): Integer; assembler
asm
{$ifdef MSWINDOWS}
  JMP   CompareText
{$endif}
{$ifdef LINUX}
  JMP   CompareStr
{$endif}
end;

// *****************************************************************************
// ************************** String handling **********************************
// *****************************************************************************

function CountCharsStop(Ch, StopCh: Char; P: PChar): Integer;
begin
  Result := 0;
  while not (P[0] in [#0, StopCh]) do
  begin
    if P[0] = Ch then Inc(Result);
    Inc(P);
  end;
end;

function CountChars(Ch: Char; const S: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(S) do
    if S[i] = Ch then
      Inc(Result);
end;

// *****************************************************************************

function PosCharSet(CS: TSysCharSet; const S: string): Integer;
begin
  for Result := 1 to Length(S) do
    if S[Result] in CS then Exit;
  Result := 0;
end;

// *****************************************************************************

function PosChar(Ch: Char; const S: string): Integer; assembler;
asm
  //  AL = Ch
  // EDX = const S
  PUSH   ESI
  MOV    ESI, EDX  // ESI = S

 // String empty ?
  OR     EDX, EDX
  JZ     @@TheEnd

@@loop:
  MOV    AH, [ESI]
  INC    ESI
 // Char found ?
  CMP    AL, AH
  JZ     @@TheEnd
 // String-End ?
  OR     AH, AH
  JNZ    @@loop

  MOV    ESI, EDX

@@TheEnd:
  MOV    EAX, ESI
  SUB    EAX, EDX

  POP    ESI
end;

// *****************************************************************************

type
  PStrRec = ^StrRec;
  StrRec = packed record
    refCnt: Longint;
    length: Longint;
  end;

function StartsText(const StartText, Text: string): Boolean;
begin
  if Pointer(Text) = nil then
    Result := Pointer(StartText) = nil
  else
    Result := StrLIComp(Pointer(Text),
                        Pointer(StartText),
                        PStrRec(Integer(StartText) - SizeOf(StrRec)).length) = 0;
end;

// *****************************************************************************

function RemoveQuotes(const Text: string): string;
var Len: Integer;
begin
  Result := Text;
  Len := Length(Result);
  if (Len > 0) and
     (Result[1] = Result[Len]) and (Result[1] in ['''', '"']) then
  begin
    Delete(Result, Len, 1);
    Delete(Result, 1, 1);
  end;
end;

// *****************************************************************************

function IsStrEmpty(const Text: string): Boolean;
var i: Integer;
begin
  Result := False;
  for i := 1 to Length(Text) do
    if Text[i] > ' ' then Exit;
  Result := True;
end;

// *****************************************************************************

function IndexOfStrText(List: TStrings; const StrText: string;
  CaseSensitive: Boolean): Integer;
var cmp: function(const S1, S2: string): Integer;
begin
  if List <> nil then
  begin
    if CaseSensitive then cmp := CompareStr else cmp := CompareText;

    for Result := 0 to List.Count - 1 do
      if cmp(List.Strings[Result], StrText) = 0 then Exit;
  end;
  Result := -1;
end;

// *****************************************************************************

function IndexOfFilename(Files: TStrings; const Filename: string): Integer;
begin
  if Files <> nil then
  begin
    for Result := 0 to Files.Count - 1 do
      if CompareFileNames(Files.Strings[Result], Filename) = 0 then Exit;
  end;
  Result := -1;
end;

// *****************************************************************************

procedure PathListToStrings(const Paths: string; List: TStrings);
var
  s: string;
  F, P: PChar;
begin
  P := PChar(Paths);
  while P[0] <> #0 do
  begin
    F := P;
    while not (P[0] in [#0, PathSep]) do Inc(P);
    if F < P then
    begin
      SetString(s, F, P - F);
      s := RemoveQuotes(s);
      if Length(s) > 0 then List.Add(s);
    end;
    if P[0] <> #0 then Inc(P);
  end;
end;

// *****************************************************************************
// ***************************** String Hash ***********************************
// *****************************************************************************

function StringHash(const Text: string): Integer;
var a, i, ch, Len: Integer;
begin
  Len := Length(Text);
  a := Len - 6;
  if a <= 0 then a := 1;
  Result := 0;
  for i := Len downto a do
  begin
    ch := Byte(Text[i]);
    if ch >= Byte('a') then Dec(ch, 32);
    Dec(ch, 48); // no chars below '0' are allowed
    Inc(Result, ch);
  end;
end;

{procedure NextHash(var hash: Integer);
begin
  Inc(hash, 29);
end;}

procedure MakeStringHash(const Text: string; Index: Integer; var Table: TRedirectTable);
var hash, len: Integer;
begin
  hash := StringHash(Text);
  len := Length(Table);
  repeat
    if hash >= len then
    begin
      SetLength(Table, hash + 1);
      Table[hash].Text := Text;
      Table[hash].Index := Index;
      Exit;
    end
    else
    if Table[hash].Index = 0 then
    begin
      Table[hash].Text := Text;
      Table[hash].Index := Index;
      Exit;
    end;

//    NextHash(hash);
    Inc(hash, 29);
  until False;
end;

function GetStringHashTableIndex(const Text: string; const Table: TRedirectTable; CaseSensitive: Boolean): Integer;
var hash, len: Integer;
begin
  Result := -1;
  hash := StringHash(Text);
  len := Length(Table);

  if CaseSensitive then
  begin
    while (hash < len) and (Table[hash].Index <> 0) do
    begin
      if Table[hash].Text = Text then
      begin
        Result := hash;
        Exit;
      end;
//      NextHash(hash);
      Inc(hash, 29);
    end;
  end
  else
  begin
    while (hash < len) and (Table[hash].Index <> 0) do
    begin
      if (SameText(Table[hash].Text, Text)) then
      begin
        Result := hash;
        Exit;
      end;
//      NextHash(hash);
      Inc(hash, 29);
    end;
  end;
end;

function FindStringHash(const Text: string; const Table: TRedirectTable; CaseSensitive: Boolean): Integer;
begin
  Result := GetStringHashTableIndex(Text, Table, CaseSensitive);
  if Result = -1 then Result := 0 else Result := Table[Result].Index;
end;

procedure DelStringHash(const Text: string; var Table: TRedirectTable; CaseSensitive: Boolean);
var Index, len: Integer;
begin
  Index := GetStringHashTableIndex(Text, Table, CaseSensitive);
  if Index >= 0 then
  begin
//    Table[Index].Text := '';
    Table[Index].Index := 0;

   // shrink table
    len := Length(Table);
    while (len > 0) and (Table[len - 1].Index = 0) do Dec(len);
    SetLength(Table, len);
  end;
end;

procedure DelStringHash(Index: Integer; var Table: TRedirectTable);
var i, len: Integer;
begin
  for i := 0 to High(Table) do
    if Table[i].Index = Index then
    begin
//      Table[i].Text := '';
      Table[i].Index := 0;
    end;

 // shrink table
  len := Length(Table);
  while (len > 0) and (Table[len - 1].Index = 0) do Dec(len);
  SetLength(Table, len);
end;

end.