[lnkForumImage]
TotalShareware - Download Free Software

Confronta i prezzi di migliaia di prodotti.
Asp Forum
 Home | Login | Register | Search 


 

Forums >

microsoft.public.vb.general.discussion

Junction points and DeviceIoControl/FSCTL_GET_REPARSE_POINT control code

Tony Toews

8/2/2012 7:01:00 AM

Folks

I'm trying to read the actual directory name of a Windows 7 junction
point.. Classic example is C:\Users\ttoews\Application Data which
doesn't actually exist. Although it appears to exist in Windows
Explorer. Instead, for me. it's really
C:\Users\ttoews\AppData\Roaming

Another example is c:\Documents and Settings which is really C:\Users

So I'm trying to convert various chunks of C++ or other languages code
to VB6 and am struggling greatly because I really don't have a clue
how to convert somewhat complex API code from C++ examples to VB6.

The MSDN code is FSCTL_GET_REPARSE_POINT control code as found at
http://msdn.microsoft.com/en-us/library/windows/desktop/aa364571%28v=vs....

The problems I'm having are

1) I have to create the following structure inside a structure as a
Type. And I have no idea how.

REPARSE_DATA_BUFFER structure
http://msdn.microsoft.com/en-us/library/ff5...

typedef struct _REPARSE_DATA_BUFFER {
ULONG ReparseTag;
USHORT ReparseDataLength;
USHORT Reserved;
union {
struct {
USHORT SubstituteNameOffset;
USHORT SubstituteNameLength;
.....
Now I've got that ULONG means long and USHORT means integer. But I
have no idea how to handle the union.

2) Then comes the following line.
WCHAR PathBuffer[1];
in the typedef. I haven't a clue how to handle that either.

3) apparently I need to allocate the above REPARSE_DATA_BUFFER
structure before I execute the call to DeviceIoControl

For example at the code found at
http://blog.kalmbach-software.de/2008/02/28/howto-correctly-read-reparse-data...
// Allocate the reparse data structure
DWORD dwBufSize = MAXIMUM_REPARSE_DATA_BUFFER_SIZE;
REPARSE_DATA_BUFFER* rdata;
rdata = (REPARSE_DATA_BUFFER*) malloc(dwBufSize);

I look at the above and haven't a clue how to code that in VB6.

Applemans Win32 API doesn't mention this stuff. And there are no
relevant hits for DeviceIoControl or FSCTL_GET_REPARSE_POINT in this
newsgroup.

Thanks, Tony
25 Answers

Ralph

8/2/2012 1:00:00 PM

0

On Thu, 02 Aug 2012 01:01:07 -0600, Tony Toews
<ttoews@telusplanet.net> wrote:

>Folks
>
>I'm trying to read the actual directory name of a Windows 7 junction
>point.. Classic example is C:\Users\ttoews\Application Data which
>doesn't actually exist. Although it appears to exist in Windows
>Explorer. Instead, for me. it's really
>C:\Users\ttoews\AppData\Roaming
>
>Another example is c:\Documents and Settings which is really C:\Users
>
>So I'm trying to convert various chunks of C++ or other languages code
>to VB6 and am struggling greatly because I really don't have a clue
>how to convert somewhat complex API code from C++ examples to VB6.
>
>The MSDN code is FSCTL_GET_REPARSE_POINT control code as found at
>http://msdn.microsoft.com/en-us/library/windows/desktop/aa364571%28v=vs....
>
>The problems I'm having are
>

OK, not in a position to build and test at the moment, but here are
some hints.

Stuck to just the basics. The details will make themselves clearer as
you get into to playing. Tried to keep it at the 4,000 foot level.


>1) I have to create the following structure inside a structure as a
>Type. And I have no idea how.
>
>REPARSE_DATA_BUFFER structure
>http://msdn.microsoft.com/en-us/library/ff5...
>
>typedef struct _REPARSE_DATA_BUFFER {
> ULONG ReparseTag;
> USHORT ReparseDataLength;
> USHORT Reserved;
> union {
> struct {
> USHORT SubstituteNameOffset;
> USHORT SubstituteNameLength;
>....
>Now I've got that ULONG means long and USHORT means integer. But I
>have no idea how to handle the union.
>

Unions are basically a "compiler-time" tool to reserve space so that
multiple "types" can be placed there. (Variants are defined as
pointers to unions.)

VB doesn't have them, therefoer you will need to create Three separate
UDTs. One for each struct.

So you will have a
SymbolicLinkReparseBuffer_Type of _REPARSE_DATA_BUFFER UDT, a
MountPointReparseBuffer_type of MountPointReparseBuffer, and a
GenericReparseBuffer_TYPE of _REPARSE_DATA_BUFFER

You'll have to work out when you need to use which one.

>2) Then comes the following line.
>WCHAR PathBuffer[1];
>in the typedef. I haven't a clue how to handle that either.
>

This is a way of saying "what follows is a block containing a C string
array that will contain a string of characters", and here is a pointer
to the first character or first address in that block . Note: In "C"
there is no such thing as a "string" (using "string" in the generic
sense here - not to be confused with C++'s string collection). There
is only a contiguous series of chars in a block of memory that is
managed by convention.
[Confused yet? <g>]

So what we have there is a block of memory containing wide chars.

You do this in VB by the following ...

PathBuffer As String * MAXIMUM_REPARSE_DATA_BUFFER_SIZE
(There is a subtle problem here - more below...)

>3) apparently I need to allocate the above REPARSE_DATA_BUFFER
>structure before I execute the call to DeviceIoControl
>
>For example at the code found at
>http://blog.kalmbach-software.de/2008/02/28/howto-correctly-read-reparse-data...
> // Allocate the reparse data structure
> DWORD dwBufSize = MAXIMUM_REPARSE_DATA_BUFFER_SIZE;
> REPARSE_DATA_BUFFER* rdata;
> rdata = (REPARSE_DATA_BUFFER*) malloc(dwBufSize);
>
>I look at the above and haven't a clue how to code that in VB6.
>

You can't. VB doesn't support dynamic UDTs. However, a UDT, after the
smoke clears, is just a block of memory, and basically just the
declaration of one creates that block.

That explains the basics. You now know how to duplicate the "union"
declarations. You now know how to add a block of memory to the end of
the UDT. - Here comes the ugly part and can be expressed in one word -
UNICODE. <g>

At this point I'm not sure how I'd go about handling that, but this
should be enough to get you started. Others should be along shortly
with more direct advice.

-ralph

Ralph

8/2/2012 1:44:00 PM

0

On Thu, 02 Aug 2012 08:00:25 -0500, ralph <nt_consulting64@yahoo.com>
wrote:

Follow-up.

The "size" or data length is used mostly to signal which struct is
being used or returned. One can do this with Len(), but in many cases
I've found the hack of simply determining the magical number and
preserving it as a constant works well. (But of course is platform
specific.)

I ended on a sour note. I forgot you are just 'reading', so actually
might not be issue. VB often performs a bit of magic with 'strings'.
Try the simple way and see what happens before panicking. <g>

Note: You will have to clean up the trailing garbage in the returned
string. C string convention is to stop at the first nul. VB has no
such compulsion.

-ralph

Ralph

8/2/2012 4:04:00 PM

0

On Thu, 02 Aug 2012 08:00:25 -0500, ralph <nt_consulting64@yahoo.com>
wrote:


>
>>1) I have to create the following structure inside a structure as a
>>Type. And I have no idea how.
>>
>>REPARSE_DATA_BUFFER structure
>>http://msdn.microsoft.com/en-us/library/ff5...
>>
>>typedef struct _REPARSE_DATA_BUFFER {
>> ULONG ReparseTag;
>> USHORT ReparseDataLength;
>> USHORT Reserved;
>> union {
>> struct {
>> USHORT SubstituteNameOffset;
>> USHORT SubstituteNameLength;
>>....
>>Now I've got that ULONG means long and USHORT means integer. But I
>>have no idea how to handle the union.
>>
>
>Unions are basically a "compiler-time" tool to reserve space so that
>multiple "types" can be placed there. (Variants are defined as
>pointers to unions.)
>
>VB doesn't have them, therefoer you will need to create Three separate
>UDTs. One for each struct.
>
>So you will have a
>SymbolicLinkReparseBuffer_Type of _REPARSE_DATA_BUFFER UDT, a
>MountPointReparseBuffer_type of MountPointReparseBuffer, and a
>GenericReparseBuffer_TYPE of _REPARSE_DATA_BUFFER
>
>You'll have to work out when you need to use which one.
>

To expand on that...
[Warning! Air Code.]

' SymbolicLinkReparseBuffer version of REPARSE_DATA_BUFFER

Private Type MySymbolic_Reparse_Data_Buffer
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
Flags As Long
PathBuffer As String * 1024 ' just a fake number
' actual is something like 6 x 1024 ???
End Type

Private Type MyMousePoint_Reparse_Data_Buffer
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
PathBuffer As String * 1024
End Type

Private Type MyGeneric_Reparse_Data_Buffer
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
DataBuffer As String * 1024
End Type

Note how the 'variability' of the struct all gets tacked on to the end
of the struct/Type*. It might help to think of the 'struct' or Type
declaration as a template to 'decode' or provide meaning for a block
of memory.

For example, for a SymbolicLink block I know I have to walk off the
'header' - a long and two integers, then four integers and a long to
get to the path. For a generic, I need only strip the header.

-ralph
[*Note: This is not always the case when converting C/C++ unions to
VB. A union is basically a block of memory which can hold different
types. It is sized to the largest datatype it is expected to hold so
in some cases you may have to pad the union. You can do this by simply
inserting a dummy element (Dummy As String * x), but that as they say
is another story and thankfully not applicable in this case. <g>]

ObiWan

8/2/2012 4:51:00 PM

0


> Folks
>
> I'm trying to read the actual directory name of a Windows 7 junction
> point.. Classic example is C:\Users\ttoews\Application Data which
> doesn't actually exist. Although it appears to exist in Windows
> Explorer. Instead, for me. it's really
> C:\Users\ttoews\AppData\Roaming

Tony... please go here

http://micksmix.wordpress.com/2009/11/21/free-and-legal-sysinternals-so...

and fetch the source code for the Junction tool; it's C, ok, but I
think it may help you figuring out how to deal with those critters ;)

HTH

ObiWan

8/2/2012 4:53:00 PM

0


> Tony... please go here
>
> http://micksmix.wordpress.com/2009/11/21/free-and-legal-sysinternals-so...
>
> and fetch the source code for the Junction tool; it's C, ok, but I
> think it may help you figuring out how to deal with those critters ;)

whoops... dead link, sorry; I'll dig my copy of the source (I should
have it around... in some dusty dungeon :D) and send it your way !

unknown

8/2/2012 5:29:00 PM

0

"ObiWan" <alb.20.trashsink@spamgourmet.com> wrote in message
news:20120802185259.000036f8@deathstar.mil...
>
>> Tony... please go here
>>
>> http://micksmix.wordpress.com/2009/11/21/free-and-legal-sysinternals-so...
>>
>> and fetch the source code for the Junction tool; it's C, ok, but I
>> think it may help you figuring out how to deal with those critters ;)
>
> whoops... dead link, sorry; I'll dig my copy of the source (I should
> have it around... in some dusty dungeon :D) and send it your way !

I copied the entire site. The downloadable files including source and
binaries is 21 MB.



Tony Toews

8/2/2012 6:44:00 PM

0

On Thu, 2 Aug 2012 13:29:01 -0400, "Farnsworth" <nospam@nospam.com>
wrote:

>I copied the entire site. The downloadable files including source and
>binaries is 21 MB.

FWIW my email can handle 100 Mb files. <smile> tony at granite dot
ab.ca.

Tony
--
Tony Toews, Microsoft Access MVP
Tony's Main MS Access pages - http://www.granite.ab.ca/ac...
Tony's Microsoft Access Blog - http://msmvps.com/blo...
For a convenient utility to keep your users FEs and other files
updated see http://www.autofeup...

unknown

8/2/2012 7:05:00 PM

0

Besides what others suggested, here is sample code. It compiles, but not
tested:

Option Explicit

Private Const INVALID_HANDLE_VALUE = -1

Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5

Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_SPARSE_FILE = &H200
Private Const FILE_ATTRIBUTE_REPARSE_POINT = &H400
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
Private Const FILE_ATTRIBUTE_ENCRYPTED = &H4000

Private Const FILE_FLAG_WRITE_THROUGH = &H80000000
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FILE_FLAG_NO_BUFFERING = &H20000000
Private Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Private Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Private Const FILE_FLAG_OPEN_REPARSE_POINT = &H200000

Private Declare Function DeviceIoControl Lib "kernel32" ( _
ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any,
_
ByVal nInBufferSize As Long, lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFileW Lib "kernel32" ( _
ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long,
_
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)

Private Const FSCTL_GET_REPARSE_POINT As Long = &H900A8


Private Const IO_REPARSE_TAG_CSV = &H80000009
Private Const IO_REPARSE_TAG_DEDUP = &H80000013
Private Const IO_REPARSE_TAG_DFS = &H8000000A
Private Const IO_REPARSE_TAG_DFSR = &H80000012
Private Const IO_REPARSE_TAG_HSM = &HC0000004
Private Const IO_REPARSE_TAG_HSM2 = &H80000006
Private Const IO_REPARSE_TAG_MOUNT_POINT = &HA0000003
Private Const IO_REPARSE_TAG_NFS = &H80000014
Private Const IO_REPARSE_TAG_SIS = &H80000007
Private Const IO_REPARSE_TAG_SYMLINK = &HA000000C
Private Const IO_REPARSE_TAG_WIM = &H80000008

Private Type REPARSE_DATA_BUFFER
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
End Type

Private Type REPARSE_DATA_BUFFER_SYMPOLIC_LINK
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
Flags As Long
End Type

Private Sub Form_Load()
Debug.Print GetReparsePoint(Environ("HOMEPATH"))
End Sub

Private Function GetReparsePoint(ByRef sFolderName As String) As String
Dim hFile As Long
Dim ret As Long
Dim lpOutBuffer() As Byte
Dim lpOutBufferSize As Long
Dim lpBytesReturned As Long
Dim ReparseDataBuffer1 As REPARSE_DATA_BUFFER
Dim sSubstituteName As String
Dim sPrintName As String

hFile = CreateFileW(ByVal StrPtr(sFolderName), GENERIC_READ, _
FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OPEN_REPARSE_POINT, ByVal 0&)
If hFile = INVALID_HANDLE_VALUE Then
Debug.Print "CreateFileW failed, LastDllError = " & _
Err.LastDllError
Exit Function
End If

' Call DeviceIoControl with small buffer to get the length
ret = DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, ByVal 0&, 0, _
ReparseDataBuffer1, Len(ReparseDataBuffer1), lpBytesReturned, _
ByVal 0&)
If ret = 0 Then
Debug.Print "DeviceIoControl call 1 failed, LastDllError = " & _
Err.LastDllError

' Calculate the buffer size
lpOutBufferSize = Len( _
ReparseDataBuffer1) + ReparseDataBuffer1.SubstituteNameLength +
_
ReparseDataBuffer1.PrintNameLength
If ReparseDataBuffer1.ReparseTag = IO_REPARSE_TAG_SYMLINK Then
lpOutBufferSize = lpOutBufferSize + 4 ' 4 = size of Flags member
End If
On Error Resume Next
ReDim lpOutBuffer(0 To lpOutBufferSize - 1)
If Err.Number <> 0 Then
Debug.Print "ReDim failed, Error " & Err.Number & ": " & _
Err.Description
GoTo Cleanup
End If
On Error GoTo 0

' Call DeviceIoControl again with a large buffer
ret = DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, ByVal 0&, 0, _
lpOutBuffer(0), lpOutBufferSize, lpBytesReturned, ByVal 0&)
If ret = 0 Then
Debug.Print "DeviceIoControl call 2 failed, LastDllError = " _
& Err.LastDllError
GoTo Cleanup
Else
' DeviceIoControl succeeded
sSubstituteName = String( _
ReparseDataBuffer1.SubstituteNameLength, 0)
sPrintName = String(ReparseDataBuffer1.PrintNameLength, 0)
If ReparseDataBuffer1.ReparseTag = IO_REPARSE_TAG_SYMLINK Then
CopyMemory ByVal StrPtr(sSubstituteName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + 4 + _
ReparseDataBuffer1.SubstituteNameOffset), _
ReparseDataBuffer1.SubstituteNameLength
CopyMemory ByVal StrPtr(sPrintName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + 4 + _
ReparseDataBuffer1.PrintNameOffset), _
ReparseDataBuffer1.PrintNameLength
Else
CopyMemory ByVal StrPtr(sSubstituteName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + _
ReparseDataBuffer1.SubstituteNameOffset), _
ReparseDataBuffer1.SubstituteNameLength
CopyMemory ByVal StrPtr(sPrintName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + ReparseDataBuffer1.PrintNameOffset
_
), ReparseDataBuffer1.PrintNameLength
End If
Debug.Print "DeviceIoControl succeeded."
Debug.Print "sSubstituteName = '" & sSubstituteName & "'"
Debug.Print "sPrintName = '" & sPrintName & "'"
GetReparsePoint = sSubstituteName
End If

End If

Cleanup:
CloseHandle hFile
End Function



unknown

8/2/2012 7:31:00 PM

0

"Farnsworth" <nospam@nospam.com> wrote in message
news:jvej0p$si0$1@speranza.aioe.org...
> hFile = CreateFileW(ByVal StrPtr(sFolderName), GENERIC_READ, _
> FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, _
> FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_OPEN_REPARSE_POINT, ByVal 0&)

Looking at "Junction" source code, it seems that I forgot
FILE_FLAG_BACKUP_SEMANTICS and FILE_SHARE_WRITE flags. Here is the correct
line:

hFile = CreateFileW(ByVal StrPtr(sFolderName), GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, _
FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OPEN_REPARSE_POINT, ByVal
0&)


unknown

8/2/2012 7:45:00 PM

0

With the help of "Junction" from sysinternals, I found some symbolic links
in my XP system under one of the folders in C:\Windows. Here is the sample
again, but this time it's tested:

Option Explicit

Private Const MAX_NAME_LENGTH = 1024

Private Const INVALID_HANDLE_VALUE = -1

Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5

Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_READ = &H80000000

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_SPARSE_FILE = &H200
Private Const FILE_ATTRIBUTE_REPARSE_POINT = &H400
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
Private Const FILE_ATTRIBUTE_ENCRYPTED = &H4000

Private Const FILE_FLAG_WRITE_THROUGH = &H80000000
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const FILE_FLAG_NO_BUFFERING = &H20000000
Private Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Private Const FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
Private Const FILE_FLAG_DELETE_ON_CLOSE = &H4000000
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const FILE_FLAG_POSIX_SEMANTICS = &H1000000
Private Const FILE_FLAG_OPEN_REPARSE_POINT = &H200000

Private Declare Function DeviceIoControl Lib "kernel32" ( _
ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any,
_
ByVal nInBufferSize As Long, lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, lpBytesReturned As Long, _
ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFileW Lib "kernel32" ( _
ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long,
_
ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub OutputDebugString Lib "kernel32" Alias _
"OutputDebugStringA" (ByVal lpOutputString As String)

Private Const FSCTL_GET_REPARSE_POINT As Long = &H900A8


Private Const IO_REPARSE_TAG_CSV = &H80000009
Private Const IO_REPARSE_TAG_DEDUP = &H80000013
Private Const IO_REPARSE_TAG_DFS = &H8000000A
Private Const IO_REPARSE_TAG_DFSR = &H80000012
Private Const IO_REPARSE_TAG_HSM = &HC0000004
Private Const IO_REPARSE_TAG_HSM2 = &H80000006
Private Const IO_REPARSE_TAG_MOUNT_POINT = &HA0000003
Private Const IO_REPARSE_TAG_NFS = &H80000014
Private Const IO_REPARSE_TAG_SIS = &H80000007
Private Const IO_REPARSE_TAG_SYMLINK = &HA000000C
Private Const IO_REPARSE_TAG_WIM = &H80000008

Private Type REPARSE_DATA_BUFFER
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
End Type

Private Type REPARSE_DATA_BUFFER_SYMPOLIC_LINK
ReparseTag As Long
ReparseDataLength As Integer
Reserved As Integer
SubstituteNameOffset As Integer
SubstituteNameLength As Integer
PrintNameOffset As Integer
PrintNameLength As Integer
Flags As Long
End Type

Private Sub Form_Load()
DebugPrint App.Title & " started on " & Now
DebugPrint GetReparsePoint( _
"c:\windows\assembly\GAC_32\System.EnterpriseServices\2.0.0.0__b03f5f7f11d50a3a")
End Sub

Private Function GetReparsePoint(ByRef sFolderName As String) As String
Dim hFile As Long
Dim ret As Long
Dim lpOutBuffer() As Byte
Dim lpOutBufferSize As Long
Dim lpBytesReturned As Long
Dim ReparseDataBuffer1 As REPARSE_DATA_BUFFER
Dim sSubstituteName As String
Dim sPrintName As String

hFile = CreateFileW(ByVal StrPtr(sFolderName), GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, _
FILE_FLAG_BACKUP_SEMANTICS Or FILE_FLAG_OPEN_REPARSE_POINT, ByVal
0&)
If hFile = INVALID_HANDLE_VALUE Then
DebugPrint "CreateFileW failed, LastDllError = " & _
Err.LastDllError
Exit Function
End If

' Call DeviceIoControl with small buffer to get the length
ret = DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, ByVal 0&, 0, _
ReparseDataBuffer1, Len(ReparseDataBuffer1), lpBytesReturned, _
ByVal 0&)
If ret = 0 Then
DebugPrint "DeviceIoControl call 1 failed, lpBytesReturned = " & _
lpBytesReturned & ", LastDllError = " & Err.LastDllError

' Calculate the buffer size
lpOutBufferSize = Len( _
ReparseDataBuffer1) + ReparseDataBuffer1.SubstituteNameLength +
_
ReparseDataBuffer1.PrintNameLength + MAX_NAME_LENGTH * 2
If ReparseDataBuffer1.ReparseTag = IO_REPARSE_TAG_SYMLINK Then
lpOutBufferSize = lpOutBufferSize + 4 ' 4 = size of Flags member
End If
On Error Resume Next
ReDim lpOutBuffer(0 To lpOutBufferSize - 1)
If Err.Number <> 0 Then
DebugPrint "ReDim failed, Error " & Err.Number & ": " & _
Err.Description
GoTo Cleanup
End If
On Error GoTo 0
DebugPrint "lpOutBufferSize = " & lpOutBufferSize

' Call DeviceIoControl again with a large buffer
ret = DeviceIoControl(hFile, FSCTL_GET_REPARSE_POINT, ByVal 0&, 0, _
lpOutBuffer(0), lpOutBufferSize, lpBytesReturned, ByVal 0&)
If ret = 0 Then
DebugPrint "DeviceIoControl call 2 failed, LastDllError = " & _
Err.LastDllError
GoTo Cleanup
Else
' DeviceIoControl succeeded
CopyMemory ReparseDataBuffer1, lpOutBuffer(0), _
Len(ReparseDataBuffer1)
sSubstituteName = String( _
ReparseDataBuffer1.SubstituteNameLength, 0)
sPrintName = String(ReparseDataBuffer1.PrintNameLength, 0)
If ReparseDataBuffer1.ReparseTag = IO_REPARSE_TAG_SYMLINK Then
CopyMemory ByVal StrPtr(sSubstituteName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + 4 + _
ReparseDataBuffer1.SubstituteNameOffset), _
ReparseDataBuffer1.SubstituteNameLength
CopyMemory ByVal StrPtr(sPrintName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + 4 + _
ReparseDataBuffer1.PrintNameOffset), _
ReparseDataBuffer1.PrintNameLength
Else
CopyMemory ByVal StrPtr(sSubstituteName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + _
ReparseDataBuffer1.SubstituteNameOffset), _
ReparseDataBuffer1.SubstituteNameLength
CopyMemory ByVal StrPtr(sPrintName), _
lpOutBuffer(Len( _
ReparseDataBuffer1) + ReparseDataBuffer1.PrintNameOffset
_
), ReparseDataBuffer1.PrintNameLength
End If
DebugPrint "DeviceIoControl succeeded."
DebugPrint "sSubstituteName = '" & sSubstituteName & "'"
DebugPrint "sPrintName = '" & sPrintName & "'"
GetReparsePoint = sSubstituteName
End If

End If

Cleanup:
CloseHandle hFile
End Function

Private Sub DebugPrint(ByRef s As String)
Debug.Print s
OutputDebugString s
End Sub