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

lcl: redo FileIsSymlink based on patch cobines (mantis #0016691)

Browse Source 
git-svn-id: trunk@28310 -
This commit is contained in:
paul 2010-11-18 03:48:51 +00:00
parent 6bf5ba8ef9
commit 75f412db98
1 changed files with 15 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/include/winfileutil.inc
View File

@ -55,16 +55,24 @@ end;
function FileIsSymlink(const AFilename: string): boolean;
------------------------------------------------------------------------------}
function FileIsSymlink(const AFilename: string): boolean;
const
IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
IO_REPARSE_TAG_SYMLINK = $A000000C;
var
FileHandle: THandle;
FileInfo: TBYHANDLEFILEINFORMATION;
Attr: Longint;
Rec: TSearchRec;
begin
FileHandle := FileOpen(UTF8ToSys(AFileName), fmOpenRead or fmShareDenyNone);
if FileHandle <> feInvalidHandle then
Attr := FileGetAttrUTF8(AFilename);
if (Attr <> -1) and (Attr and FILE_ATTRIBUTE_REPARSE_POINT <> 0) then
begin
GetFileInformationByHandle(HFile(FileHandle), FileInfo);
Result := FileInfo.nNumberOfLinks > 1;
FileClose(FileHandle);
FindFirstUTF8(AFilename, Attr, Rec);
if Rec.FindHandle <> feInvalidHandle then
begin
Windows.FindClose(Rec.FindHandle);
Result := (Rec.FindData.dwReserved0 = IO_REPARSE_TAG_SYMLINK) or (Rec.FindData.dwReserved0 = IO_REPARSE_TAG_MOUNT_POINT);
end
else
Result := False;
end
else
Result := False;