utils.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Utils.pas, released on 2004-05-19.

The Initial Developer of the Original Code is Andreas Hausladen
(Andreas dott Hausladen att gmx dott de)
Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
All Rights Reserved.

Contributor(s): -

You may retrieve the latest version of this file at the Project JEDI's JVCL
home page, located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Utils.pas,v 1.1 2004/05/19 00:02:45 ahuser Exp $

unit Utils;

interface

uses
  SysUtils, Classes;

type
  IStringBuilder = interface
    procedure Append(const Text: string); overload;
    procedure Append(const Args: array of string); overload;
    function GetValue: string; overload;
    procedure GetValue(var Value: string); overload;
    function Length: Integer;
    function Capacity: Integer;
  end;

function StringBuilder(const StartValue: string; StartCapacity: Integer = 1024;
  ADelta: Integer = 1024): IStringBuilder;

function AnsiStartsFilename(const SubStr, S: string): Boolean;
  // AnsiStartsText/Str depends on the used OS
function ParsePath(const Path: string): string;

function RepeatStr(const S: string; Count: Integer): string;
function IsEmptyStr(const S: string): Boolean;
function RemoveCommentChars(const S: string): string;
function TrimCopy(const S: string; Index, Count: Integer): string;

procedure ReadFileToString(const Filename: string; var S: string);
procedure WriteFileFromString(const Filename, S: string);

function FollowRelativeFilename(const RootDir: string; RelFilename: string): string;
function CutFirstDirectory(var Dir: string): string;

procedure ConvertBinDfmToText(const Filename: string);

implementation

uses
  StrUtils;

type
  TStringBuilder = class(TInterfacedObject, IStringBuilder)
  private
    FBuffer: string;
    FLength: Integer;
    FDelta: Integer;
    procedure Append(const Text: string); overload;
    procedure Append(const Args: array of string); overload;
    function GetValue: string; overload;
    procedure GetValue(var Value: string); overload;
    function Length: Integer;
    function Capacity: Integer;
  protected
    procedure Grow(AddLen: Integer);
  public
    constructor Create(const StartValue: string; StartCapacity: Integer = 1024;
      ADelta: Integer = 1024);
  end;

{ TStringBuilder }

constructor TStringBuilder.Create(const StartValue: string; StartCapacity,
  ADelta: Integer);
begin
  inherited Create;
  FDelta := ADelta;
  if FDelta < 16 then
    FDelta := 16;
  FLength := System.Length(StartValue);
  if StartCapacity < FLength then
    FBuffer := StartValue
  else
  begin
    SetLength(FBuffer, StartCapacity);
    if FLength > 0 then
      Move(StartValue[1], FBuffer[1], FLength);
  end;
end;

procedure TStringBuilder.Append(const Args: array of string);
var
  AddLen: Integer;
  i: Integer;
  Len: Integer;
begin
  AddLen := 0;
  for i := 0 to High(Args) do
    Inc(AddLen, System.Length(Args[i]));
  if AddLen = 0 then
    Exit; // nothing to do
  if FLength + AddLen > System.Length(FBuffer) then
    Grow(AddLen);
  for i := 0 to High(Args) do
  begin
    Len := System.Length(Args[i]);
    Move(Args[i][1], FBuffer[FLength + 1], Len);
    Inc(FLength, Len);
  end;
end;

procedure TStringBuilder.Append(const Text: string);
type
  PRec3 = ^TRec3;
  TRec3 = packed record
    res1: Word;
    res2: Byte;
  end;

  PRec5 = ^TRec5;
  TRec5 = packed record
    res1: LongWord;
    res2: Byte;
  end;

  PRec6 = ^TRec6;
  TRec6 = packed record
    res1: LongWord;
    res2: Word;
  end;

  PRec7 = ^TRec7;
  TRec7 = packed record
    res1: LongWord;
    res2: Word;
    res3: Byte;
  end;

var
  AddLen: Integer;
  P: PChar;
begin
  AddLen := System.Length(Text);
  if AddLen > 0 then
  begin
    if FLength + AddLen > System.Length(FBuffer) then
      Grow(AddLen);
    P := Pointer(FBuffer);
    Inc(P, FLength);
    case AddLen of
      1: P^ := Text[1];
      2: PWord(P)^ := PWord(Text)^;
      3: PRec3(P)^ := PRec3(Text)^;
      4: PLongWord(P)^ := PLongWord(Text)^;
      5: PRec5(P)^ := PRec5(Text)^;
      6: PRec6(P)^ := PRec6(Text)^;
      7: PRec7(P)^ := PRec7(Text)^;
      8: PInt64(P)^ := PInt64(Text)^;
    else
      Move(Text[1], P^, AddLen);
    end;
    Inc(FLength, AddLen);
  end;
end;

function TStringBuilder.Capacity: Integer;
begin
  Result := System.Length(FBuffer);
end;

function TStringBuilder.Length: Integer;
begin
  Result := FLength;
end;

function TStringBuilder.GetValue: string;
begin
  GetValue(Result);
end;

procedure TStringBuilder.GetValue(var Value: string);
begin
  if FLength > 0 then
    SetString(Value, PChar(Pointer(FBuffer)), FLength)
  else
    Value := '';
end;

procedure TStringBuilder.Grow(AddLen: Integer);
var
  NewLen: Integer;
begin
  NewLen := FLength + AddLen + FDelta;
  SetLength(FBuffer, NewLen);
end;


function StringBuilder(const StartValue: string; StartCapacity: Integer = 1024;
  ADelta: Integer = 1024): IStringBuilder;
begin
  Result := TStringBuilder.Create(StartValue, StartCapacity, ADelta);
end;

function AnsiStartsFilename(const SubStr, S: string): Boolean;
begin
  {$IFDEF MSWINDOWS}
  Result := AnsiStartsText(SubStr, S);
  {$ENDIF MSWINDOWS}
  {$IFDEF LINUX}
  Result := AnsiStartsStr(SubStr, S);
  {$ENDIF LINUX}
end;

{$IFDEF MSWINDOWS}
function ParsePath(const Path: string): string;
var
  i: Integer;
begin
  Result := Path;
  for i := 1 to Length(Result) do
    if Result[i] = '/' then
      Result[i] := '\';
end;
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
function ParsePath(const Path: string): string;
var
  i: Integer;
begin
  Result := Path;
  for i := 1 to Length(Result) do
    if Result[i] = '\' then
      Result[i] := '/';
end;
{$ENDIF LINUX}

function RepeatStr(const S: string; Count: Integer): string;
var
  sb: IStringBuilder;
begin
  sb := StringBuilder('', Length(S) * Count);
  while Count > 0 do
  begin
    sb.Append(S);
    Dec(Count);
  end;
  sb.GetValue(Result);
end;

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

function RemoveCommentChars(const S: string): string;
begin
  if S <> '' then
  begin
    if S[1] = '{' then
      Result := Copy(S, 2, Length(S) - 2)
    else // '(*'
      Result := Copy(S, 3, Length(S) - 3);
  end
  else
    Result := '';
end;

function TrimCopy(const S: string; Index, Count: Integer): string;
var
  Len, StartIndex, EndIndex: Integer;
begin
  Result := '';

  Len := Length(S);
  if Index <= 0 then
    Index := 1;
  if Count > Len then
    Count := Len;

  if (Count > 0) and (Len > 0) then
  begin
    StartIndex := Index;
    while (StartIndex <= Len) and (S[StartIndex] <= #32) do
      Inc(StartIndex);
    Dec(Count, StartIndex - Index);

    EndIndex := StartIndex + Count - 1;
    if EndIndex > Len then
    begin
      Dec(Count, EndIndex - Len);
      EndIndex := Len;
    end;

    while (EndIndex > 0) and (S[EndIndex] <= #32) do
    begin
      Dec(EndIndex);
      Dec(Count);
    end;

    if EndIndex >= StartIndex then
      SetString(Result, PChar(Pointer(S)) + StartIndex - 1, Count);
  end;
end;


procedure ReadFileToString(const Filename: string; var S: string);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
  try
    SetLength(S, fs.Size);
    if Length(S) > 0 then
      fs.Read(S[1], Length(S));
  finally
    fs.Free;
  end;
end;

procedure WriteFileFromString(const Filename, S: string);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(Filename, fmCreate);
  try
    if Length(S) > 0 then
      fs.Write(S[1], Length(S));
  finally
    fs.Free;
  end;
end;

function CutFirstDirectory(var Dir: string): string;
var
  ps: Integer;
begin
  ps := Pos(PathDelim, Dir);
  if ps > 0 then
  begin
    Result := Copy(Dir, 1, ps - 1);
    Delete(Dir, 1, ps);
  end
  else
  begin
    Result := Dir;
    Dir := '';
  end;
end;

function FollowRelativeFilename(const RootDir: string; RelFilename: string): string;
var
  Dir: string;
begin
  Result := RootDir;
  while RelFilename <> '' do
  begin
    Dir := CutFirstDirectory(RelFilename);
    if Dir = '..' then
      Result := ExtractFileDir(Result)
    else if Dir = '.' then
      Continue
    else
      Result := Result + PathDelim + Dir;
  end;
end;

procedure ConvertBinDfmToText(const Filename: string);
var
  InStream, OutStream: TStream;
begin
  OutStream := TMemoryStream.Create;
  try
    InStream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
    try
      ObjectResourceToText(InStream, OutStream);
    finally
      InStream.Free;
    end;
    TMemoryStream(OutStream).SaveToFile(Filename); // overwrite file
  finally
    OutStream.Free;
  end;
end;


end.