They crossed it seems. It would be nice to have the urls that were the sources for that patch, and why the exception is needed. Maybe we can prepare more such cases.
The patch is written by me.
Look at the attached
testLinkFileExists.pas program.
As suggested by
ASerge (Do it if you think so), I extracted the suspected routine
FileGetSymLinkTargetInt and added DEBUG output text to follow the code.
I found that case $9000601A was not handled (case PBuffer^.ReparseTag of).
Saving the whole TReparseDataBuffer record content to PBuffer.dat file helped me to understand that no more info about the link is available within the extracted data.
Googling 0x9000601A I found IO_REPARSE_TAG_CLOUD_6 and other tags related to OneDrive / Cloud in general.
All Reparse Tags are listed here:
https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4That's all.
program test;
{$MODE objfpc}
{$MODESWITCH OUT}
{ force ansistrings }
{$H+}
{$modeswitch typehelpers}
{$modeswitch advancedrecords}
uses
Windows, SysUtils;
var
FindExInfoDefaults : TFINDEX_INFO_LEVELS = FindExInfoStandard;
function MyFileGetSymLinkTargetInt(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec; RaiseErrorOnMissing: Boolean): Boolean;
{ reparse point specific declarations from Windows headers }
const
IO_REPARSE_TAG_MOUNT_POINT = $A0000003;
IO_REPARSE_TAG_SYMLINK = $A000000C;
IO_REPARSE_TAG_CLOUD = $9000001A;
IO_REPARSE_TAG_CLOUD_1 = $9000101A;
IO_REPARSE_TAG_CLOUD_2 = $9000201A;
IO_REPARSE_TAG_CLOUD_3 = $9000301A;
IO_REPARSE_TAG_CLOUD_4 = $9000401A;
IO_REPARSE_TAG_CLOUD_5 = $9000501A;
IO_REPARSE_TAG_CLOUD_6 = $9000601A;
IO_REPARSE_TAG_CLOUD_7 = $9000701A;
IO_REPARSE_TAG_CLOUD_8 = $9000801A;
IO_REPARSE_TAG_CLOUD_9 = $9000901A;
IO_REPARSE_TAG_CLOUD_A = $9000A01A;
IO_REPARSE_TAG_CLOUD_B = $9000B01A;
IO_REPARSE_TAG_CLOUD_C = $9000C01A;
IO_REPARSE_TAG_CLOUD_D = $9000D01A;
IO_REPARSE_TAG_CLOUD_E = $9000E01A;
IO_REPARSE_TAG_CLOUD_F = $9000F01A;
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;
f: file;
begin
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
// Save to buffer.dat TReparseDataBuffer record content
writeln('BytesReturned ', BytesReturned);
AssignFile(f,'buffer.dat');
Rewrite(f, 1);
BlockWrite(f, PBuffer^, BytesReturned);
closeFile(f);
case PBuffer^.ReparseTag of
IO_REPARSE_TAG_MOUNT_POINT: begin
// DEBUG
writeln('case IO_REPARSE_TAG_MOUNT_POINT');
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
// DEBUG
writeln('case IO_REPARSE_TAG_SYMLINK');
SymLinkRec.TargetName := WideCharLenToString(
@PBuffer^.PathBufferSym[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;
// IO_REPARSE_TAG_CLOUD,
// IO_REPARSE_TAG_CLOUD_1,
// IO_REPARSE_TAG_CLOUD_2,
// IO_REPARSE_TAG_CLOUD_3,
// IO_REPARSE_TAG_CLOUD_4,
// IO_REPARSE_TAG_CLOUD_5,
// IO_REPARSE_TAG_CLOUD_6,
// IO_REPARSE_TAG_CLOUD_7,
// IO_REPARSE_TAG_CLOUD_8,
// IO_REPARSE_TAG_CLOUD_9,
// IO_REPARSE_TAG_CLOUD_A,
// IO_REPARSE_TAG_CLOUD_B,
// IO_REPARSE_TAG_CLOUD_C,
// IO_REPARSE_TAG_CLOUD_D,
// IO_REPARSE_TAG_CLOUD_E,
// IO_REPARSE_TAG_CLOUD_F: begin
// SymLinkRec.TargetName := FileName;
// end;
else
// DEBUG
writeln('case 0x', IntTohex(PBuffer^.ReparseTag,8));
end;
Handle := FindFirstFileExW(PUnicodeChar(SymLinkRec.TargetName), FindExInfoDefaults , @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 if RaiseErrorOnMissing then
raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError))
else
SymLinkRec.TargetName := '';
end else
begin
SetLastError(ERROR_REPARSE_TAG_INVALID);
end;
finally
FreeMem(PBuffer);
end;
finally
CloseHandle(HFile);
end;
Result := SymLinkRec.TargetName <> '';
end;
function MyFileGetSymLinkTarget(const FileName: UnicodeString; out SymLinkRec: TUnicodeSymLinkRec): Boolean;
begin
Result := MyFileGetSymLinkTargetInt(FileName, SymLinkRec, True);
end;
function MyLinkFileExists(FileOrDirName: String): Boolean;
var
slr: TUnicodeSymLinkRec;
begin
Result := MyFileGetSymLinkTargetInt(FileOrDirName, slr, False);
end;
procedure testRoutine(FileName: String);
begin
writeln('Testing ', FileName);
if MyLinkFileExists(FileName) then
writeln('MyLinkFileExists')
else
writeln('ERROR');
writeln;
end;
begin
// Point to an existing OneDrive for Business file
testRoutine(ParamStr(1));
readln;
end.