View Issue Details

IDProjectCategoryView StatusLast Update
0032370FPCRTLpublic2019-09-05 20:13
ReporterSerge AnvarovAssigned ToSven Barth 
PrioritynormalSeverityminorReproducibilityN/A
Status assignedResolutionopen 
PlatformWindowsOSWindowsOS Version
Product Version3.1.1Product Build 
Target VersionFixed in Version 
Summary0032370: Windows. Compatibility with Delphi when working with links
DescriptionIn Delphi, for FileExists, DirectoryExists, there is the FollowLink parameter. In FPC this is not. Therefore, I propose a patch that adds a function with an explicit FollowLink parameter to the release for Windows.
Their implementation is based on the new added function GetLinkTargetName(const LinkSourceName: UnicodeString; out LinkTargetName: UnicodeString): Boolean;

Also, the patch contains a fix for the FileAge function with the FollowLink parameter. In fact, in the implementation for Windows it is ignored. In addition to the function FileAge with one parameter added protection from wildcards, as it is done for a newer function.
TagsNo tags attached.
Fixed in Revision39670,39671
FPCOldBugId
FPCTarget-
Attached Files
  • links.diff (9,993 bytes)
    Index: rtl/objpas/sysutils/filutil.inc
    ===================================================================
    --- rtl/objpas/sysutils/filutil.inc	(revision 37139)
    +++ rtl/objpas/sysutils/filutil.inc	(working copy)
    @@ -292,34 +292,58 @@
     end;
     {$endif}
     
    +function ContainsWildcards(const S: UnicodeString): Boolean;
    +var
    +  i: Integer;
    +begin
    +  for i := Low(S) to High(S) do
    +    case S[i] of
    +      '*', '?':
    +         Exit(True);
    +    end;
    +  Result := False;
    +end;
     
    -function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
    -Var
    -  Info : TUnicodeSearchRec;
    -  A : Integer;
    +function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime;
    +  FollowLink: Boolean = True): Boolean;
     
    +{$IFDEF WINDOWS}
    +  function FileLinkAge(const LinkSourceName: UnicodeString;
    +    out FileDateTime: TDateTime): Boolean;
    +  var
    +    LinkTargeName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
    +      FileAge(LinkTargeName, FileDateTime);
    +  end;
    +{$ENDIF}
    +
    +var
    +  Info: TUnicodeSearchRec;
    +  Attr: Longint;
     begin
    -  for A:=1 to Length(FileName) do
    -    if CharInSet(FileName[A],['?','*']) then
    -      Exit(False);
    -  A:=0;
    +  if ContainsWildcards(FileName) then
    +    Exit(False);
    +  Attr := 0;
       if not FollowLink then
    -    A:=A or faSymLink;
    -  Result:=FindFirst(FileName,A,Info)=0;
    +    Attr := Attr or faSymLink;
    +  Result := FindFirst(FileName, Attr, Info) = 0;
       if Result then
    -    begin
    -      FileDateTime:=FileDatetoDateTime(Info.Time);
    -      FindClose(Info);
    -    end;
    +  begin
    +    FileDateTime := FileDateToDateTime(Info.Time);
    +    FindClose(Info);
    +{$IFDEF WINDOWS}
    +    if ((Attr and faSymLink) <> 0) and FollowLink then
    +      Result := FileLinkAge(FileName, FileDateTime);
    +{$ENDIF}
    +  end;
     end;
     
    -
     Function FileAge(const FileName: RawbyteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
     begin
       Result:=FileAge(UnicodeString(FileName),FileDateTime,FollowLink);
     end;
     
    -
     Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
     Var
       I : longint;
    Index: rtl/win/sysutils.pp
    ===================================================================
    --- rtl/win/sysutils.pp	(revision 37139)
    +++ rtl/win/sysutils.pp	(working copy)
    @@ -86,6 +86,18 @@
     procedure GetFormatSettings;
     procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
     
    +// Valid for a directory with mount point (junction) or a symbolic link
    +// Valid for a file with a symbolic link
    +function GetLinkTargetName(const LinkSourceName: UnicodeString;
    +  out LinkTargetName: UnicodeString): Boolean; overload;
    +function GetLinkTargetName(const LinkSourceName: RawByteString;
    +  out LinkTargetName: RawByteString): Boolean; overload;
    +
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
    +
     implementation
     
       uses
    @@ -383,32 +395,34 @@
     end;
     
     
    -Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
    +function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
     var
    -  lft : TFileTime;
    +  lft: TFileTime;
     begin
    -  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
    -                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
    +  Result := FileTimeToLocalFileTime(@WTime, @lft) and
    +    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
     end;
     
     
    -Function FileAge (Const FileName : UnicodeString): Longint;
    +function FileAge(const FileName: UnicodeString): Longint;
     var
       Handle: THandle;
       FindData: TWin32FindDataW;
     begin
    -  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
    -  if Handle <> INVALID_HANDLE_VALUE then
    +  if not ContainsWildcards(FileName) then
    +  begin
    +    Handle := FindFirstFileW(PUnicodeChar(FileName), @FindData);
    +    if Handle <> INVALID_HANDLE_VALUE then
         begin
           Windows.FindClose(Handle);
           if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    -        If WinToDosTime(FindData.ftLastWriteTime,Result) then
    -          exit;
    +        if WinToDosTime(FindData.ftLastWriteTime, Result) then
    +          Exit;
         end;
    +  end;
       Result := -1;
     end;
     
    -
     Function FileExists (Const FileName : UnicodeString) : Boolean;
     var
       Attr:Dword;
    @@ -422,6 +436,33 @@
     end;
     
     
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +const
    +  INVALID_FILE_ATTRIBUTES = -1;
    +
    +  function LinkFileExists(const LinkSourceName: UnicodeString): Boolean;
    +  var
    +    LinkTargetName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
    +      FileExists(LinkTargetName);
    +  end;
    +
    +var
    +  Attr: Longint;
    +begin
    +  Attr := FileGetAttr(FileName);
    +  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
    +    ((Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
    +  if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
    +    Result := LinkFileExists(FileName);
    +end;
    +
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
    +begin
    +  Result := FileExists(UnicodeString(FileName), FollowLink);
    +end;
    +
     Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
     var
       Attr:Dword;
    @@ -433,6 +474,33 @@
         Result:=False;
     end;
     
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +
    +  function LinkDirExists(const LinkSourceName: UnicodeString): Boolean;
    +  var
    +    LinkTargetName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
    +      DirectoryExists(LinkTargetName);
    +  end;
    +
    +const
    +  INVALID_FILE_ATTRIBUTES = -1;
    +var
    +  Attr: Longint;
    +begin
    +  Attr := FileGetAttr(Directory);
    +  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
    +    ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0);
    +  if Result and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) and FollowLink then
    +    Result := LinkDirExists(Directory);
    +end;
    +
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
    +begin
    +  Result := DirectoryExists(UnicodeString(Directory), FollowLink);
    +end;
    +
     Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
     begin
       { Find file with correct attribute }
    @@ -557,7 +625,93 @@
       Result := MoveFileW(PWideChar(OldName), PWideChar(NewName));
     end;
     
    +// Valid for a directory with mount point (junction) or a symbolic link
    +// Valid for a file with a symbolic link
    +function GetLinkTargetName(const LinkSourceName: UnicodeString;
    +  out LinkTargetName: UnicodeString): Boolean;
    +const
    +  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
    +  IO_REPARSE_TAG_SYMLINK = $A000000C;
    +  ERROR_REPARSE_TAG_INVALID = 4393;
    +type
    +  TReparseDataBuffer = record
    +    ReparseTag: ULONG;
    +    ReparseDataLength: Word;
    +    Reserved: Word;
    +    SubstituteNameOffset: Word;
    +    SubstituteNameLength: Word;
    +    PrintNameOffset: Word;
    +    PrintNameLength: Word;
    +    case ULONG of
    +      IO_REPARSE_TAG_MOUNT_POINT: (
    +        PathBufferMount: array [0..4095] of WCHAR);
    +      IO_REPARSE_TAG_SYMLINK: (
    +        Flags: ULONG;
    +        PathBufferSym: array [0..4095] of WCHAR);
    +    end;
    +const
    +  FSCTL_GET_REPARSE_POINT = $900A8;
    +  MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024;
    +  SYMLINK_FLAG_RELATIVE = 1;
    +  FILE_FLAG_OPEN_REPARSE_POINT = $200000;
    +  FILE_READ_EA = $8;
    +  CShareAny = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
    +  COpenReparse = FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS;
    +var
    +  HFile: THandle;
    +  PBuffer: ^TReparseDataBuffer;
    +  BytesReturned: DWORD;
    +begin
    +  LinkTargetName := '';
    +  HFile := CreateFileW(PUnicodeChar(LinkSourceName), FILE_READ_EA, CShareAny,
    +    nil, OPEN_EXISTING, COpenReparse, 0);
    +  if HFile <> INVALID_HANDLE_VALUE then
    +  try
    +    GetMem(PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE);
    +    try
    +      if DeviceIoControl(HFile, FSCTL_GET_REPARSE_POINT, nil, 0,
    +        PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, @BytesReturned, nil) then
    +      begin
    +        case PBuffer^.ReparseTag of
    +          IO_REPARSE_TAG_MOUNT_POINT:
    +            begin
    +              LinkTargetName := WideCharLenToString(
    +                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
    +                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
    +                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
    +            end;
    +          IO_REPARSE_TAG_SYMLINK:
    +            begin
    +              LinkTargetName := WideCharLenToString(
    +                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
    +                PBuffer^.PrintNameLength div SizeOf(WCHAR));
    +              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
    +                LinkTargetName := ExpandFileName(
    +                  ExtractFilePath(LinkSourceName) + LinkTargetName);
    +            end
    +        else
    +          SetLastError(ERROR_REPARSE_TAG_INVALID);
    +        end;
    +      end;
    +    finally
    +      FreeMem(PBuffer);
    +    end;
    +  finally
    +    CloseHandle(HFile);
    +  end;
    +  Result := LinkTargetName <> '';
    +end;
     
    +function GetLinkTargetName(const LinkSourceName: RawByteString;
    +  out LinkTargetName: RawByteString): Boolean;
    +var
    +  LinkTargetNameW: UnicodeString;
    +begin
    +  Result := GetLinkTargetName(UnicodeString(LinkSourceName), LinkTargetNameW);
    +  LinkTargetName := string(LinkTargetNameW);
    +end;
    +
    +
     {****************************************************************************
                                   Disk Functions
     ****************************************************************************}
    
    links.diff (9,993 bytes)
  • links37149.diff (10,010 bytes)
    Index: rtl/objpas/sysutils/filutil.inc
    ===================================================================
    --- rtl/objpas/sysutils/filutil.inc	(revision 37149)
    +++ rtl/objpas/sysutils/filutil.inc	(working copy)
    @@ -292,34 +292,58 @@
     end;
     {$endif}
     
    +function ContainsWildcards(const S: UnicodeString): Boolean;
    +var
    +  i: Integer;
    +begin
    +  for i := Low(S) to High(S) do
    +    case S[i] of
    +      '*', '?':
    +         Exit(True);
    +    end;
    +  Result := False;
    +end;
     
    -function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
    -Var
    -  Info : TUnicodeSearchRec;
    -  A : Integer;
    +function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime;
    +  FollowLink: Boolean = True): Boolean;
     
    +{$IFDEF WINDOWS}
    +  function FileLinkAge(const LinkSourceName: UnicodeString;
    +    out FileDateTime: TDateTime): Boolean;
    +  var
    +    LinkTargeName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
    +      FileAge(LinkTargeName, FileDateTime);
    +  end;
    +{$ENDIF}
    +
    +var
    +  Info: TUnicodeSearchRec;
    +  Attr: Longint;
     begin
    -  for A:=1 to Length(FileName) do
    -    if CharInSet(FileName[A],['?','*']) then
    -      Exit(False);
    -  A:=0;
    +  if ContainsWildcards(FileName) then
    +    Exit(False);
    +  Attr := 0;
       if not FollowLink then
    -    A:=A or faSymLink;
    -  Result:=FindFirst(FileName,A,Info)=0;
    +    Attr := Attr or faSymLink;
    +  Result := FindFirst(FileName, Attr, Info) = 0;
       if Result then
    -    begin
    -      FileDateTime:=FileDatetoDateTime(Info.Time);
    -      FindClose(Info);
    -    end;
    +  begin
    +    FileDateTime := FileDateToDateTime(Info.Time);
    +    FindClose(Info);
    +{$IFDEF WINDOWS}
    +    if ((FileGetAttr(FileName) and faSymLink) <> 0) and FollowLink then
    +      Result := FileLinkAge(FileName, FileDateTime);
    +{$ENDIF}
    +  end;
     end;
     
    -
     Function FileAge(const FileName: RawbyteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
     begin
       Result:=FileAge(UnicodeString(FileName),FileDateTime,FollowLink);
     end;
     
    -
     Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
     Var
       I : longint;
    Index: rtl/win/sysutils.pp
    ===================================================================
    --- rtl/win/sysutils.pp	(revision 37149)
    +++ rtl/win/sysutils.pp	(working copy)
    @@ -86,6 +86,18 @@
     procedure GetFormatSettings;
     procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
     
    +// Valid for a directory with mount point (junction) or a symbolic link
    +// Valid for a file with a symbolic link
    +function GetLinkTargetName(const LinkSourceName: UnicodeString;
    +  out LinkTargetName: UnicodeString): Boolean; overload;
    +function GetLinkTargetName(const LinkSourceName: RawByteString;
    +  out LinkTargetName: RawByteString): Boolean; overload;
    +
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
    +
     implementation
     
       uses
    @@ -383,32 +395,34 @@
     end;
     
     
    -Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
    +function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
     var
    -  lft : TFileTime;
    +  lft: TFileTime;
     begin
    -  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
    -                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
    +  Result := FileTimeToLocalFileTime(@WTime, @lft) and
    +    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
     end;
     
     
    -Function FileAge (Const FileName : UnicodeString): Longint;
    +function FileAge(const FileName: UnicodeString): Longint;
     var
       Handle: THandle;
       FindData: TWin32FindDataW;
     begin
    -  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
    -  if Handle <> INVALID_HANDLE_VALUE then
    +  if not ContainsWildcards(FileName) then
    +  begin
    +    Handle := FindFirstFileW(PUnicodeChar(FileName), @FindData);
    +    if Handle <> INVALID_HANDLE_VALUE then
         begin
           Windows.FindClose(Handle);
           if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    -        If WinToDosTime(FindData.ftLastWriteTime,Result) then
    -          exit;
    +        if WinToDosTime(FindData.ftLastWriteTime, Result) then
    +          Exit;
         end;
    +  end;
       Result := -1;
     end;
     
    -
     Function FileExists (Const FileName : UnicodeString) : Boolean;
     var
       Attr:Dword;
    @@ -422,6 +436,33 @@
     end;
     
     
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +const
    +  INVALID_FILE_ATTRIBUTES = -1;
    +
    +  function LinkFileExists(const LinkSourceName: UnicodeString): Boolean;
    +  var
    +    LinkTargetName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
    +      FileExists(LinkTargetName);
    +  end;
    +
    +var
    +  Attr: Longint;
    +begin
    +  Attr := FileGetAttr(FileName);
    +  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
    +    ((Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
    +  if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
    +    Result := LinkFileExists(FileName);
    +end;
    +
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
    +begin
    +  Result := FileExists(UnicodeString(FileName), FollowLink);
    +end;
    +
     Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
     var
       Attr:Dword;
    @@ -433,6 +474,33 @@
         Result:=False;
     end;
     
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
    +
    +  function LinkDirExists(const LinkSourceName: UnicodeString): Boolean;
    +  var
    +    LinkTargetName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
    +      DirectoryExists(LinkTargetName);
    +  end;
    +
    +const
    +  INVALID_FILE_ATTRIBUTES = -1;
    +var
    +  Attr: Longint;
    +begin
    +  Attr := FileGetAttr(Directory);
    +  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
    +    ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0);
    +  if Result and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) and FollowLink then
    +    Result := LinkDirExists(Directory);
    +end;
    +
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
    +begin
    +  Result := DirectoryExists(UnicodeString(Directory), FollowLink);
    +end;
    +
     Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
     begin
       { Find file with correct attribute }
    @@ -557,7 +625,93 @@
       Result := MoveFileW(PWideChar(OldName), PWideChar(NewName));
     end;
     
    +// Valid for a directory with mount point (junction) or a symbolic link
    +// Valid for a file with a symbolic link
    +function GetLinkTargetName(const LinkSourceName: UnicodeString;
    +  out LinkTargetName: UnicodeString): Boolean;
    +const
    +  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
    +  IO_REPARSE_TAG_SYMLINK = $A000000C;
    +  ERROR_REPARSE_TAG_INVALID = 4393;
    +type
    +  TReparseDataBuffer = record
    +    ReparseTag: ULONG;
    +    ReparseDataLength: Word;
    +    Reserved: Word;
    +    SubstituteNameOffset: Word;
    +    SubstituteNameLength: Word;
    +    PrintNameOffset: Word;
    +    PrintNameLength: Word;
    +    case ULONG of
    +      IO_REPARSE_TAG_MOUNT_POINT: (
    +        PathBufferMount: array [0..4095] of WCHAR);
    +      IO_REPARSE_TAG_SYMLINK: (
    +        Flags: ULONG;
    +        PathBufferSym: array [0..4095] of WCHAR);
    +    end;
    +const
    +  FSCTL_GET_REPARSE_POINT = $900A8;
    +  MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024;
    +  SYMLINK_FLAG_RELATIVE = 1;
    +  FILE_FLAG_OPEN_REPARSE_POINT = $200000;
    +  FILE_READ_EA = $8;
    +  CShareAny = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
    +  COpenReparse = FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS;
    +var
    +  HFile: THandle;
    +  PBuffer: ^TReparseDataBuffer;
    +  BytesReturned: DWORD;
    +begin
    +  LinkTargetName := '';
    +  HFile := CreateFileW(PUnicodeChar(LinkSourceName), FILE_READ_EA, CShareAny,
    +    nil, OPEN_EXISTING, COpenReparse, 0);
    +  if HFile <> INVALID_HANDLE_VALUE then
    +  try
    +    GetMem(PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE);
    +    try
    +      if DeviceIoControl(HFile, FSCTL_GET_REPARSE_POINT, nil, 0,
    +        PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, @BytesReturned, nil) then
    +      begin
    +        case PBuffer^.ReparseTag of
    +          IO_REPARSE_TAG_MOUNT_POINT:
    +            begin
    +              LinkTargetName := WideCharLenToString(
    +                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
    +                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
    +                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
    +            end;
    +          IO_REPARSE_TAG_SYMLINK:
    +            begin
    +              LinkTargetName := WideCharLenToString(
    +                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
    +                PBuffer^.PrintNameLength div SizeOf(WCHAR));
    +              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
    +                LinkTargetName := ExpandFileName(
    +                  ExtractFilePath(LinkSourceName) + LinkTargetName);
    +            end
    +        else
    +          SetLastError(ERROR_REPARSE_TAG_INVALID);
    +        end;
    +      end;
    +    finally
    +      FreeMem(PBuffer);
    +    end;
    +  finally
    +    CloseHandle(HFile);
    +  end;
    +  Result := LinkTargetName <> '';
    +end;
     
    +function GetLinkTargetName(const LinkSourceName: RawByteString;
    +  out LinkTargetName: RawByteString): Boolean;
    +var
    +  LinkTargetNameW: UnicodeString;
    +begin
    +  Result := GetLinkTargetName(UnicodeString(LinkSourceName), LinkTargetNameW);
    +  LinkTargetName := string(LinkTargetNameW);
    +end;
    +
    +
     {****************************************************************************
                                   Disk Functions
     ****************************************************************************}
    
    links37149.diff (10,010 bytes)
  • Project1.lpr (7,488 bytes)
  • FileOrDirExists39662.diff (7,588 bytes)
    Index: rtl/objpas/sysutils/filutil.inc
    ===================================================================
    --- rtl/objpas/sysutils/filutil.inc	(revision 39662)
    +++ rtl/objpas/sysutils/filutil.inc	(working copy)
    @@ -100,22 +100,43 @@
     
     
     function FileAge(const FileName: RawByteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
    -Var
    -  Info : TRawByteSearchRec;
    -  A : Integer;
    +
    +{$IFDEF WINDOWS}
    +  function FileLinkAge(const LinkSourceName: UnicodeString;
    +    out FileDateTime: TDateTime): Boolean;
    +  var
    +    LinkTargeName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
    +      FileAge(LinkTargeName, FileDateTime);
    +  end;
    +{$ENDIF}
    +
    +{$PUSH}
    +{$WARN 5044 OFF : Symbol "$1" is not portable}
    +const
    +  faSymLinkNoWarning = faSymLink;
    +{$POP}
    +
    +var
    +  Info: TUnicodeSearchRec;
    +  Attr: Longint;
     begin
    -  for A:=1 to Length(FileName) do
    -    if CharInSet(FileName[A],['?','*']) then
    -      Exit(False);
    -  A:=0;
    +  if ContainsWildcards(FileName) then
    +    Exit(False);
    +  Attr := 0;
       if not FollowLink then
    -    A:=A or faSymLink;
    -  Result:=FindFirst(FileName,A,Info)=0;
    +    Attr := Attr or faSymLinkNoWarning;
    +  Result := FindFirst(FileName, Attr, Info) = 0;
       if Result then
    -    begin
    -      FileDateTime:=FileDatetoDateTime(Info.Time);
    -      FindClose(Info);
    -    end;
    +  begin
    +    FileDateTime := FileDateToDateTime(Info.Time);
    +    FindClose(Info);
    +{$IFDEF WINDOWS}
    +    if ((FileGetAttr(FileName) and faSymLinkNoWarning) <> 0) and FollowLink then
    +      Result := FileLinkAge(FileName, FileDateTime);
    +{$ENDIF}
    +  end;
     end;
     
     
    @@ -292,6 +313,15 @@
     end;
     {$endif}
     
    +function ContainsWildcards(const S: UnicodeString): Boolean;
    +var
    +  C: UnicodeChar;
    +begin
    +  for C in S do
    +    if (C = '*') or (C = '?') then
    +       Exit(True);
    +  Result := False;
    +end;
     
     function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
     Var
    Index: rtl/win/sysutils.pp
    ===================================================================
    --- rtl/win/sysutils.pp	(revision 39662)
    +++ rtl/win/sysutils.pp	(working copy)
    @@ -86,6 +86,16 @@
     procedure GetFormatSettings;
     procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
     
    +function GetLinkTargetName(const LinkSourceName: UnicodeString;
    +  out LinkTargetName: UnicodeString): Boolean;
    +function GetLinkTargetName(const LinkSourceName: RawByteString;
    +  out LinkTargetName: RawByteString): Boolean;
    +
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean;
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean;
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean;
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean;
    +
     implementation
     
       uses
    @@ -380,57 +390,120 @@
                     LocalFileTimeToFileTime(lft,Wtime);
     end;
     
    -
    -Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
    +function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
     var
    -  lft : TFileTime;
    +  lft: TFileTime;
     begin
    -  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
    -                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
    +  Result := FileTimeToLocalFileTime(@WTime, @lft) and
    +    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
     end;
     
     
    -Function FileAge (Const FileName : UnicodeString): Longint;
    +function FileAge(const FileName: UnicodeString): Longint;
     var
       Handle: THandle;
       FindData: TWin32FindDataW;
     begin
    -  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
    -  if Handle <> INVALID_HANDLE_VALUE then
    +  if not ContainsWildcards(FileName) then
    +  begin
    +    Handle := FindFirstFileExW(PUnicodeChar(FileName), FindExInfoBasic, @FindData,
    +      FindExSearchNameMatch, nil, 0); // It's faster, than FindFirstFile
    +    if Handle <> INVALID_HANDLE_VALUE then
         begin
           Windows.FindClose(Handle);
           if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    -        If WinToDosTime(FindData.ftLastWriteTime,Result) then
    -          exit;
    +        if WinToDosTime(FindData.ftLastWriteTime, Result) then
    +          Exit;
         end;
    +  end;
       Result := -1;
     end;
     
    +function FileOrDirExists(const FileOrDirName: UnicodeString; CheckDir: Boolean;
    +  FollowLink: Boolean): Boolean;
     
    -Function FileExists (Const FileName : UnicodeString) : Boolean;
    +const
    +  CDirAttributes: array[Boolean] of DWORD = (0, FILE_ATTRIBUTE_DIRECTORY);
    +
    +  function FoundByEnum: Boolean;
    +  var
    +    FindData: TWin32FindDataW;
    +    Handle: THandle;
    +  begin
    +    Handle := FindFirstFileExW(PUnicodeChar(FileOrDirName), FindExInfoBasic, @FindData,
    +      FindExSearchNameMatch, nil, 0); // It's faster, than FindFirstFile
    +    Result := Handle <> INVALID_HANDLE_VALUE;
    +    if Result then
    +    begin
    +      Windows.FindClose(Handle);
    +      Result := (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
    +    end;
    +  end;
    +
    +  function LinkFileExists: Boolean;
    +  var
    +    LinkTargetName: UnicodeString;
    +  begin
    +    Result := GetLinkTargetName(FileOrDirName, LinkTargetName) and
    +      FileOrDirExists(LinkTargetName, CheckDir, False);
    +  end;
    +
    +const
    +  INVALID_FILE_ATTRIBUTES = -1;
    +  CNotExistsErrors = [
    +    ERROR_FILE_NOT_FOUND,
    +    ERROR_PATH_NOT_FOUND,
    +    ERROR_INVALID_NAME,    // Protects from names in the form of masks like '*'
    +    ERROR_INVALID_DRIVE,
    +    ERROR_NOT_READY,
    +    ERROR_INVALID_PARAMETER,
    +    ERROR_BAD_PATHNAME,
    +    ERROR_BAD_NETPATH,
    +    ERROR_BAD_NET_NAME];
     var
    -  Attr:Dword;
    +  Attr: LongInt;
     begin
    -
    -  Attr:=GetFileAttributesW(PWideChar(FileName));
    -  if Attr <> $ffffffff then
    -    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
    +  Attr := FileGetAttr(FileOrDirName);
    +  if Attr = INVALID_FILE_ATTRIBUTES then
    +    Result := not (GetLastError in CNotExistsErrors) and FoundByEnum
       else
    -    Result:=False;
    +  begin
    +    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
    +    if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
    +      Result := LinkFileExists;
    +  end;
     end;
     
    +function FileExists(const FileName: UnicodeString): Boolean;
    +begin
    +  Result := FileOrDirExists(FileName, False, False);
    +end;
     
    -Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
    -var
    -  Attr:Dword;
    +function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean;
     begin
    -  Attr:=GetFileAttributesW(PWideChar(Directory));
    -  if Attr <> $ffffffff then
    -    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
    -  else
    -    Result:=False;
    +  Result := FileOrDirExists(FileName, False, FollowLink);
     end;
     
    +function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean;
    +begin
    +  Result := FileOrDirExists(UnicodeString(FileName), False, FollowLink);
    +end;
    +
    +function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean;
    +begin
    +  Result := FileOrDirExists(Directory, True, FollowLink);
    +end;
    +
    +function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean;
    +begin
    +  Result := FileOrDirExists(UnicodeString(Directory), True, FollowLink);
    +end;
    +
    +function DirectoryExists(const Directory: UnicodeString): Boolean;
    +begin
    +  Result := FileOrDirExists(Directory, True, False);
    +end;
    +
     Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
     begin
       { Find file with correct attribute }
    
  • project1.lpr (8,802 bytes)
  • sysutils-win.diff (688 bytes)
    Index: sysutils.pp
    ===================================================================
    --- sysutils.pp	(revision 42284)
    +++ sysutils.pp	(working copy)
    @@ -462,7 +462,7 @@
                 IO_REPARSE_TAG_SYMLINK: begin
                   SymLinkRec.TargetName := WideCharLenToString(
                     @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
    -                PBuffer^.PrintNameOffset div SizeOf(WCHAR));
    +                PBuffer^.PrintNameLength div SizeOf(WCHAR));
                   if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
                     SymLinkRec.TargetName := ExpandFileName(ExtractFilePath(FileName) + SymLinkRec.TargetName);
                 end;
    
    sysutils-win.diff (688 bytes)

Relationships

parent of 0035744 closedSven Barth Windows compiler doesn't see simlink as an executable 

Activities

Serge Anvarov

2017-09-04 21:32

reporter  

links.diff (9,993 bytes)
Index: rtl/objpas/sysutils/filutil.inc
===================================================================
--- rtl/objpas/sysutils/filutil.inc	(revision 37139)
+++ rtl/objpas/sysutils/filutil.inc	(working copy)
@@ -292,34 +292,58 @@
 end;
 {$endif}
 
+function ContainsWildcards(const S: UnicodeString): Boolean;
+var
+  i: Integer;
+begin
+  for i := Low(S) to High(S) do
+    case S[i] of
+      '*', '?':
+         Exit(True);
+    end;
+  Result := False;
+end;
 
-function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
-Var
-  Info : TUnicodeSearchRec;
-  A : Integer;
+function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime;
+  FollowLink: Boolean = True): Boolean;
 
+{$IFDEF WINDOWS}
+  function FileLinkAge(const LinkSourceName: UnicodeString;
+    out FileDateTime: TDateTime): Boolean;
+  var
+    LinkTargeName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
+      FileAge(LinkTargeName, FileDateTime);
+  end;
+{$ENDIF}
+
+var
+  Info: TUnicodeSearchRec;
+  Attr: Longint;
 begin
-  for A:=1 to Length(FileName) do
-    if CharInSet(FileName[A],['?','*']) then
-      Exit(False);
-  A:=0;
+  if ContainsWildcards(FileName) then
+    Exit(False);
+  Attr := 0;
   if not FollowLink then
-    A:=A or faSymLink;
-  Result:=FindFirst(FileName,A,Info)=0;
+    Attr := Attr or faSymLink;
+  Result := FindFirst(FileName, Attr, Info) = 0;
   if Result then
-    begin
-      FileDateTime:=FileDatetoDateTime(Info.Time);
-      FindClose(Info);
-    end;
+  begin
+    FileDateTime := FileDateToDateTime(Info.Time);
+    FindClose(Info);
+{$IFDEF WINDOWS}
+    if ((Attr and faSymLink) <> 0) and FollowLink then
+      Result := FileLinkAge(FileName, FileDateTime);
+{$ENDIF}
+  end;
 end;
 
-
 Function FileAge(const FileName: RawbyteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
 begin
   Result:=FileAge(UnicodeString(FileName),FileDateTime,FollowLink);
 end;
 
-
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 Var
   I : longint;
Index: rtl/win/sysutils.pp
===================================================================
--- rtl/win/sysutils.pp	(revision 37139)
+++ rtl/win/sysutils.pp	(working copy)
@@ -86,6 +86,18 @@
 procedure GetFormatSettings;
 procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
 
+// Valid for a directory with mount point (junction) or a symbolic link
+// Valid for a file with a symbolic link
+function GetLinkTargetName(const LinkSourceName: UnicodeString;
+  out LinkTargetName: UnicodeString): Boolean; overload;
+function GetLinkTargetName(const LinkSourceName: RawByteString;
+  out LinkTargetName: RawByteString): Boolean; overload;
+
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
+
 implementation
 
   uses
@@ -383,32 +395,34 @@
 end;
 
 
-Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
+function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
 var
-  lft : TFileTime;
+  lft: TFileTime;
 begin
-  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
-                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
+  Result := FileTimeToLocalFileTime(@WTime, @lft) and
+    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
 end;
 
 
-Function FileAge (Const FileName : UnicodeString): Longint;
+function FileAge(const FileName: UnicodeString): Longint;
 var
   Handle: THandle;
   FindData: TWin32FindDataW;
 begin
-  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
-  if Handle <> INVALID_HANDLE_VALUE then
+  if not ContainsWildcards(FileName) then
+  begin
+    Handle := FindFirstFileW(PUnicodeChar(FileName), @FindData);
+    if Handle <> INVALID_HANDLE_VALUE then
     begin
       Windows.FindClose(Handle);
       if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
+        if WinToDosTime(FindData.ftLastWriteTime, Result) then
+          Exit;
     end;
+  end;
   Result := -1;
 end;
 
-
 Function FileExists (Const FileName : UnicodeString) : Boolean;
 var
   Attr:Dword;
@@ -422,6 +436,33 @@
 end;
 
 
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+
+  function LinkFileExists(const LinkSourceName: UnicodeString): Boolean;
+  var
+    LinkTargetName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
+      FileExists(LinkTargetName);
+  end;
+
+var
+  Attr: Longint;
+begin
+  Attr := FileGetAttr(FileName);
+  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
+    ((Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
+  if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
+    Result := LinkFileExists(FileName);
+end;
+
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
+begin
+  Result := FileExists(UnicodeString(FileName), FollowLink);
+end;
+
 Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
 var
   Attr:Dword;
@@ -433,6 +474,33 @@
     Result:=False;
 end;
 
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
+
+  function LinkDirExists(const LinkSourceName: UnicodeString): Boolean;
+  var
+    LinkTargetName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
+      DirectoryExists(LinkTargetName);
+  end;
+
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+var
+  Attr: Longint;
+begin
+  Attr := FileGetAttr(Directory);
+  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
+    ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0);
+  if Result and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) and FollowLink then
+    Result := LinkDirExists(Directory);
+end;
+
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
+begin
+  Result := DirectoryExists(UnicodeString(Directory), FollowLink);
+end;
+
 Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
 begin
   { Find file with correct attribute }
@@ -557,7 +625,93 @@
   Result := MoveFileW(PWideChar(OldName), PWideChar(NewName));
 end;
 
+// Valid for a directory with mount point (junction) or a symbolic link
+// Valid for a file with a symbolic link
+function GetLinkTargetName(const LinkSourceName: UnicodeString;
+  out LinkTargetName: UnicodeString): Boolean;
+const
+  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
+  IO_REPARSE_TAG_SYMLINK = $A000000C;
+  ERROR_REPARSE_TAG_INVALID = 4393;
+type
+  TReparseDataBuffer = record
+    ReparseTag: ULONG;
+    ReparseDataLength: Word;
+    Reserved: Word;
+    SubstituteNameOffset: Word;
+    SubstituteNameLength: Word;
+    PrintNameOffset: Word;
+    PrintNameLength: Word;
+    case ULONG of
+      IO_REPARSE_TAG_MOUNT_POINT: (
+        PathBufferMount: array [0..4095] of WCHAR);
+      IO_REPARSE_TAG_SYMLINK: (
+        Flags: ULONG;
+        PathBufferSym: array [0..4095] of WCHAR);
+    end;
+const
+  FSCTL_GET_REPARSE_POINT = $900A8;
+  MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024;
+  SYMLINK_FLAG_RELATIVE = 1;
+  FILE_FLAG_OPEN_REPARSE_POINT = $200000;
+  FILE_READ_EA = $8;
+  CShareAny = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
+  COpenReparse = FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS;
+var
+  HFile: THandle;
+  PBuffer: ^TReparseDataBuffer;
+  BytesReturned: DWORD;
+begin
+  LinkTargetName := '';
+  HFile := CreateFileW(PUnicodeChar(LinkSourceName), FILE_READ_EA, CShareAny,
+    nil, OPEN_EXISTING, COpenReparse, 0);
+  if HFile <> INVALID_HANDLE_VALUE then
+  try
+    GetMem(PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE);
+    try
+      if DeviceIoControl(HFile, FSCTL_GET_REPARSE_POINT, nil, 0,
+        PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, @BytesReturned, nil) then
+      begin
+        case PBuffer^.ReparseTag of
+          IO_REPARSE_TAG_MOUNT_POINT:
+            begin
+              LinkTargetName := WideCharLenToString(
+                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
+                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
+                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
+            end;
+          IO_REPARSE_TAG_SYMLINK:
+            begin
+              LinkTargetName := WideCharLenToString(
+                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
+                PBuffer^.PrintNameLength div SizeOf(WCHAR));
+              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
+                LinkTargetName := ExpandFileName(
+                  ExtractFilePath(LinkSourceName) + LinkTargetName);
+            end
+        else
+          SetLastError(ERROR_REPARSE_TAG_INVALID);
+        end;
+      end;
+    finally
+      FreeMem(PBuffer);
+    end;
+  finally
+    CloseHandle(HFile);
+  end;
+  Result := LinkTargetName <> '';
+end;
 
+function GetLinkTargetName(const LinkSourceName: RawByteString;
+  out LinkTargetName: RawByteString): Boolean;
+var
+  LinkTargetNameW: UnicodeString;
+begin
+  Result := GetLinkTargetName(UnicodeString(LinkSourceName), LinkTargetNameW);
+  LinkTargetName := string(LinkTargetNameW);
+end;
+
+
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
links.diff (9,993 bytes)

Thaddy de Koning

2017-09-05 11:42

reporter   ~0102642

Last edited: 2017-09-05 11:44

View 2 revisions

Which Delphi version..... Up to and including XE2 it doesn't...
And... the Delphi code (post- Berlin) will crash when there is no connection.

Suggest to skip this..... Even in Delphi it is immature. Nice to have...
It is also not a good idea to have such a feature (really an obvious security risk) in a language.

Thaddy de Koning

2017-09-05 11:49

reporter   ~0102643

Stronger: If one does allow it as proposed, I go to the curly brackets. It is that stupid (or smart...)

Thaddy de Koning

2017-09-05 12:05

reporter   ~0102645

Also, do not think you own my computer.... Maybe I should hide this... But I don'.t... Tnx for the "response"..... Some (smart) moderator?

Thaddy de Koning

2017-09-05 12:19

reporter   ~0102649

This patch needs to be examined thoroughly.

Serge Anvarov

2017-09-06 05:08

reporter  

links37149.diff (10,010 bytes)
Index: rtl/objpas/sysutils/filutil.inc
===================================================================
--- rtl/objpas/sysutils/filutil.inc	(revision 37149)
+++ rtl/objpas/sysutils/filutil.inc	(working copy)
@@ -292,34 +292,58 @@
 end;
 {$endif}
 
+function ContainsWildcards(const S: UnicodeString): Boolean;
+var
+  i: Integer;
+begin
+  for i := Low(S) to High(S) do
+    case S[i] of
+      '*', '?':
+         Exit(True);
+    end;
+  Result := False;
+end;
 
-function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
-Var
-  Info : TUnicodeSearchRec;
-  A : Integer;
+function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime;
+  FollowLink: Boolean = True): Boolean;
 
+{$IFDEF WINDOWS}
+  function FileLinkAge(const LinkSourceName: UnicodeString;
+    out FileDateTime: TDateTime): Boolean;
+  var
+    LinkTargeName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
+      FileAge(LinkTargeName, FileDateTime);
+  end;
+{$ENDIF}
+
+var
+  Info: TUnicodeSearchRec;
+  Attr: Longint;
 begin
-  for A:=1 to Length(FileName) do
-    if CharInSet(FileName[A],['?','*']) then
-      Exit(False);
-  A:=0;
+  if ContainsWildcards(FileName) then
+    Exit(False);
+  Attr := 0;
   if not FollowLink then
-    A:=A or faSymLink;
-  Result:=FindFirst(FileName,A,Info)=0;
+    Attr := Attr or faSymLink;
+  Result := FindFirst(FileName, Attr, Info) = 0;
   if Result then
-    begin
-      FileDateTime:=FileDatetoDateTime(Info.Time);
-      FindClose(Info);
-    end;
+  begin
+    FileDateTime := FileDateToDateTime(Info.Time);
+    FindClose(Info);
+{$IFDEF WINDOWS}
+    if ((FileGetAttr(FileName) and faSymLink) <> 0) and FollowLink then
+      Result := FileLinkAge(FileName, FileDateTime);
+{$ENDIF}
+  end;
 end;
 
-
 Function FileAge(const FileName: RawbyteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
 begin
   Result:=FileAge(UnicodeString(FileName),FileDateTime,FollowLink);
 end;
 
-
 Function FileSearch (Const Name, DirList : UnicodeString; Options : TFileSearchoptions = [sfoImplicitCurrentDir]) : UnicodeString;
 Var
   I : longint;
Index: rtl/win/sysutils.pp
===================================================================
--- rtl/win/sysutils.pp	(revision 37149)
+++ rtl/win/sysutils.pp	(working copy)
@@ -86,6 +86,18 @@
 procedure GetFormatSettings;
 procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
 
+// Valid for a directory with mount point (junction) or a symbolic link
+// Valid for a file with a symbolic link
+function GetLinkTargetName(const LinkSourceName: UnicodeString;
+  out LinkTargetName: UnicodeString): Boolean; overload;
+function GetLinkTargetName(const LinkSourceName: RawByteString;
+  out LinkTargetName: RawByteString): Boolean; overload;
+
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
+
 implementation
 
   uses
@@ -383,32 +395,34 @@
 end;
 
 
-Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
+function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
 var
-  lft : TFileTime;
+  lft: TFileTime;
 begin
-  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
-                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
+  Result := FileTimeToLocalFileTime(@WTime, @lft) and
+    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
 end;
 
 
-Function FileAge (Const FileName : UnicodeString): Longint;
+function FileAge(const FileName: UnicodeString): Longint;
 var
   Handle: THandle;
   FindData: TWin32FindDataW;
 begin
-  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
-  if Handle <> INVALID_HANDLE_VALUE then
+  if not ContainsWildcards(FileName) then
+  begin
+    Handle := FindFirstFileW(PUnicodeChar(FileName), @FindData);
+    if Handle <> INVALID_HANDLE_VALUE then
     begin
       Windows.FindClose(Handle);
       if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
+        if WinToDosTime(FindData.ftLastWriteTime, Result) then
+          Exit;
     end;
+  end;
   Result := -1;
 end;
 
-
 Function FileExists (Const FileName : UnicodeString) : Boolean;
 var
   Attr:Dword;
@@ -422,6 +436,33 @@
 end;
 
 
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean; overload;
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+
+  function LinkFileExists(const LinkSourceName: UnicodeString): Boolean;
+  var
+    LinkTargetName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
+      FileExists(LinkTargetName);
+  end;
+
+var
+  Attr: Longint;
+begin
+  Attr := FileGetAttr(FileName);
+  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
+    ((Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
+  if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
+    Result := LinkFileExists(FileName);
+end;
+
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean; overload;
+begin
+  Result := FileExists(UnicodeString(FileName), FollowLink);
+end;
+
 Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
 var
   Attr:Dword;
@@ -433,6 +474,33 @@
     Result:=False;
 end;
 
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean; overload;
+
+  function LinkDirExists(const LinkSourceName: UnicodeString): Boolean;
+  var
+    LinkTargetName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargetName) and
+      DirectoryExists(LinkTargetName);
+  end;
+
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+var
+  Attr: Longint;
+begin
+  Attr := FileGetAttr(Directory);
+  Result := (Attr <> INVALID_FILE_ATTRIBUTES) and
+    ((Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0);
+  if Result and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) and FollowLink then
+    Result := LinkDirExists(Directory);
+end;
+
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean; overload;
+begin
+  Result := DirectoryExists(UnicodeString(Directory), FollowLink);
+end;
+
 Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
 begin
   { Find file with correct attribute }
@@ -557,7 +625,93 @@
   Result := MoveFileW(PWideChar(OldName), PWideChar(NewName));
 end;
 
+// Valid for a directory with mount point (junction) or a symbolic link
+// Valid for a file with a symbolic link
+function GetLinkTargetName(const LinkSourceName: UnicodeString;
+  out LinkTargetName: UnicodeString): Boolean;
+const
+  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
+  IO_REPARSE_TAG_SYMLINK = $A000000C;
+  ERROR_REPARSE_TAG_INVALID = 4393;
+type
+  TReparseDataBuffer = record
+    ReparseTag: ULONG;
+    ReparseDataLength: Word;
+    Reserved: Word;
+    SubstituteNameOffset: Word;
+    SubstituteNameLength: Word;
+    PrintNameOffset: Word;
+    PrintNameLength: Word;
+    case ULONG of
+      IO_REPARSE_TAG_MOUNT_POINT: (
+        PathBufferMount: array [0..4095] of WCHAR);
+      IO_REPARSE_TAG_SYMLINK: (
+        Flags: ULONG;
+        PathBufferSym: array [0..4095] of WCHAR);
+    end;
+const
+  FSCTL_GET_REPARSE_POINT = $900A8;
+  MAXIMUM_REPARSE_DATA_BUFFER_SIZE = 16 * 1024;
+  SYMLINK_FLAG_RELATIVE = 1;
+  FILE_FLAG_OPEN_REPARSE_POINT = $200000;
+  FILE_READ_EA = $8;
+  CShareAny = FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE;
+  COpenReparse = FILE_FLAG_OPEN_REPARSE_POINT or FILE_FLAG_BACKUP_SEMANTICS;
+var
+  HFile: THandle;
+  PBuffer: ^TReparseDataBuffer;
+  BytesReturned: DWORD;
+begin
+  LinkTargetName := '';
+  HFile := CreateFileW(PUnicodeChar(LinkSourceName), FILE_READ_EA, CShareAny,
+    nil, OPEN_EXISTING, COpenReparse, 0);
+  if HFile <> INVALID_HANDLE_VALUE then
+  try
+    GetMem(PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE);
+    try
+      if DeviceIoControl(HFile, FSCTL_GET_REPARSE_POINT, nil, 0,
+        PBuffer, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, @BytesReturned, nil) then
+      begin
+        case PBuffer^.ReparseTag of
+          IO_REPARSE_TAG_MOUNT_POINT:
+            begin
+              LinkTargetName := WideCharLenToString(
+                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
+                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
+                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
+            end;
+          IO_REPARSE_TAG_SYMLINK:
+            begin
+              LinkTargetName := WideCharLenToString(
+                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
+                PBuffer^.PrintNameLength div SizeOf(WCHAR));
+              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
+                LinkTargetName := ExpandFileName(
+                  ExtractFilePath(LinkSourceName) + LinkTargetName);
+            end
+        else
+          SetLastError(ERROR_REPARSE_TAG_INVALID);
+        end;
+      end;
+    finally
+      FreeMem(PBuffer);
+    end;
+  finally
+    CloseHandle(HFile);
+  end;
+  Result := LinkTargetName <> '';
+end;
 
+function GetLinkTargetName(const LinkSourceName: RawByteString;
+  out LinkTargetName: RawByteString): Boolean;
+var
+  LinkTargetNameW: UnicodeString;
+begin
+  Result := GetLinkTargetName(UnicodeString(LinkSourceName), LinkTargetNameW);
+  LinkTargetName := string(LinkTargetNameW);
+end;
+
+
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
links37149.diff (10,010 bytes)

Serge Anvarov

2017-09-06 05:09

reporter  

Project1.lpr (7,488 bytes)

Serge Anvarov

2017-09-06 05:09

reporter   ~0102656

Please, examine. I'm attached the test project, as well as a new version of the diff file for revision 37149.

Thaddy de Koning

2018-08-21 18:52

reporter   ~0110210

Last edited: 2018-08-21 18:54

View 2 revisions

I think, mind you given some *very* recent windows 10 updates, it is currently less than a risk than I originally envisioned. For older systems though, I stick to my statement. In the light of normal users.
Didn't I post an example? or was that on the forum?

Serge Anvarov

2018-08-23 00:53

reporter  

FileOrDirExists39662.diff (7,588 bytes)
Index: rtl/objpas/sysutils/filutil.inc
===================================================================
--- rtl/objpas/sysutils/filutil.inc	(revision 39662)
+++ rtl/objpas/sysutils/filutil.inc	(working copy)
@@ -100,22 +100,43 @@
 
 
 function FileAge(const FileName: RawByteString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
-Var
-  Info : TRawByteSearchRec;
-  A : Integer;
+
+{$IFDEF WINDOWS}
+  function FileLinkAge(const LinkSourceName: UnicodeString;
+    out FileDateTime: TDateTime): Boolean;
+  var
+    LinkTargeName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(LinkSourceName, LinkTargeName) and
+      FileAge(LinkTargeName, FileDateTime);
+  end;
+{$ENDIF}
+
+{$PUSH}
+{$WARN 5044 OFF : Symbol "$1" is not portable}
+const
+  faSymLinkNoWarning = faSymLink;
+{$POP}
+
+var
+  Info: TUnicodeSearchRec;
+  Attr: Longint;
 begin
-  for A:=1 to Length(FileName) do
-    if CharInSet(FileName[A],['?','*']) then
-      Exit(False);
-  A:=0;
+  if ContainsWildcards(FileName) then
+    Exit(False);
+  Attr := 0;
   if not FollowLink then
-    A:=A or faSymLink;
-  Result:=FindFirst(FileName,A,Info)=0;
+    Attr := Attr or faSymLinkNoWarning;
+  Result := FindFirst(FileName, Attr, Info) = 0;
   if Result then
-    begin
-      FileDateTime:=FileDatetoDateTime(Info.Time);
-      FindClose(Info);
-    end;
+  begin
+    FileDateTime := FileDateToDateTime(Info.Time);
+    FindClose(Info);
+{$IFDEF WINDOWS}
+    if ((FileGetAttr(FileName) and faSymLinkNoWarning) <> 0) and FollowLink then
+      Result := FileLinkAge(FileName, FileDateTime);
+{$ENDIF}
+  end;
 end;
 
 
@@ -292,6 +313,15 @@
 end;
 {$endif}
 
+function ContainsWildcards(const S: UnicodeString): Boolean;
+var
+  C: UnicodeChar;
+begin
+  for C in S do
+    if (C = '*') or (C = '?') then
+       Exit(True);
+  Result := False;
+end;
 
 function FileAge(const FileName: UnicodeString; out FileDateTime: TDateTime; FollowLink: Boolean = True): Boolean;
 Var
Index: rtl/win/sysutils.pp
===================================================================
--- rtl/win/sysutils.pp	(revision 39662)
+++ rtl/win/sysutils.pp	(working copy)
@@ -86,6 +86,16 @@
 procedure GetFormatSettings;
 procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings); platform;
 
+function GetLinkTargetName(const LinkSourceName: UnicodeString;
+  out LinkTargetName: UnicodeString): Boolean;
+function GetLinkTargetName(const LinkSourceName: RawByteString;
+  out LinkTargetName: RawByteString): Boolean;
+
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean;
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean;
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean;
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean;
+
 implementation
 
   uses
@@ -380,57 +390,120 @@
                 LocalFileTimeToFileTime(lft,Wtime);
 end;
 
-
-Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
+function WinToDosTime(const WTime: TFileTime; out DTime: Longint): LongBool;
 var
-  lft : TFileTime;
+  lft: TFileTime;
 begin
-  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
-                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
+  Result := FileTimeToLocalFileTime(@WTime, @lft) and
+    FileTimeToDosDateTime(@lft, @LongRec(DTime).Hi, @LongRec(DTime).Lo);
 end;
 
 
-Function FileAge (Const FileName : UnicodeString): Longint;
+function FileAge(const FileName: UnicodeString): Longint;
 var
   Handle: THandle;
   FindData: TWin32FindDataW;
 begin
-  Handle := FindFirstFileW(Pwidechar(FileName), FindData);
-  if Handle <> INVALID_HANDLE_VALUE then
+  if not ContainsWildcards(FileName) then
+  begin
+    Handle := FindFirstFileExW(PUnicodeChar(FileName), FindExInfoBasic, @FindData,
+      FindExSearchNameMatch, nil, 0); // It's faster, than FindFirstFile
+    if Handle <> INVALID_HANDLE_VALUE then
     begin
       Windows.FindClose(Handle);
       if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
+        if WinToDosTime(FindData.ftLastWriteTime, Result) then
+          Exit;
     end;
+  end;
   Result := -1;
 end;
 
+function FileOrDirExists(const FileOrDirName: UnicodeString; CheckDir: Boolean;
+  FollowLink: Boolean): Boolean;
 
-Function FileExists (Const FileName : UnicodeString) : Boolean;
+const
+  CDirAttributes: array[Boolean] of DWORD = (0, FILE_ATTRIBUTE_DIRECTORY);
+
+  function FoundByEnum: Boolean;
+  var
+    FindData: TWin32FindDataW;
+    Handle: THandle;
+  begin
+    Handle := FindFirstFileExW(PUnicodeChar(FileOrDirName), FindExInfoBasic, @FindData,
+      FindExSearchNameMatch, nil, 0); // It's faster, than FindFirstFile
+    Result := Handle <> INVALID_HANDLE_VALUE;
+    if Result then
+    begin
+      Windows.FindClose(Handle);
+      Result := (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
+    end;
+  end;
+
+  function LinkFileExists: Boolean;
+  var
+    LinkTargetName: UnicodeString;
+  begin
+    Result := GetLinkTargetName(FileOrDirName, LinkTargetName) and
+      FileOrDirExists(LinkTargetName, CheckDir, False);
+  end;
+
+const
+  INVALID_FILE_ATTRIBUTES = -1;
+  CNotExistsErrors = [
+    ERROR_FILE_NOT_FOUND,
+    ERROR_PATH_NOT_FOUND,
+    ERROR_INVALID_NAME,    // Protects from names in the form of masks like '*'
+    ERROR_INVALID_DRIVE,
+    ERROR_NOT_READY,
+    ERROR_INVALID_PARAMETER,
+    ERROR_BAD_PATHNAME,
+    ERROR_BAD_NETPATH,
+    ERROR_BAD_NET_NAME];
 var
-  Attr:Dword;
+  Attr: LongInt;
 begin
-
-  Attr:=GetFileAttributesW(PWideChar(FileName));
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
+  Attr := FileGetAttr(FileOrDirName);
+  if Attr = INVALID_FILE_ATTRIBUTES then
+    Result := not (GetLastError in CNotExistsErrors) and FoundByEnum
   else
-    Result:=False;
+  begin
+    Result := (Attr and FILE_ATTRIBUTE_DIRECTORY) = CDirAttributes[CheckDir];
+    if Result and FollowLink and ((Attr and FILE_ATTRIBUTE_REPARSE_POINT) <> 0) then
+      Result := LinkFileExists;
+  end;
 end;
 
+function FileExists(const FileName: UnicodeString): Boolean;
+begin
+  Result := FileOrDirExists(FileName, False, False);
+end;
 
-Function DirectoryExists (Const Directory : UnicodeString) : Boolean;
-var
-  Attr:Dword;
+function FileExists(const FileName: UnicodeString; FollowLink: Boolean): Boolean;
 begin
-  Attr:=GetFileAttributesW(PWideChar(Directory));
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0
-  else
-    Result:=False;
+  Result := FileOrDirExists(FileName, False, FollowLink);
 end;
 
+function FileExists(const FileName: RawByteString; FollowLink: Boolean): Boolean;
+begin
+  Result := FileOrDirExists(UnicodeString(FileName), False, FollowLink);
+end;
+
+function DirectoryExists(const Directory: UnicodeString; FollowLink: Boolean): Boolean;
+begin
+  Result := FileOrDirExists(Directory, True, FollowLink);
+end;
+
+function DirectoryExists(const Directory: RawByteString; FollowLink: Boolean): Boolean;
+begin
+  Result := FileOrDirExists(UnicodeString(Directory), True, FollowLink);
+end;
+
+function DirectoryExists(const Directory: UnicodeString): Boolean;
+begin
+  Result := FileOrDirExists(Directory, True, False);
+end;
+
 Function FindMatch(var f: TAbstractSearchRec; var Name: UnicodeString) : Longint;
 begin
   { Find file with correct attribute }

Serge Anvarov

2018-08-23 00:53

reporter  

project1.lpr (8,802 bytes)

Serge Anvarov

2018-08-23 00:55

reporter   ~0110247

Add new FileExists, DirectoryExists implementation (based on https://forum.lazarus.freepascal.org/index.php/topic,42155.0.html).

Sven Barth

2018-08-24 17:46

manager   ~0110290

Thank you for your patches.

- I've changed LinkGetTargetName to be the Delphi compatible FileGetSymLinkTarget with the addition that it's available for all platforms (despite returning False on nearly all).
- Instead of adding overloads I went the Delphi route and added a default FollowLink parameter to DirectoryExists() and FileExists() for all platforms.
- I've not yet applied your FileAge changes as I first want to check how it behaves on Unix systems (in addition your change is incomplete as you didn't include the UnicodeString variant and the RawByteString wouldn't find ContainsWildcards due to the order)

Now we only need FileGetSymLinkTarget and the FollowLink behavior for Unix and we're set. :)

Marco van de Voort

2018-08-25 15:25

manager   ~0110302

I google a bit and *nix uses access(), analogous to Windows getfileattr for basic fileexists functionality. direxists uses stat.

- both currently probably follow symlinks, so the default true is already the case.
- checking for symlinks is done using lstat.
- fileexists contains a warning about stat not working for files >32-bit. (I assume Linux only, and are we not through this transition meanwhile?)


Besides that, there is a warning that access() checks real and not effective user rights, which might not be reliable inside programs started with SETUID/SETGID

Sergey Bychkow

2019-06-21 18:49

reporter   ~0116823

FileExists doesn't work with default parameter FollowLink = True. See 0035744

Serge Anvarov

2019-06-22 16:25

reporter   ~0116852

Bart, when you ported my code, you made a typo.
My code:
              LinkTargetName := WideCharLenToString(
                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
                PBuffer^.PrintNameLength div SizeOf(WCHAR));
New code
              SymLinkRec.TargetName := WideCharLenToString(
                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
                PBuffer^.PrintNameOffset div SizeOf(WCHAR));
The last line should be with PrintNameLength instead of PrintNameOffset.

Anton Kavalenka

2019-06-25 16:46

reporter   ~0116925

Last edited: 2019-06-25 16:47

View 2 revisions

tested with
program test;
uses sysutils;
begin
  writeln(FileExists(ParamStr(1)));
end.

patch fixes the problem



sysutils-win.diff (688 bytes)
Index: sysutils.pp
===================================================================
--- sysutils.pp	(revision 42284)
+++ sysutils.pp	(working copy)
@@ -462,7 +462,7 @@
             IO_REPARSE_TAG_SYMLINK: begin
               SymLinkRec.TargetName := WideCharLenToString(
                 @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
-                PBuffer^.PrintNameOffset div SizeOf(WCHAR));
+                PBuffer^.PrintNameLength div SizeOf(WCHAR));
               if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
                 SymLinkRec.TargetName := ExpandFileName(ExtractFilePath(FileName) + SymLinkRec.TargetName);
             end;
sysutils-win.diff (688 bytes)

Anton Kavalenka

2019-07-18 13:32

reporter   ~0117303

ping @Sven Barth

patch is trivial (just copy-paste error) - why not apply it?

Sven Barth

2019-07-19 17:56

manager   ~0117320

Sorry, forgot about the patch. Thank you!

Marco van de Voort

2019-09-03 17:03

manager   ~0117939

What still needs to be done for this?

Anton Kavalenka

2019-09-03 17:14

reporter   ~0117940

Last edited: 2019-09-03 17:15

View 2 revisions

* implementation for OSes other than Windows and supporting symlinks
* testsuite

For instance UNIX version of FileExists looks like

Function FileExists (Const FileName : RawByteString; FollowLink : Boolean) : Boolean;
var
  SystemFileName: RawByteString;
begin
  SystemFileName:=ToSingleByteFileSystemEncodedFileName(FileName);
  // Don't use stat. It fails on files >2 GB.
  // Access obeys the same access rules, so the result should be the same.
  FileExists:=fpAccess(pointer(SystemFileName),F_OK)=0;
end;

Specifying FollowLink=false would be ignored

Thaddy de Koning

2019-09-04 09:02

reporter   ~0117947

Last edited: 2019-09-04 09:03

View 2 revisions

@Aserge
I still can't get it to work on arm-linux. I suppose I am doing something wrong. Is it Windows specific?
I hoped it was cross platform.

Serge Anvarov

2019-09-04 18:06

reporter   ~0117953

I opened issue specifically for Windows (see issue Platform), and the solution was just for it. Bart subsequently decided to expand to *nix. But I don't have a *nix environment, so I won't even be able to test it.

Anton Kavalenka

2019-09-04 22:16

reporter   ~0117954

Seems like UNIX fix is simple:

access() always dereferences symbolic links. If you need to check the permissions on a symbolic link, use faccessat() with the flag AT_SYMLINK_NOFOLLOW.

Bart Broersma

2019-09-04 22:20

reporter   ~0117955

> Bart subsequently decided to expand to *nix.
Huh?

Anton Kavalenka

2019-09-05 15:30

reporter   ~0117960

Oops
faccessat() has no corresponding Fp* wrapper but in any way called via syscall inside access() wrapper

function Fpaccess(pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
{
  Test users access rights on the specified file.
  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
  R,W,X stand for read,write and Execute access, simultaneously.
  F_OK checks whether the test would be allowed on the file.
  i.e. It checks the search permissions in all directory components
  of the path.
  The test is done with the real user-ID, instead of the effective.
  If access is denied, or an error occurred, false is returned.
  If access is granted, true is returned.
  Errors other than no access,are reported in unixerror.
}

begin
{$if defined(generic_linux_syscalls)}
 FpAccess:=do_syscall(syscall_nr_faccessat,AT_FDCWD,TSysParam(pathname),amode,0);
{$else}
 FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
{$endif}
end;

Marco van de Voort

2019-09-05 20:13

manager   ~0117961

Research the relevant call at the open group site, and see if you can make it *nix general.

Issue History

Date Modified Username Field Change
2017-09-04 21:32 Serge Anvarov New Issue
2017-09-04 21:32 Serge Anvarov File Added: links.diff
2017-09-05 11:42 Thaddy de Koning Note Added: 0102642
2017-09-05 11:44 Thaddy de Koning Note Edited: 0102642 View Revisions
2017-09-05 11:49 Thaddy de Koning Note Added: 0102643
2017-09-05 12:05 Thaddy de Koning Note Added: 0102645
2017-09-05 12:19 Thaddy de Koning Note Added: 0102649
2017-09-06 05:08 Serge Anvarov File Added: links37149.diff
2017-09-06 05:09 Serge Anvarov File Added: Project1.lpr
2017-09-06 05:09 Serge Anvarov Note Added: 0102656
2018-08-21 18:52 Thaddy de Koning Note Added: 0110210
2018-08-21 18:54 Thaddy de Koning Note Edited: 0110210 View Revisions
2018-08-23 00:53 Serge Anvarov File Added: FileOrDirExists39662.diff
2018-08-23 00:53 Serge Anvarov File Added: project1.lpr
2018-08-23 00:55 Serge Anvarov Note Added: 0110247
2018-08-24 15:43 Sven Barth Assigned To => Sven Barth
2018-08-24 15:43 Sven Barth Status new => assigned
2018-08-24 17:46 Sven Barth Note Added: 0110290
2018-08-24 17:46 Sven Barth Fixed in Revision => 39670,39671
2018-08-25 15:25 Marco van de Voort Note Added: 0110302
2019-06-21 18:49 Sergey Bychkow Note Added: 0116823
2019-06-22 16:25 Serge Anvarov Note Added: 0116852
2019-06-25 16:46 Anton Kavalenka File Added: sysutils-win.diff
2019-06-25 16:46 Anton Kavalenka Note Added: 0116925
2019-06-25 16:47 Anton Kavalenka Note Edited: 0116925 View Revisions
2019-07-18 13:32 Anton Kavalenka Note Added: 0117303
2019-07-19 17:28 Sven Barth Relationship added parent of 0035744
2019-07-19 17:56 Sven Barth Note Added: 0117320
2019-09-03 17:03 Marco van de Voort Status assigned => feedback
2019-09-03 17:03 Marco van de Voort FPCTarget => -
2019-09-03 17:03 Marco van de Voort Note Added: 0117939
2019-09-03 17:14 Anton Kavalenka Note Added: 0117940
2019-09-03 17:15 Anton Kavalenka Note Edited: 0117940 View Revisions
2019-09-04 09:02 Thaddy de Koning Note Added: 0117947
2019-09-04 09:03 Thaddy de Koning Note Edited: 0117947 View Revisions
2019-09-04 18:06 Serge Anvarov Note Added: 0117953
2019-09-04 18:06 Serge Anvarov Status feedback => assigned
2019-09-04 22:16 Anton Kavalenka Note Added: 0117954
2019-09-04 22:20 Bart Broersma Note Added: 0117955
2019-09-05 15:30 Anton Kavalenka Note Added: 0117960
2019-09-05 20:13 Marco van de Voort Note Added: 0117961