david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
547 lines
14 KiB
ObjectPascal
547 lines
14 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: Utils.pas 10872 2006-08-09 17:03:16Z outchy $
|
|
|
|
unit Utils;
|
|
|
|
{$I installer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, ShellAPI, SysUtils, Classes;
|
|
|
|
{$IFDEF COMPILER5}
|
|
const
|
|
sLineBreak = #13#10;
|
|
PathDelim = '\';
|
|
{$ENDIF COMPILER5}
|
|
|
|
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;
|
|
|
|
{$IFDEF COMPILER5}
|
|
type
|
|
IInterface = IUnknown;
|
|
|
|
function Supports(const Intf: IInterface; const IID: TGUID): Boolean; overload;
|
|
|
|
function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;
|
|
function GetEnvironmentVariable(const Name: string): string;
|
|
function ExcludeTrailingPathDelimiter(const Path: string): string;
|
|
{$ENDIF COMPIELR5}
|
|
|
|
function AnsiStartsText(const SubStr, Text: string): Boolean;
|
|
|
|
|
|
procedure LockControl(AHandle: THandle);
|
|
procedure UnlockControl(AHandle: THandle);
|
|
|
|
implementation
|
|
|
|
{$IFDEF COMPILER6_UP}
|
|
uses
|
|
StrUtils;
|
|
{$ENDIF COMPILER6_UP}
|
|
|
|
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
|
|
{$IFDEF COMPILER5}
|
|
Result := AnsiStrLIComp(PChar(SubStr), PChar(Text), Length(SubStr)) = 0;
|
|
{$ELSE}
|
|
Result := StrUtils.AnsiStartsText(SubStr, Text);
|
|
{$ENDIF COMPILER5}
|
|
end;
|
|
|
|
{$IFDEF COMPILER5}
|
|
function ExcludeTrailingPathDelimiter(const Path: string): string;
|
|
begin
|
|
if (Path <> '') and (Path[Length(Path)] = '\') then // Delphi 5 only knows Windows
|
|
Result := Copy(Path, 1, Length(Path) - 1)
|
|
else
|
|
Result := Path;
|
|
end;
|
|
|
|
function GetEnvironmentVariable(const Name: string): string;
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
SetLength(Result, 8 * 1024);
|
|
Len := Windows.GetEnvironmentVariable(PChar(Name), PChar(Result), Length(Result));
|
|
if Len > Length(Result) then
|
|
begin
|
|
SetLength(Result, Len);
|
|
Len := Windows.GetEnvironmentVariable(PChar(Name), PChar(Result), Length(Result));
|
|
end;
|
|
SetLength(Result, Len);
|
|
end;
|
|
{$ENDIF COMPIELR5}
|
|
|
|
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;
|
|
|
|
{$IFDEF COMPILER5}
|
|
function Supports(const Intf: IInterface; const IID: TGUID): Boolean; overload;
|
|
var
|
|
TempIntf: IInterface;
|
|
begin
|
|
Result := Supports(Intf, IID, TempIntf);
|
|
end;
|
|
|
|
function FileSetReadOnly(const FileName: string; ReadOnly: Boolean): Boolean;
|
|
var
|
|
Attr: Cardinal;
|
|
begin
|
|
Result := False;
|
|
Attr := GetFileAttributes(PChar(FileName));
|
|
if Attr = $FFFFFFFF then
|
|
Exit;
|
|
if ReadOnly then
|
|
Attr := Attr or FILE_ATTRIBUTE_READONLY
|
|
else
|
|
Attr := Attr and not FILE_ATTRIBUTE_READONLY;
|
|
SetFileAttributes(PChar(FileName), Attr);
|
|
end;
|
|
{$ENDIF COMPILER5}
|
|
|
|
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.
|