Componentes.Terceros.jvcl/official/3.39/devtools/InstallerTests/Installer/Common/Utils.pas

{-----------------------------------------------------------------------------
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-03-29.

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.delphi-jedi.org

Known Issues:
-----------------------------------------------------------------------------}
// $Id: Utils.pas 12461 2009-08-14 17:21:33Z obones $

unit Utils;

{$I installer.inc}

interface

uses
  Windows, Messages, ShellAPI, SysUtils, Classes;

function WordWrapString(const S: string; Width: Integer = 75): string;
  
function CompareFileAge(const Filename1Fmt: string; const Args1: array of const;
  const Filename2Fmt: string; const Args2: array of const): Integer;
function GetReturnPath(const Dir: string): string;
function FileExists(const Filename: string): Boolean;
function DirectoryExists(const Dir: string): Boolean;
function Path(const APath: string): string; // converts each '\' to PathDelim

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

function StartsWith(const Text, StartText: string; CaseInsensitive: Boolean = False): Boolean;
function EndsWith(const Text, EndText: string; CaseInsensitive: Boolean): Boolean;
function SubStr(const Text: string; StartIndex, EndIndex: Integer): string;

function HasText(Text: string; const Values: array of string): Boolean; // case insensitive
procedure AddPaths(List: TStrings; Add: Boolean; const Dir: string;
  const Paths: array of string);
function OpenAtAnchor(const FileName, Anchor: string): Boolean;

procedure FindFiles(const Dir, Mask: string; SubDirs: Boolean; List: TStrings;
  const FileExtensions: array of string);

function FindFilename(const Paths: string; const Filename: string): string;

 { DirContainsFiles returns True if the directory Dir contains at least one file
   that matches Mask. }
function DirContainsFiles(const Dir, Mask: string): Boolean;

function PathListToStr(List: TStrings): string;
procedure StrToPathList(Paths: string; List: TStrings);

procedure ConvertPathList(const Paths: string; List: TStrings); overload;
function ConvertPathList(List: TStrings): string; overload;

function AnsiStartsText(const SubStr, Text: string): Boolean;


procedure LockControl(AHandle: THandle);
procedure UnlockControl(AHandle: THandle);

implementation

uses
  StrUtils;

procedure LockControl(AHandle: THandle);
begin
  SendMessage(AHandle, WM_SETREDRAW, ord(False), 0);
end;

procedure UnlockControl(AHandle: THandle);
begin
  SendMessage(AHandle, WM_SETREDRAW, ord(True), 0);
  UpdateWindow(AHandle);
end;

function AnsiStartsText(const SubStr, Text: string): Boolean;
begin
  Result := StrUtils.AnsiStartsText(SubStr, Text);
end;

procedure ConvertPathList(const Paths: string; List: TStrings); overload;
var
  F, P: PChar;
  S: string;
begin
  List.Clear;
  P := PChar(Paths);
  while (P[0] <> #0) do
  begin
    // trim
    while (P[0] = ' ') do
      Inc(P);
    if P[0] = #0 then
      Break;

    F := P;
    while not (P[0] in [#0, ';']) do
      Inc(P);
    SetString(S, F, P - F);
    List.Add(ExcludeTrailingPathDelimiter(S));
    if P[0] = #0 then
      Break;
    Inc(P);
  end;
end;

function ConvertPathList(List: TStrings): string; overload;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to List.Count - 1 do
    Result := Result + List[I] + ';';
  SetLength(Result, Length(Result) - 1);
end;

function WordWrapString(const S: string; Width: Integer = 75): string;
var
  i, cnt, Len, LastWordStart, BreakStrLen: Integer;
begin
  Result := S;
  BreakStrLen := Length(sLineBreak);
  if (Width <= 0) or (S = '') then
    Exit;

  Len := Length(Result);
  i := 1;
  while i <= Len do
  begin
    cnt := 0;
    LastWordStart := 0;
    while (i <= Len) and ((LastWordStart = 0) or (cnt <= Width)) do
    begin
      if Result[i] = ' ' then
        LastWordStart := i;
      Inc(cnt);
      Inc(i);
    end;
    if i <= Len then
    begin
      if LastWordStart > 0 then
      begin
        Delete(Result, LastWordStart, 1);
        Dec(Len, 1);
        i := LastWordStart;
      end;
      Insert(sLineBreak, Result, i);
      Inc(Len, BreakStrLen);
      Inc(i, BreakStrLen);
    end;
  end;
end;

function CompareFileAge(const Filename1Fmt: string; const Args1: array of const;
  const Filename2Fmt: string; const Args2: array of const): Integer;
begin
  Result := FileAge(Format(Filename1Fmt, Args1))
            -
            FileAge(Format(Filename2Fmt, Args2));
end;

function GetReturnPath(const Dir: string): string;
var
  i: Integer;
begin
  Result := '';
  if Dir <> '' then
  begin
    Result := '..';
    for i := 1 to Length(Dir) do
      if Dir[i] = PathDelim then
        Result := Result + PathDelim + '..';
  end;
end;

function FileExists(const Filename: string): Boolean;
var
  Attr: Cardinal;
begin
  Attr := GetFileAttributes(PChar(Filename));
  Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY = 0);
end;

function DirectoryExists(const Dir: string): Boolean;
var
  Attr: Cardinal;
begin
  Attr := GetFileAttributes(PChar(Dir));
  Result := (Attr <> $FFFFFFFF) and (Attr and FILE_ATTRIBUTE_DIRECTORY <> 0);
end;

function Path(const APath: string): string;
var
  i: Integer;
begin
  Result := APath;
  for i := 1 to Length(Result) do
    if Result[i] = '\' then
      Result[i] := PathDelim;
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;

function FindFilename(const Paths: string; const Filename: string): string;
var
  List: TStrings;
  i: Integer;
begin
  if Filename <> '' then
  begin
    List := TStringList.Create;
    try
      ConvertPathList(Paths, List);
      for i := 0 to List.Count - 1 do
      begin
        Result := List[i];
        if (Result <> '') and (Result[1] = '"') then
        begin
          Delete(Result, 1, 1);
          Delete(Result, Length(Result), 1);
        end;
        if Result <> '' then
        begin
          if Result[Length(Result)] <> PathDelim then
            Result := Result + PathDelim;
          if Filename[1] = PathDelim then
            Result := Result + Copy(Filename, 2, MaxInt)
          else
            Result := Result + Filename;
          if FileExists(Result) then
            Exit; // found
        end;
      end;
    finally
      List.Free;
    end;
  end;
  Result := Filename;
end;

function DirContainsFiles(const Dir, Mask: string): Boolean;
var
  sr: TSearchRec;
begin
  Result := FindFirst(Dir + PathDelim + Mask, faAnyFile and not faDirectory, sr) = 0;
  if Result then
    FindClose(sr);
end;

function PathListToStr(List: TStrings): string;
var
  i: Integer;
begin
  Result := '';
  if List.Count > 0 then
    Result := List[0];
  for i := 1 to List.Count - 1 do
    Result := Result + ';' + List[i];
end;

procedure StrToPathList(Paths: string; List: TStrings);
var
  ps: Integer;
  S: string;
begin
  Assert(List <> nil);

  ps := Pos(';', Paths);
  while ps > 0 do
  begin
    S := Trim(Copy(Paths, 1, ps - 1));
    if S <> '' then
      List.Add(S);
    Delete(Paths, 1, ps);
    ps := Pos(';', Paths);
  end;
end;
                                      
function StartsWith(const Text, StartText: string; CaseInsensitive: Boolean = False): Boolean;
var
  Len, i: Integer;
begin
  Result := False;
  Len := Length(StartText);
  if Len > Length(Text) then
    Exit;
  if CaseInsensitive then
  begin
    for i := 1 to Len do
      if UpCase(Text[i]) <> UpCase(StartText[i]) then
        Exit;
  end
  else
  begin
    for i := 1 to Len do
      if Text[i] <> StartText[i] then
        Exit;
  end;
  Result := True;
end;

function EndsWith(const Text, EndText: string; CaseInsensitive: Boolean): Boolean;
var
  Len, i, x: Integer;
begin
  Result := False;
  Len := Length(EndText);
  x := Length(Text);
  if Len > x then
    Exit;
  if CaseInsensitive then
  begin
    for i := Len downto 1 do
      if UpCase(Text[x]) <> UpCase(EndText[i]) then
        Exit
      else
        Dec(x);
  end
  else
  begin
    for i := Len downto 1 do
      if Text[x] <> EndText[i] then
        Exit
      else
        Dec(x);
  end;
  Result := True;
end;

function SubStr(const Text: string; StartIndex, EndIndex: Integer): string;
begin
  Result := Copy(Text, StartIndex, EndIndex - StartIndex + 1);
end;

function HasText(Text: string; const Values: array of string): Boolean;
var
  i: Integer;
begin
  Result := True;
  Text := AnsiLowerCase(Text);
  for i := 0 to High(Values) do
    if Pos(Values[i], Text) > 0 then
      Exit;
  Result := False;
end;

procedure AddPaths(List: TStrings; Add: Boolean; const Dir: string;
  const Paths: array of string);
var
  i, j: Integer;
  Path: string;
begin
 // remove old paths
  for j := 0 to High(Paths) do
    for i := List.Count - 1 downto 0 do
      if Paths[j] <> '' then
      begin
        Path := Paths[j];
        if (Pos(':', Path) = 0) and (Path[1] <> '$') then
          Path := PathDelim + ExtractFileName(Dir) + PathDelim + Paths[j];
        if EndsWith(List[i], Path, True) then
          List.Delete(i)
        else if EndsWith(List[i], Path + '\', True) then
          List.Delete(i);
      end;

  if Add then
   // add new paths
    for j := 0 to High(Paths) do
      if Paths[j] <> '' then
      begin
        Path := Paths[j];
        if (Pos(':', Path) = 0) and (Path[1] <> '$') then
          List.Add(Dir + PathDelim + Path)
        else
          List.Add(Path);
      end;
end;

function OpenAtAnchor(const FileName, Anchor: string): Boolean;
var
  Cmd: string;
begin
  SetLength(Cmd, MAX_PATH);
  Result := FindExecutable(PChar(FileName), nil, PChar(Cmd)) > 32;
  SetLength(Cmd, StrLen(PChar(Cmd)));
  if Result then
    Result := ShellExecute(0, 'open', PChar(Cmd), PChar(FileName + '#' + Anchor), nil,
      SW_SHOWNORMAL) > 32;
end;

function IsInArray(const Value: string; const Args: array of string): Integer;
begin
  for Result := 0 to High(Args) do
    if CompareText(Value, Args[Result]) = 0 then
      Exit;
  Result := -1;
end;

procedure FindFiles(const Dir, Mask: string; SubDirs: Boolean; List: TStrings;
  const FileExtensions: array of string);
var
  sr: TSearchRec;
begin
  if FindFirst(Dir + '\' + Mask, faAnyFile or faDirectory, sr) = 0 then
  try
    repeat
      if sr.Attr and faDirectory <> 0 then
      begin
        if (sr.Name <> '.') and (sr.Name <> '..') then
          if SubDirs then
            FindFiles(Dir + '\' + sr.Name, Mask, SubDirs, List, FileExtensions);
      end
      else
      begin
        if (Length(FileExtensions) = 0) or (IsInArray(ExtractFileExt(sr.Name), FileExtensions) <> -1) then
          List.AddObject(Dir + '\' + sr.Name, TObject(sr.Size));
      end;
    until FindNext(sr) <> 0;
  finally
    FindClose(sr);
  end;
end;

end.