paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 04:40:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Fix ExpandFileNameUTF8 for directories with Unicode characters outside

Browse Source 
current codepage on Windows.
Also do not remove trailing and leading spaces, it is inconsistent with
SysUtils.ExpandFileName.
Start splitting implementation in general, unix and windows specific includefiles.

git-svn-id: trunk@40842 -
This commit is contained in:
bart 2013-04-18 18:23:02 +00:00
parent 5afa7d5da1
commit a53520295e
6 changed files with 617 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -2167,6 +2167,7 @@ components/lazutils/lazclasses.pas svneol=native#text/pascal
components/lazutils/lazconfigstorage.pas svneol=native#text/pascal
components/lazutils/lazdbglog.pas svneol=native#text/pascal
components/lazutils/lazfilecache.pas svneol=native#text/pascal
components/lazutils/lazfileutils.inc svneol=native#text/plain
components/lazutils/lazfileutils.pas svneol=native#text/pascal
components/lazutils/lazfreetype.pas svneol=native#text/pascal
components/lazutils/lazfreetypefontcollection.pas svneol=native#text/plain
@ -2207,8 +2208,10 @@ components/lazutils/ttraster_sweep.inc svneol=native#text/pascal
components/lazutils/tttables.pas svneol=native#text/pascal
components/lazutils/tttypes.pas svneol=native#text/pascal
components/lazutils/unixfileutil.inc svneol=native#text/pascal
components/lazutils/unixlazfileutils.inc svneol=native#text/plain
components/lazutils/utf8process.pp svneol=native#text/pascal
components/lazutils/winfileutil.inc svneol=native#text/pascal
components/lazutils/winlazfileutils.inc svneol=native#text/plain
components/leakview/Makefile svneol=native#text/plain
components/leakview/Makefile.compiled svneol=native#text/plain
components/leakview/Makefile.fpc svneol=native#text/plain

142
components/lazutils/lazfileutils.inc Normal file
View File

@ -0,0 +1,142 @@
{%MainUnit lazfileutils.pas}
function ExpandDots(const AFilename: string): String;
//trim double path delims and expand special dirs like .. and .
var SrcPos, DestPos, l, DirStart: integer;
c: char;
MacroPos: LongInt;
begin
Result:=AFilename;
l:=length(AFilename);
SrcPos:=1;
DestPos:=1;
// trim double path delimiters and special dirs . and ..
while (SrcPos<=l) do begin
c:=AFilename[SrcPos];
// check for double path delims
if (c=PathDelim) then begin
inc(SrcPos);
{$IFDEF Windows}
if (DestPos>2)
{$ELSE}
if (DestPos>1)
{$ENDIF}
and (Result[DestPos-1]=PathDelim) then begin
// skip second PathDelim
continue;
end;
Result[DestPos]:=c;
inc(DestPos);
continue;
end;
// check for special dirs . and ..
if (c='.') then begin
if (SrcPos<l) then begin
if (AFilename[SrcPos+1]=PathDelim)
and ((DestPos=1) or (AFilename[SrcPos-1]=PathDelim)) then begin
// special dir ./
// -> skip
inc(SrcPos,2);
continue;
end else if (AFilename[SrcPos+1]='.')
and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim) then
begin
// special dir ..
// 1. .. -> copy
// 2. /.. -> skip .., keep /
// 3. C:.. -> copy
// 4. C:\.. -> skip .., keep C:\
// 5. \\.. -> skip .., keep \\
// 6. xxx../.. -> copy
// 7. xxxdir/.. -> trim dir and skip ..
// 8. xxxdir/.. -> trim dir and skip ..
if DestPos=1 then begin
// 1. .. -> copy
end else if (DestPos=2) and (Result[1]=PathDelim) then begin
// 2. /.. -> skip .., keep /
inc(SrcPos,2);
continue;
{$IFDEF Windows}
end else if (DestPos=3) and (Result[2]=':')
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 3. C:.. -> copy
end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim)
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 4. C:\.. -> skip .., keep C:\
inc(SrcPos,2);
continue;
end else if (DestPos=3) and (Result[1]=PathDelim)
and (Result[2]=PathDelim) then begin
// 5. \\.. -> skip .., keep \\
inc(SrcPos,2);
continue;
{$ENDIF}
end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
if (DestPos>3)
and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
// 6. ../.. -> copy
end else begin
// 7. xxxdir/.. -> trim dir and skip ..
DirStart:=DestPos-2;
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
dec(DirStart);
MacroPos:=DirStart;
while MacroPos<DestPos do begin
if (Result[MacroPos]='$')
and (Result[MacroPos+1] in ['(','a'..'z','A'..'Z']) then begin
// 8. directory contains a macro -> keep
break;
end;
inc(MacroPos);
end;
if MacroPos=DestPos then begin
DestPos:=DirStart;
inc(SrcPos,2);
continue;
end;
end;
end;
end;
end else begin
// special dir . at end of filename
if DestPos=1 then begin
Result:='.';
exit;
end else begin
// skip
break;
end;
end;
end;
// copy directory
repeat
Result[DestPos]:=c;
inc(DestPos);
inc(SrcPos);
if (SrcPos>l) then break;
c:=AFilename[SrcPos];
if c=PathDelim then break;
until false;
end;
// trim result
if DestPos<=length(AFilename) then
SetLength(Result,DestPos-1);
end;
function FilenameIsWinAbsolute(const TheFilename: string): boolean;
begin
Result:=((length(TheFilename)>=3) and
(TheFilename[1] in ['A'..'Z','a'..'z']) and (TheFilename[2]=':') and (TheFilename[3]='\'))
or ((length(TheFilename)>=2) and (TheFilename[1]='\') and (TheFilename[2]='\'))
;
end;
function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
begin
Result:=(TheFilename<>'') and (TheFilename[1]='/');
end;

226
components/lazutils/lazfileutils.pas
View File

@ -45,6 +45,7 @@ function FileIsText(const AFilename: string; out FileReadable: boolean): boolean
function FilenameIsTrimmed(const TheFilename: string): boolean;
function FilenameIsTrimmed(StartPos: PChar; NameLen: integer): boolean;
function TrimFilename(const AFilename: string): string;
function ExpandDots(const AFilename: string): string;
function CleanAndExpandFilename(const Filename: string): string; // empty string returns current directory
function CleanAndExpandDirectory(const Filename: string): string; // empty string returns current directory
function TrimAndExpandFilename(const Filename: string; const BaseDir: string = ''): string; // empty string returns empty string
@ -66,7 +67,7 @@ function FindPathInSearchPath(APath: PChar; APathLen: integer;
function FileExistsUTF8(const Filename: string): boolean;
function FileAgeUTF8(const FileName: string): Longint;
function DirectoryExistsUTF8(const Directory: string): Boolean;
function ExpandFileNameUTF8(const FileName: string; const BaseDir: string = ''): string;
function ExpandFileNameUTF8(const FileName: string; {const} BaseDir: string = ''): string;
function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec): Longint;
function FindNextUTF8(var Rslt: TSearchRec): Longint;
procedure FindCloseUTF8(var F: TSearchrec);
@ -109,6 +110,13 @@ uses
Unix, BaseUnix;
{$ENDIF}
{$I lazfileutils.inc}
{$IFDEF windows}
{$I winlazfileutils.inc}
{$ELSE}
{$I unixlazfileutils.inc}
{$ENDIF}
function CompareFilenames(const Filename1, Filename2: string): integer;
{$IFDEF darwin}
var
@ -273,29 +281,7 @@ begin
Result:=copy(Result,1,length(Result)-ExtLen);
end;
function FilenameIsAbsolute(const TheFilename: string):boolean;
begin
{$IFDEF Windows}
// windows
Result:=FilenameIsWinAbsolute(TheFilename);
{$ELSE}
// unix
Result:=FilenameIsUnixAbsolute(TheFilename);
{$ENDIF}
end;
function FilenameIsWinAbsolute(const TheFilename: string): boolean;
begin
Result:=((length(TheFilename)>=2) and (TheFilename[1] in ['A'..'Z','a'..'z'])
and (TheFilename[2]=':'))
or ((length(TheFilename)>=2)
and (TheFilename[1]='\') and (TheFilename[2]='\'));
end;
function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
begin
Result:=(TheFilename<>'') and (TheFilename[1]='/');
end;
{$IFDEF darwin}
function GetDarwinSystemFilename(Filename: string): string;
@ -611,137 +597,23 @@ begin
end;
function TrimFilename(const AFilename: string): string;
// trim double path delims, heading and trailing spaces
// and special dirs . and ..
var SrcPos, DestPos, l, DirStart: integer;
c: char;
MacroPos: LongInt;
//Trim leading and trailing spaces
//then call ExpandDots to trim double path delims and expand special dirs like .. and .
var
Len, Start: Integer;
begin
Result:=AFilename;
if FilenameIsTrimmed(Result) then exit;
l:=length(AFilename);
SrcPos:=1;
DestPos:=1;
// skip trailing spaces
while (l>=1) and (AFilename[l]=' ') do dec(l);
// skip heading spaces
while (SrcPos<=l) and (AFilename[SrcPos]=' ') do inc(SrcPos);
// trim double path delimiters and special dirs . and ..
while (SrcPos<=l) do begin
c:=AFilename[SrcPos];
// check for double path delims
if (c=PathDelim) then begin
inc(SrcPos);
{$IFDEF Windows}
if (DestPos>2)
{$ELSE}
if (DestPos>1)
{$ENDIF}
and (Result[DestPos-1]=PathDelim) then begin
// skip second PathDelim
continue;
end;
Result[DestPos]:=c;
inc(DestPos);
continue;
end;
// check for special dirs . and ..
if (c='.') then begin
if (SrcPos<l) then begin
if (AFilename[SrcPos+1]=PathDelim)
and ((DestPos=1) or (AFilename[SrcPos-1]=PathDelim)) then begin
// special dir ./
// -> skip
inc(SrcPos,2);
continue;
end else if (AFilename[SrcPos+1]='.')
and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim) then
begin
// special dir ..
// 1. .. -> copy
// 2. /.. -> skip .., keep /
// 3. C:.. -> copy
// 4. C:\.. -> skip .., keep C:\
// 5. \\.. -> skip .., keep \\
// 6. xxx../.. -> copy
// 7. xxxdir/.. -> trim dir and skip ..
// 8. xxxdir/.. -> trim dir and skip ..
if DestPos=1 then begin
// 1. .. -> copy
end else if (DestPos=2) and (Result[1]=PathDelim) then begin
// 2. /.. -> skip .., keep /
inc(SrcPos,2);
continue;
{$IFDEF Windows}
end else if (DestPos=3) and (Result[2]=':')
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 3. C:.. -> copy
end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim)
and (Result[1] in ['a'..'z','A'..'Z']) then begin
// 4. C:\.. -> skip .., keep C:\
inc(SrcPos,2);
continue;
end else if (DestPos=3) and (Result[1]=PathDelim)
and (Result[2]=PathDelim) then begin
// 5. \\.. -> skip .., keep \\
inc(SrcPos,2);
continue;
{$ENDIF}
end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
if (DestPos>3)
and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
// 6. ../.. -> copy
end else begin
// 7. xxxdir/.. -> trim dir and skip ..
DirStart:=DestPos-2;
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
dec(DirStart);
MacroPos:=DirStart;
while MacroPos<DestPos do begin
if (Result[MacroPos]='$')
and (Result[MacroPos+1] in ['(','a'..'z','A'..'Z']) then begin
// 8. directory contains a macro -> keep
break;
end;
inc(MacroPos);
end;
if MacroPos=DestPos then begin
DestPos:=DirStart;
inc(SrcPos,2);
continue;
end;
end;
end;
end;
end else begin
// special dir . at end of filename
if DestPos=1 then begin
Result:='.';
exit;
end else begin
// skip
break;
end;
end;
end;
// copy directory
repeat
Result[DestPos]:=c;
inc(DestPos);
inc(SrcPos);
if (SrcPos>l) then break;
c:=AFilename[SrcPos];
if c=PathDelim then break;
until false;
Result := AFileName;
Len := Length(AFileName);
if (Len > 0) and not FilenameIsTrimmed(Result) then
begin
Start := 1;
while (Len > 0) and (AFileName[Len] = #32) do Dec(Len);
while (Start <= Len) and (AFilename[Start] = #32) do Inc(Start);
if Start > 1 then System.Delete(Result,1,Start-1);
SetLength(Result, Len - (Start - 1));
Result := ExpandDots(Result);
end;
// trim result
if DestPos<=length(AFilename) then
SetLength(Result,DestPos-1);
end;
{------------------------------------------------------------------------------
@ -1164,48 +1036,6 @@ begin
Result:=SysUtils.DirectoryExists(UTF8ToSys(Directory));
end;
function ExpandFileNameUTF8(const FileName: string; const BaseDir: string): string;
{$IFDEF Unix}
{$DEFINE ExpandTilde}
{$ENDIF}
{$IFDEF Windows}
{$DEFINE UppercaseDrive}
{$ENDIF}
{$IFDEF ExpandTilde}
var
HomeDir: String;
{$ENDIF}
begin
Result:=FileName;
if Result='' then exit('');
Result:=SetDirSeparators(Result);
if BaseDir='' then
begin
// use RTL function, which uses GetCurrentDir
Result:=SysToUTF8(SysUtils.ExpandFileName(UTF8ToSys(Result)));
end else begin
{$IFDEF ExpandTilde}
// expand ~
if (Result<>'') and (Result[1]='~') then
begin
{$Hint use GetEnvironmentVariableUTF8}
HomeDir := TrimAndExpandDirectory(GetEnvironmentVariable('HOME'));
Result := HomeDir+copy(Result,2,length(Result));
end;
{$ENDIF}
// trim
Result := TrimFilename(Result);
{$IFDEF UppercaseDrive}
if (Length(Result)>=2) and (Result[1] in ['a'..'z']) and (Result[2]=':') then
Result[1]:=chr(ord(Result[1])+ord('A')-ord('a'));
{$ENDIF}
// ToDo: expand C:a
// make absolute
if not FilenameIsAbsolute(Result) then
Result := TrimAndExpandDirectory(BaseDir) + Result;
end;
end;
function FindFirstUTF8(const Path: string; Attr: Longint; out Rslt: TSearchRec
): Longint;
@ -1267,11 +1097,6 @@ begin
Result:=SysUtils.FileIsReadOnly(UTF8ToSys(Filename));
end;
function GetCurrentDirUTF8: String;
begin
Result:=SysToUTF8(SysUtils.GetCurrentDir);
end;
function SetCurrentDirUTF8(const NewDir: String): Boolean;
begin
Result:=SysUtils.SetCurrentDir(UTF8ToSys(NewDir));
@ -1444,5 +1269,8 @@ begin
end;
{$ENDIF}
initialization
InitLazFileUtils;
end.

230
components/lazutils/lazutils.lpk
View File

@ -19,7 +19,7 @@
<Description Value="Useful units for Lazarus packages."/>
<License Value="Modified LGPL-2"/>
<Version Major="1"/>
<Files Count="68">
<Files Count="71">
<Item1>
<Filename Value="laz2_dom.pas"/>
<UnitName Value="laz2_DOM"/>
@ -69,230 +69,242 @@
<UnitName Value="LazFileUtils"/>
</Item12>
<Item13>
<Filename Value="lazfilecache.pas"/>
<UnitName Value="LazFileCache"/>
<Filename Value="lazfileutils.inc"/>
<Type Value="Include"/>
</Item13>
<Item14>
<Filename Value="luresstrings.pas"/>
<UnitName Value="LUResStrings"/>
<Filename Value="unixlazfileutils.inc"/>
<Type Value="Include"/>
</Item14>
<Item15>
<Filename Value="lazutf8.pas"/>
<UnitName Value="LazUTF8"/>
<Filename Value="winlazfileutils.inc"/>
<Type Value="Include"/>
</Item15>
<Item16>
<Filename Value="lazdbglog.pas"/>
<UnitName Value="LazDbgLog"/>
<Filename Value="lazfilecache.pas"/>
<UnitName Value="LazFileCache"/>
</Item16>
<Item17>
<Filename Value="paswstring.pas"/>
<UnitName Value="paswstring"/>
<Filename Value="luresstrings.pas"/>
<UnitName Value="LUResStrings"/>
</Item17>
<Item18>
<Filename Value="fileutil.pas"/>
<UnitName Value="FileUtil"/>
<Filename Value="lazutf8.pas"/>
<UnitName Value="LazUTF8"/>
</Item18>
<Item19>
<Filename Value="lazutf8classes.pas"/>
<UnitName Value="lazutf8classes"/>
<Filename Value="lazdbglog.pas"/>
<UnitName Value="LazDbgLog"/>
</Item19>
<Item20>
<Filename Value="masks.pas"/>
<UnitName Value="Masks"/>
<Filename Value="paswstring.pas"/>
<UnitName Value="paswstring"/>
</Item20>
<Item21>
<Filename Value="unixfileutil.inc"/>
<Type Value="Include"/>
<Filename Value="fileutil.pas"/>
<UnitName Value="FileUtil"/>
</Item21>
<Item22>
<Filename Value="winfileutil.inc"/>
<Type Value="Include"/>
<Filename Value="lazutf8classes.pas"/>
<UnitName Value="lazutf8classes"/>
</Item22>
<Item23>
<Filename Value="fileutil.inc"/>
<Type Value="Include"/>
<Filename Value="masks.pas"/>
<UnitName Value="Masks"/>
</Item23>
<Item24>
<Filename Value="lazutilsstrconsts.pas"/>
<UnitName Value="LazUtilsStrConsts"/>
<Filename Value="unixfileutil.inc"/>
<Type Value="Include"/>
</Item24>
<Item25>
<Filename Value="lconvencoding.pas"/>
<UnitName Value="LConvEncoding"/>
<Filename Value="winfileutil.inc"/>
<Type Value="Include"/>
</Item25>
<Item26>
<Filename Value="asiancodepages.inc"/>
<Filename Value="fileutil.inc"/>
<Type Value="Include"/>
</Item26>
<Item27>
<Filename Value="asiancodepagefunctions.inc"/>
<Type Value="Include"/>
<Filename Value="lazutilsstrconsts.pas"/>
<UnitName Value="LazUtilsStrConsts"/>
</Item27>
<Item28>
<Filename Value="lazutf16.pas"/>
<UnitName Value="lazutf16"/>
<Filename Value="lconvencoding.pas"/>
<UnitName Value="LConvEncoding"/>
</Item28>
<Item29>
<Filename Value="lazutf8sysutils.pas"/>
<UnitName Value="lazutf8sysutils"/>
<Filename Value="asiancodepages.inc"/>
<Type Value="Include"/>
</Item29>
<Item30>
<Filename Value="lazmethodlist.pas"/>
<UnitName Value="LazMethodList"/>
<Filename Value="asiancodepagefunctions.inc"/>
<Type Value="Include"/>
</Item30>
<Item31>
<Filename Value="avglvltree.pas"/>
<UnitName Value="AvgLvlTree"/>
<Filename Value="lazutf16.pas"/>
<UnitName Value="lazutf16"/>
</Item31>
<Item32>
<Filename Value="lazlogger.pas"/>
<UnitName Value="LazLogger"/>
<Filename Value="lazutf8sysutils.pas"/>
<UnitName Value="lazutf8sysutils"/>
</Item32>
<Item33>
<Filename Value="lazfreetype.pas"/>
<UnitName Value="LazFreeType"/>
<Filename Value="lazmethodlist.pas"/>
<UnitName Value="LazMethodList"/>
</Item33>
<Item34>
<Filename Value="Makefile"/>
<Type Value="Text"/>
<Filename Value="avglvltree.pas"/>
<UnitName Value="AvgLvlTree"/>
</Item34>
<Item35>
<Filename Value="Makefile.compiled"/>
<Type Value="Text"/>
<Filename Value="lazlogger.pas"/>
<UnitName Value="LazLogger"/>
</Item35>
<Item36>
<Filename Value="Makefile.fpc"/>
<Type Value="Text"/>
<Filename Value="lazfreetype.pas"/>
<UnitName Value="LazFreeType"/>
</Item36>
<Item37>
<Filename Value="ttcache.pas"/>
<UnitName Value="TTCache"/>
<Filename Value="Makefile"/>
<Type Value="Text"/>
</Item37>
<Item38>
<Filename Value="ttcalc.pas"/>
<UnitName Value="TTCalc"/>
<Filename Value="Makefile.compiled"/>
<Type Value="Text"/>
</Item38>
<Item39>
<Filename Value="ttcalc1.inc"/>
<Type Value="Include"/>
<Filename Value="Makefile.fpc"/>
<Type Value="Text"/>
</Item39>
<Item40>
<Filename Value="ttcalc2.inc"/>
<Type Value="Include"/>
<Filename Value="ttcache.pas"/>
<UnitName Value="TTCache"/>
</Item40>
<Item41>
<Filename Value="ttcalc3.inc"/>
<Type Value="Include"/>
<Filename Value="ttcalc.pas"/>
<UnitName Value="TTCalc"/>
</Item41>
<Item42>
<Filename Value="ttcalc4.inc"/>
<Filename Value="ttcalc1.inc"/>
<Type Value="Include"/>
</Item42>
<Item43>
<Filename Value="ttcmap.pas"/>
<UnitName Value="TTCMap"/>
<Filename Value="ttcalc2.inc"/>
<Type Value="Include"/>
</Item43>
<Item44>
<Filename Value="ttconfig.inc"/>
<Filename Value="ttcalc3.inc"/>
<Type Value="Include"/>
</Item44>
<Item45>
<Filename Value="ttdebug.pas"/>
<UnitName Value="TTDebug"/>
<Filename Value="ttcalc4.inc"/>
<Type Value="Include"/>
</Item45>
<Item46>
<Filename Value="tterror.pas"/>
<UnitName Value="TTError"/>
<Filename Value="ttcmap.pas"/>
<UnitName Value="TTCMap"/>
</Item46>
<Item47>
<Filename Value="ttfile.pas"/>
<UnitName Value="TTFile"/>
<Filename Value="ttconfig.inc"/>
<Type Value="Include"/>
</Item47>
<Item48>
<Filename Value="ttgload.pas"/>
<UnitName Value="TTGLoad"/>
<Filename Value="ttdebug.pas"/>
<UnitName Value="TTDebug"/>
</Item48>
<Item49>
<Filename Value="ttinterp.pas"/>
<UnitName Value="TTInterp"/>
<Filename Value="tterror.pas"/>
<UnitName Value="TTError"/>
</Item49>
<Item50>
<Filename Value="ttload.pas"/>
<UnitName Value="TTLoad"/>
<Filename Value="ttfile.pas"/>
<UnitName Value="TTFile"/>
</Item50>
<Item51>
<Filename Value="ttmemory.pas"/>
<UnitName Value="TTMemory"/>
<Filename Value="ttgload.pas"/>
<UnitName Value="TTGLoad"/>
</Item51>
<Item52>
<Filename Value="ttobjs.pas"/>
<UnitName Value="TTObjs"/>
<Filename Value="ttinterp.pas"/>
<UnitName Value="TTInterp"/>
</Item52>
<Item53>
<Filename Value="ttprofile.pas"/>
<UnitName Value="TTProfile"/>
<Filename Value="ttload.pas"/>
<UnitName Value="TTLoad"/>
</Item53>
<Item54>
<Filename Value="ttraster_sweep.inc"/>
<Type Value="Include"/>
<Filename Value="ttmemory.pas"/>
<UnitName Value="TTMemory"/>
</Item54>
<Item55>
<Filename Value="ttraster.pas"/>
<UnitName Value="TTRASTER"/>
<Filename Value="ttobjs.pas"/>
<UnitName Value="TTObjs"/>
</Item55>
<Item56>
<Filename Value="tttables.pas"/>
<UnitName Value="TTTables"/>
<Filename Value="ttprofile.pas"/>
<UnitName Value="TTProfile"/>
</Item56>
<Item57>
<Filename Value="tttypes.pas"/>
<UnitName Value="TTTypes"/>
<Filename Value="ttraster_sweep.inc"/>
<Type Value="Include"/>
</Item57>
<Item58>
<Filename Value="easylazfreetype.pas"/>
<UnitName Value="EasyLazFreeType"/>
<Filename Value="ttraster.pas"/>
<UnitName Value="TTRASTER"/>
</Item58>
<Item59>
<Filename Value="lazloggerbase.pas"/>
<UnitName Value="LazLoggerBase"/>
<Filename Value="tttables.pas"/>
<UnitName Value="TTTables"/>
</Item59>
<Item60>
<Filename Value="LazLoggerIntf.inc"/>
<Type Value="Include"/>
<Filename Value="tttypes.pas"/>
<UnitName Value="TTTypes"/>
</Item60>
<Item61>
<Filename Value="lazloggerdummy.pas"/>
<UnitName Value="LazLoggerDummy"/>
<Filename Value="easylazfreetype.pas"/>
<UnitName Value="EasyLazFreeType"/>
</Item61>
<Item62>
<Filename Value="lazclasses.pas"/>
<UnitName Value="LazClasses"/>
<Filename Value="lazloggerbase.pas"/>
<UnitName Value="LazLoggerBase"/>
</Item62>
<Item63>
<Filename Value="lazfreetypefontcollection.pas"/>
<UnitName Value="LazFreeTypeFontCollection"/>
<Filename Value="LazLoggerIntf.inc"/>
<Type Value="Include"/>
</Item63>
<Item64>
<Filename Value="LazLoggerImpl.inc"/>
<Type Value="Include"/>
<Filename Value="lazloggerdummy.pas"/>
<UnitName Value="LazLoggerDummy"/>
</Item64>
<Item65>
<Filename Value="lazconfigstorage.pas"/>
<UnitName Value="LazConfigStorage"/>
<Filename Value="lazclasses.pas"/>
<UnitName Value="LazClasses"/>
</Item65>
<Item66>
<Filename Value="lazfreetypefontcollection.pas"/>
<UnitName Value="LazFreeTypeFontCollection"/>
</Item66>
<Item67>
<Filename Value="LazLoggerImpl.inc"/>
<Type Value="Include"/>
</Item67>
<Item68>
<Filename Value="lazconfigstorage.pas"/>
<UnitName Value="LazConfigStorage"/>
</Item68>
<Item69>
<Filename Value="utf8process.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="UTF8Process"/>
</Item66>
<Item67>
</Item69>
<Item70>
<Filename Value="laz2_xpath.pas"/>
<UnitName Value="laz2_xpath"/>
</Item67>
<Item68>
</Item70>
<Item71>
<Filename Value="dictionarystringlist.pas"/>
<UnitName Value="dictionarystringlist"/>
</Item68>
</Item71>
</Files>
<LazDoc Paths="../../docs/xml/lazutils"/>
<i18n>

58
components/lazutils/unixlazfileutils.inc Normal file
View File

@ -0,0 +1,58 @@
{%MainUnit lazfileutils.pas}
function FilenameIsAbsolute(const TheFilename: string):boolean;
begin
Result:=FilenameIsUnixAbsolute(TheFilename);
end;
function ExpandFileNameUtf8(const FileName: string; {const} BaseDir: String = ''): String;
var
IsAbs: Boolean;
CurDir, HomeDir, Fn: String;
begin
Fn := FileName;
DoDirSeparators(Fn);
IsAbs := FileNameIsUnixAbsolute(Fn);
if (not IsAbs) then
begin
CurDir := GetCurrentDirUtf8;
if ((Length(Fn) > 1) and (Fn[1] = '~') and (Fn[2] = '/')) or (Fn = '~') then
begin
{$Hint use GetEnvironmentVariableUTF8}
HomeDir := SysToUtf8(GetEnvironmentVariable('HOME'));
if not FileNameIsUnixAbsolute(HomeDir) then
HomeDir := ExpandFileNameUtf8(HomeDir,'');
Fn := HomeDir + Copy(Fn,2,length(Fn));
IsAbs := True;
end;
end;
if IsAbs then
begin
Result := ExpandDots(Fn);
end
else
begin
if (BaseDir = '') then
Fn := IncludeTrailingPathDelimiter(CurDir) + Fn
else
Fn := IncludeTrailingPathDelimiter(BaseDir) + Fn;
Fn := ExpandDots(Fn);
//if BaseDir is not absolute then this needs to be expanded as well
if not FileNameIsUnixAbsolute(Fn) then
Fn := ExpandFileNameUtf8(Fn, '');
Result := Fn;
end;
end;
function GetCurrentDirUTF8: String;
begin
Result:=SysToUTF8(SysUtils.GetCurrentDir);
end;
procedure InitLazFileUtils;
begin
//dummy
end;

266
components/lazutils/winlazfileutils.inc Normal file
View File

@ -0,0 +1,266 @@
{%MainUnit lazfileutils.pas}
var
//procedural variables for procedures that are implemented different on Win9x and NT or WinCE platform
//They are intialized in InitLazFileUtils
//FileAge_ : function (const Filename:string):Longint;
//FileSize_ : function (const Filename: string): int64;
//FileSetDate_ : function (const FileName: String; Age: Longint): Longint;
//FindFirst_ : function (const Path: string; Attr: Longint;
// out Rslt: TSearchRec): Longint;
//FindNext_ : function (var Rslt: TSearchRec): Longint;
//FindClose_ : procedure (var F: TSearchrec);
//FileGetAttr_ : function (const FileName: String): Longint;
//FileSetAttr_ : function (const Filename: String; Attr: longint): Longint;
//DeleteFile_ : function (const FileName: String): Boolean;
//RenameFile_ : function (const OldName, NewName: String): Boolean;
_GetCurrentDirUtf8 : function : String ;
_GetDirUtf8 : procedure (DriveNr: Byte; var Dir: String);
//SetCurrentDir_ : function (const NewDir: String): Boolean;
//CreateDir_ : function (const NewDir: String): Boolean;
//RemoveDir_ : function (const Dir: String): Boolean ;
function FilenameIsAbsolute(const TheFilename: string):boolean;
begin
Result:=FilenameIsWinAbsolute(TheFilename);
end;
function ExpandFileNameUtf8(const FileName: string; {const} BaseDir: String = ''): String;
var
IsAbs, StartsWithRoot, CanUseBaseDir : Boolean;
{$ifndef WinCE}
HasDrive: Boolean;
FnDrive, CurDrive, BaseDirDrive: Char;
{$endif}
CurDir, Fn: String;
begin
//writeln('LazFileUtils.ExpandFileNameUtf8');
//writeln('FileName = "',FileName,'"');
//writeln('BaseDir = "',BaseDir,'"');
//{$ifndef WinCE}
//if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then
// Result := SysToUtf8(SysUtils.ExpandFileName(Utf8ToSys(FileName)))
//else
//{$endif}
Fn := FileName;
DoDirSeparators(Fn);
IsAbs := FileNameIsWinAbsolute(Fn);
if not IsAbs then
begin
StartsWithRoot := (Length(Fn) > 1) and
(Fn[1] = DirectorySeparator) and
(Fn[2] <> DirectorySeparator);
{$ifndef WinCE}
HasDrive := (Length(Fn) > 1) and
(Fn[2] = ':') and
(UpCase(Fn[1]) in ['A'..'Z']);
if HasDrive then
begin
FnDrive := UpCase(Fn[1]);
_GetDirUtf8(Byte(FnDrive)-64, CurDir);
CurDrive := UpCase(GetCurrentDirUtf8[1]);
end
else
begin
CurDir := GetCurrentDirUtf8;
FnDrive := UpCase(CurDir[1]);
CurDrive := FnDrive;
end;
//writeln('HasDrive = ',HasDrive,' Fn = ',Fn);
//writeln('CurDir = ',CurDir);
//writeln('CurDrive = ',CurDrive);
//writeln('FnDrive = ',FnDrive);
if (Length(BaseDir) > 1) and (UpCase(BaseDir[1]) in ['A'..'Z']) and (BaseDir[2] = ':') then
begin
BaseDirDrive := BaseDir[1]
end
else
begin
if HasDrive then
BaseDirDrive := CurDrive
else
BaseDirDrive := #0;
end;
//You cannot use BaseDir if both FileName and BaseDir includes a drive and they are not the same
CanUseBaseDir := ((BaseDirDrive = #0) or
(not HasDrive) or
(HasDrive and (FnDrive = BaseDirDrive)))
and (BaseDir <> '');
//writeln('CanUseBaseDir = ',CanUseBaseDir);
if not HasDrive and StartsWithRoot and not CanUseBaseDir then
begin
//writeln('HasDrive and StartsWithRoot');
Fn := Copy(CurDir,1,2) + Fn;
HasDrive := True;
IsAbs := True;
end;
//FileNames like C:foo, strip Driveletter + colon
if HasDrive and not IsAbs then Delete(Fn,1,2);
//writeln('HasDrive = ',Hasdrive,' Fn = ',Fn);
{$else}
CanUseBaseDir := True;
{$endif WinCE}
end;
if IsAbs then
begin
//writeln('IsAbs = True -> Exit');
Result := ExpandDots(Fn);
end
else
begin
if not CanUseBaseDir or (BaseDir = '') then
Fn := IncludeTrailingPathDelimiter(CurDir) + Fn
else
begin
if (Fn[1] = DirectorySeparator) then Delete(Fn,1,1);
Fn := IncludeTrailingPathDelimiter(BaseDir) + Fn;
end;
Fn := ExpandDots(Fn);
//if BaseDir is something like 'z:foo\' or '\' then this needs to be expanded as well
if not FileNameIsAbsolute(Fn) then
Fn := ExpandFileNameUtf8(Fn, '');
Result := Fn;
end;
end;
function GetCurrentDirUTF8: String;
begin
Result:=_GetCurrentDirUtf8();
end;
procedure GetDirUtf8(DriveNr: Byte; var Dir: String);
begin
_GetDirUtf8(DriveNr, Dir);
end;
{$ifndef WinCE}
//No ANSII functions on WinCE
function GetCurrentDirAnsi: String;
begin
Result:=SysToUTF8(SysUtils.GetCurrentDir);
end;
procedure GetDirAnsi(DriveNr: Byte; var Dir: String);
begin
GetDir(DriveNr, Dir);
Dir := SysToUtf8(Dir);
end;
{$endif WinCE}
//WideString functions
function GetCurrentDirWide: String;
var
w : WideString;
res : Integer;
begin
{$ifdef WinCE}
Result := '\';
// Previously we sent an exception here, which is correct, but this causes
// trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
// Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
{$else}
res:=GetCurrentDirectoryW(0, nil);
SetLength(w, res);
res:=Windows.GetCurrentDirectoryW(res, @w[1]);
SetLength(w, res);
Result:=UTF8Encode(w);
{$endif}
end;
procedure GetDirWide(DriveNr: Byte; var Dir: String);
{This procedure may not be threadsafe, because SetCurrentDirectory isn't}
var
w, D: WideString;
SavedDir: WideString;
res : Integer;
begin
{$ifdef WinCE}
Dir := '\';
// Previously we sent an exception here, which is correct, but this causes
// trouble with code which isnt tested for WinCE, so lets just send a dummy result instead
// Exception.Create('[GetCurrentDirWide] The concept of the current directory doesn''t exist in Windows CE');
{$else}
//writeln('GetDirWide START');
if not (DriveNr = 0) then
begin
res := GetCurrentDirectoryW(0, nil);
SetLength(SavedDir, res);
res:=Windows.GetCurrentDirectoryW(res, @SavedDir[1]);
SetLength(SavedDir,res);
D := WideChar(64 + DriveNr) + ':';
if not SetCurrentDirectoryW(@D[1]) then
begin
Dir := Char(64 + DriveNr) + ':\';
SetCurrentDirectoryW(@SavedDir[1]);
Exit;
end;
end;
res := GetCurrentDirectoryW(0, nil);
SetLength(w, res);
res := GetCurrentDirectoryW(res, @w[1]);
SetLength(w, res);
Dir:=UTF8Encode(w);
if not (DriveNr = 0) then SetCurrentDirectoryW(@SavedDir[1]);
//writeln('GetDirWide END');
{$endif}
end;
procedure InitLazFileUtils;
begin
{$ifndef WinCE}
if Win32MajorVersion <= 4 then
begin
//FileAge_ := @FileAgeAnsi;
//FileSize_ := @FileSizeAnsi;
//FileSetDate_ := @FileSetDateAnsi;
//FileGetAttr_ := @FileGetAttrAnsi;
//FileSetAttr_ := @FileSetAttrAnsi;
//DeleteFile_ := @DeleteFileAnsi;
//RenameFile_ := @RenameFileAnsi;
//SetCurrentDir_ := @SetCurrentDirAnsi;
_GetCurrentDirUtf8 := @GetCurrentDirAnsi;
_GetDirUtf8 := @GetDirAnsi;
//CreateDir_ := @CreateDirAnsi;
//RemoveDir_ := @RemoveDirAnsi;
//FindFirst_ := @FindFirstAnsi;
//FindNext_ := @FindNextAnsi;
//FindClose_ := @FindCloseAnsi;
end
else
{$endif}
begin
//FileAge_ := @FileAgeWide;
//FileSize_ := @FileSizeWide;
//FileSetDate_ := @FileSetDateWide;
//FileGetAttr_ := @FileGetAttrWide;
//FileSetAttr_ := @FileSetAttrWide;
//DeleteFile_ := @DeleteFileWide;
//RenameFile_ := @RenameFileWide;
//SetCurrentDir_ := @SetCurrentDirWide;
_GetCurrentDirUtf8 :=@ GetCurrentDirWide;
_GetDirUtf8 := @GetDirWide;
//CreateDir_ := @CreateDirWide;
//RemoveDir_ := @RemoveDirWide;
//FindFirst_ := @FindFirstWide;
//FindNext_ := @FindNextWide;
//FindClose_ := @FindCloseWide;
end;
end;