without IShellLink

Code:
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type LNKHEAD
    dwID As Long
    dwGUID(3) As Long
    dwFlags As Long
    dwFileAttributes As Long
    dwCreationTime As FILETIME
    dwModificationTime As FILETIME
    dwLastaccessTime As FILETIME
    dwFileLen As Long
    dwIconNum As Long
    dwWinStyle As Long
    dwHotkey As Long
    dwReserved1 As Long
    dwReserved2 As Long
End Type

Private Type FILELOCATIONINFO
    dwSize As Long
    dwFirstOffset As Long
    dwFlags As Long
    dwOffsetOfVolume As Long
    dwOffsetOfBasePath As Long
    dwOffsetOfNetworkVolume As Long
    dwOffsetOfRemainingPath As Long
End Type

Private Type LOCALVOLUMETAB
    dwSize As Long
    dwTypeOfVolume As Long
    dwVolumeSerialNumber As Long
    dwOffsetOfVolumeName As Long
    strVolumeName As Byte
End Type

Private Type NETWORKVOLUMETAB
    dwSize As Long
    dwUnknown1 As Long
    dwOffsetOfNetShareName As Long
    dwUnknown2 As Long
    dwUnknown3 As Long
    strNetShareName As Byte
End Type

Private Const LNK_HASIDLIST = &H1
Private Const LNK_FILEDIR = &H2
Private Const LNK_HASDES = &H4
Private Const LNK_HASPATH = &H8
Private Const LNK_HASWORKDIR = &H10
Private Const LNK_HASCMD = &H20

Private Const LNK_LOCALVOLUME = &H1
Private Const LNK_NETSHARE = &H2

Public Function GetLinkPath(ByVal strShortCut As String) As String
    On Error GoTo Err1
    Dim objLinked As LNKHEAD
    Dim intNo As Integer, intTmp As Integer
    Dim objInfo As FILELOCATIONINFO
    Dim intSeek As Integer
    Dim bytBuffer() As Byte
    intNo = FreeFile
    Open strShortCut For Binary As #intNo
    Get #intNo, , objLinked
    intSeek = Len(objLinked)
    If objLinked.dwFlags And LNK_HASIDLIST Then
    Get #intNo, , intTmp
    Else
    Close #intNo
    Exit Function
    End If
    intSeek = Seek(intNo)
    intSeek = intSeek + intTmp
    Seek #intNo, intSeek
    Get #intNo, , objInfo
    Seek #intNo, objInfo.dwOffsetOfBasePath + intSeek
    If objInfo.dwFlags And LNK_NETSHARE Then
    intSeek = objInfo.dwOffsetOfNetworkVolume - objInfo.dwOffsetOfBasePath
    Else
    intSeek = objInfo.dwOffsetOfRemainingPath - objInfo.dwOffsetOfBasePath
    End If
    ReDim bytBuffer(intSeek - 1)
    Get #intNo, , bytBuffer
    Close #intNo
    GetLinkPath = StrConv(bytBuffer, vbUnicode)
    Exit Function
Err1:    Debug.Print Err.Description
End Function