paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-20 12:59:16 +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;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
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 var
FileHandle: THandle; Attr: Longint;
FileInfo: TBYHANDLEFILEINFORMATION; Rec: TSearchRec;
begin begin
FileHandle := FileOpen(UTF8ToSys(AFileName), fmOpenRead or fmShareDenyNone); Attr := FileGetAttrUTF8(AFilename);
if FileHandle <> feInvalidHandle then if (Attr <> -1) and (Attr and FILE_ATTRIBUTE_REPARSE_POINT <> 0) then
begin begin
GetFileInformationByHandle(HFile(FileHandle), FileInfo); FindFirstUTF8(AFilename, Attr, Rec);
Result := FileInfo.nNumberOfLinks > 1; if Rec.FindHandle <> feInvalidHandle then
FileClose(FileHandle); 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 end
else else
Result := False; Result := False;