VBa,VB6,VBS获取快捷方式对应的目标路径

B编程：VB获取快捷方式对应的目标路径。

比如，我们想获取桌面上腾讯QQ快捷方式对应的路径，也就是想知道QQ运行程序的安装位置。

我们先做一个函数，专门用于取得一个程序的快捷方式对应的路径名。函数代码如下：

Function GetTargetPath(ByVal LinkName As String) '得到快捷方式的程序的路径
On Local Error Resume Next
Dim Obj As Object
Set Obj = CreateObject(“Wscript.Shell”)
Dim ShortCut As Object
Set ShortCut = Obj.CreateShortcut(LinkName)
GetTargetPath = ShortCut.TargetPath
End Function

下面我们在窗体的load事件中取得QQ的安装路径：

Private Sub Form_Load()
MsgBox GetTargetPath(“C:\Users\Administrator\Desktop\qq.lnk”) '这个是快捷方式所在的路径
End Sub

 本文介绍了一种通过VB脚本解析Windows快捷方式(.lnk)文件的方法，详细展示了如何读取并提取.lnk文件中的目标路径信息。此过程涉及直接操作文件内部结构，使用了如GetMem4和MoveMemory等底层API函数。

Function QueryShortcutFilePath$(ByVal lnkFile$)
'codeid=1235 取快捷方式真实路径2
    Dim pFlag&, pFileInfo&, pFilePath&, pSHHeadLength%, strFilePath$, lpBuffer() As Byte
    Dim file1 As Integer
    file1 = FreeFile
    'MsgBox Dir(lnkFile$)
    'If Dir(lnkFile$) = "" Then Exit Function
    On Error GoTo err1
    Open lnkFile For Binary Access Read As #file1
    If LOF(file1) = 0 Then Exit Function
        ReDim lpBuffer(LOF(file1) - 1)
        Get #file1, , lpBuffer
        Close #file1: file1 = 0
        GetMem4 VarPtr(lpBuffer(0)), pFlag
        If pFlag = &H4C Then
            GetMem2 VarPtr(lpBuffer(76)), pSHHeadLength
            pFileInfo = &H4C + pSHHeadLength + 2
            If lpBuffer(pFileInfo + 8) = 1 Then '//local file
                If lpBuffer(pFileInfo + 40) = 16 Then  '//test ok
                pFilePath = pFileInfo + 44
                pFilePath = pFilePath + lstrlenA(VarPtr(lpBuffer(pFilePath))) + 1 '// jump volume label
                If lstrlenA(VarPtr(lpBuffer(pFilePath))) > 0 Then
                strFilePath = Space$(260)
                MoveMemory lstrlenA(VarPtr(lpBuffer(pFilePath))) + 1, StrPtr(strFilePath), VarPtr(lpBuffer(pFilePath))
                strFilePath = LeftB$(strFilePath, lstrlenA(StrPtr(strFilePath)))
                QueryShortcutFilePath = StrConv(strFilePath, vbUnicode)
                End If
            End If
        End If
    End If
    Exit Function
err1:
If file1 <> 0 Then Close file1
End Function