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

lazutils: add IsUNCPath, ExtractUNCVolume routines

Browse Source 
git-svn-id: trunk@35913 -
This commit is contained in:
paul 2012-03-13 03:11:18 +00:00
parent 6f7c5e1d9b
commit 4322f2fcf6
1 changed files with 53 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
components/lazutils/lazfileutils.pas
View File

@ -79,6 +79,11 @@ function CreateDirUTF8(const NewDir: String): Boolean;
function RemoveDirUTF8(const Dir: String): Boolean;
function ForceDirectoriesUTF8(const Dir: string): Boolean;
// UNC paths
function IsUNCPath(const Path: String): Boolean;
function ExtractUNCVolume(const Path: String): String;
type
TInvalidateFileStateCacheEvent = procedure(const Filename: string);
var
@ -1190,5 +1195,53 @@ begin
OnInvalidateFileStateCache(Filename);
end;
function IsUNCPath(const Path: String): Boolean;
begin
Result := (Length(Path) > 2) and (Path[1] = PathDelim) and (Path[2] = PathDelim);
end;
function ExtractUNCVolume(const Path: String): String;
var
I, Len: Integer;
// the next function reuses Len variable
function NextPathDelim(const Start: Integer): Integer;// inline;
begin
Result := Start;
while (Result <= Len) and (Path[Result] <> PathDelim) do
inc(Result);
end;
begin
if not IsUNCPath(Path) then
Exit('');
I := 3;
Len := Length(Path);
if Path[I] = '?' then
begin
// Long UNC path form like:
// \\?\UNC\ComputerName\SharedFolder\Resource or
// \\?\C:\Directory
inc(I);
if Path[I] <> PathDelim then
Exit('');
if UpperCase(Copy(Path, I + 1, 3)) = 'UNC' then
begin
inc(I, 4);
if I < Len then
I := NextPathDelim(I + 1);
if I < Len then
I := NextPathDelim(I + 1);
end;
end
else
begin
I := NextPathDelim(I);
if I < Len then
I := NextPathDelim(I + 1);
end;
Result := Copy(Path, 1, I);
end;
end.