+ implement FileGetSymLinkTarget() based on patch by Serge Anvarov in Mantis #32370

git-svn-id: trunk@39671 -

rtl/objpas/sysutils/filutil.inc

@@ -609,15 +609,33 @@ end;
 { TUnicodeSymLinkRec }
 
 function TUnicodeSymLinkRec.GetTimeStamp: TDateTime;
+{$if defined(win32) or defined(win64) or defined(wince)}
+var
+  st: TSystemTime;
+{$endif}
 begin
+{$if defined(win32) or defined(win64) or defined(wince)}
+  FileTimeToSystemTime(FindData.ftLastWriteTime, st);
+  Result := SystemTimeToDateTime(st);
+{$else}
   Result := 0;
+{$endif}
 end;
 
 { TRawbyteSymLinkRec }
 
 function TRawbyteSymLinkRec.GetTimeStamp: TDateTime;
+{$if defined(win32) or defined(win64) or defined(wince)}
+var
+  st: TSystemTime;
+{$endif}
 begin
+{$if defined(win32) or defined(win64) or defined(wince)}
+  FileTimeToSystemTime(FindData.ftLastWriteTime, st);
+  Result := SystemTimeToDateTime(st);
+{$else}
   Result := 0;
+{$endif}
 end;
 
 

rtl/objpas/sysutils/filutilh.inc

@@ -24,6 +24,7 @@ Type
   // Some operating systems need extra find data.
 {$if defined(Win32) or defined(WinCE) or defined(Win64)}
     {$define SEARCHREC_USEFINDDATA}
+    {$define SYMLINKREC_USEFINDDATA}
     TFindData = TWin32FindDataW;
 {$endif}
 {$ifdef netware_clib}

rtl/win/sysutils.pp

@@ -408,8 +408,83 @@ end;
 
 
 function FileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
+{ reparse point specific declarations from Windows headers }
+const
+  IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
+  IO_REPARSE_TAG_SYMLINK = $A000000C;
+  ERROR_REPARSE_TAG_INVALID = 4393;
+  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;
+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
+  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, Handle: THandle;
+  PBuffer: ^TReparseDataBuffer;
+  BytesReturned: DWORD;
 begin
-  Result := False;
+  SymLinkRec := Default(TUnicodeSymLinkRec);
+
+  HFile := CreateFileW(PUnicodeChar(FileName), 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
+              SymLinkRec.TargetName := WideCharLenToString(
+                @PBuffer^.PathBufferMount[4 { skip start '\??\' } +
+                  PBuffer^.SubstituteNameOffset div SizeOf(WCHAR)],
+                PBuffer^.SubstituteNameLength div SizeOf(WCHAR) - 4);
+            end;
+            IO_REPARSE_TAG_SYMLINK: begin
+              SymLinkRec.TargetName := WideCharLenToString(
+                @PBuffer^.PathBufferSym[PBuffer^.PrintNameOffset div SizeOf(WCHAR)],
+                PBuffer^.PrintNameOffset div SizeOf(WCHAR));
+              if (PBuffer^.Flags and SYMLINK_FLAG_RELATIVE) <> 0 then
+                SymLinkRec.TargetName := ExpandFileName(ExtractFilePath(FileName) + SymLinkRec.TargetName);
+            end;
+          end;
+
+          Handle := FindFirstFileExW(PUnicodeChar(FileName), FindExInfoBasic, @SymLinkRec.FindData,
+                      FindExSearchNameMatch, Nil, 0);
+          if Handle <> INVALID_HANDLE_VALUE then begin
+            Windows.FindClose(Handle);
+            SymLinkRec.Attr := SymLinkRec.FindData.dwFileAttributes;
+            SymLinkRec.Size := QWord(SymLinkRec.FindData.nFileSizeHigh) shl 32 + QWord(SymLinkRec.FindData.nFileSizeLow);
+          end else
+            SymLinkRec.TargetName := '';
+        end else
+          SetLastError(ERROR_REPARSE_TAG_INVALID);
+      finally
+        FreeMem(PBuffer);
+      end;
+    finally
+      CloseHandle(HFile);
+    end;
+  Result := SymLinkRec.TargetName <> '';
 end;