View Issue Details

IDProjectCategoryView StatusLast Update
0032370FPCRTLpublic2019-07-19 17:56
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!

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