paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-04 23:58:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: move more Utf8 file routines to LazFileUtils (and inline them in FileUtil):

Browse Source 
ForceDirectoriesUTF8.

git-svn-id: trunk@41374 -
This commit is contained in:
bart 2013-05-23 17:26:47 +00:00
parent 9d7979342e
commit 42315809a3
3 changed files with 46 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
components/lazutils/fileutil.inc
View File

@ -1282,50 +1282,8 @@ end;
function ForceDirectoriesUTF8(const Dir: string): Boolean;
------------------------------------------------------------------------------}
function ForceDirectoriesUTF8(const Dir: string): Boolean;
var
E: EInOutError;
ADrv : String;
function DoForceDirectories(Const Dir: string): Boolean;
var
ADir : String;
APath: String;
begin
Result:=True;
ADir:=ExcludeTrailingPathDelimiter(Dir);
if (ADir='') then Exit;
if Not DirectoryExistsUTF8(ADir) then
begin
APath := ExtractFilePath(ADir);
//this can happen on Windows if user specifies Dir like \user\name/test/
//and would, if not checked for, cause an infinite recusrsion and a stack overflow
if (APath = ADir) then
Result := False
else
Result:=DoForceDirectories(APath);
if Result then
Result := CreateDirUTF8(ADir);
end;
end;
function IsUncDrive(const Drv: String): Boolean;
begin
Result := (Length(Drv) > 2) and (Drv[1] = PathDelim) and (Drv[2] = PathDelim);
end;
begin
Result := False;
ADrv := ExtractFileDrive(Dir);
if (ADrv<>'') and (not DirectoryExistsUTF8(ADrv))
{$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
if Dir='' then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);
E.ErrorCode:=3;
Raise E;
end;
Result := DoForceDirectories(SetDirSeparators(Dir));
Result := LazFileUtils.ForceDirectoriesUTF8(Dir);
end;
{------------------------------------------------------------------------------

2
components/lazutils/fileutil.pas
View File

@ -261,7 +261,7 @@ function GetCurrentDirUTF8: String; inline;
function SetCurrentDirUTF8(const NewDir: String): Boolean; inline;
function CreateDirUTF8(const NewDir: String): Boolean; inline;
function RemoveDirUTF8(const Dir: String): Boolean; inline;
function ForceDirectoriesUTF8(const Dir: string): Boolean;
function ForceDirectoriesUTF8(const Dir: string): Boolean; inline;
function FileOpenUTF8(Const FileName : string; Mode : Integer) : THandle; inline;
function FileCreateUTF8(Const FileName : string) : THandle; overload; inline;
function FileCreateUTF8(Const FileName : string; Rights: Cardinal) : THandle; overload; inline;

45
components/lazutils/lazfileutils.pas
View File

@ -6,6 +6,7 @@ interface
uses
Classes, SysUtils, LazUTF8, LazUtf8Classes,
SysConst,
{$IFDEF Windows}
LUResStrings,
{$ENDIF}
@ -1020,10 +1021,52 @@ end;
function ForceDirectoriesUTF8(const Dir: string): Boolean;
var
E: EInOutError;
ADrv : String;
function DoForceDirectories(Const Dir: string): Boolean;
var
ADir : String;
APath: String;
begin
Result:=True;
ADir:=ExcludeTrailingPathDelimiter(Dir);
if (ADir='') then Exit;
if Not DirectoryExistsUTF8(ADir) then
begin
APath := ExtractFilePath(ADir);
//this can happen on Windows if user specifies Dir like \user\name/test/
//and would, if not checked for, cause an infinite recusrsion and a stack overflow
if (APath = ADir) then
Result := False
else
Result:=DoForceDirectories(APath);
if Result then
Result := CreateDirUTF8(ADir);
end;
end;
function IsUncDrive(const Drv: String): Boolean;
begin
Result := (Length(Drv) > 2) and (Drv[1] = PathDelim) and (Drv[2] = PathDelim);
end;
begin
Result:=SysUtils.ForceDirectories(UTF8ToSys(Dir));
Result := False;
ADrv := ExtractFileDrive(Dir);
if (ADrv<>'') and (not DirectoryExistsUTF8(ADrv))
{$IFNDEF FORCEDIR_NO_UNC_SUPPORT} and (not IsUncDrive(ADrv)){$ENDIF} then Exit;
if Dir='' then
begin
E:=EInOutError.Create(SCannotCreateEmptyDir);
E.ErrorCode:=3;
Raise E;
end;
Result := DoForceDirectories(SetDirSeparators(Dir));
end;
procedure InvalidateFileStateCache(const Filename: string);
begin
if Assigned(OnInvalidateFileStateCache) then