VB.NET创建快捷方式和读取快捷方式的类

Imports IWshRuntimeLibrary '引用:Windows Script Host Object Model
Public Class LnkFileClass
    Public Sub New()
    End Sub
    Public Function GetLnkFileInfo(ByVal LnkFilePath As String) As String
        Dim iPos As Integer
        iPos = LnkFilePath.LastIndexOf(".")
        Dim tmp As String
        tmp = LnkFilePath.Substring(iPos + 1)
        If tmp.ToLower <> "lnk" Then
            Return ""
        End If
        Try
            Dim f As New IWshShell_Class
            Dim Lnk As IWshShortcut
            Lnk = CType(f.CreateShortcut(LnkFilePath), IWshShortcut)
            f = Nothing
            Return Lnk.TargetPath
        Catch ex As Exception
            Return ""
        End Try
    End Function
    Public Function CreatLnkFile(ByVal lnkFile As String, ByVal ExeFilePath As String, ByVal iDescription As String) As Boolean
        Try
            If Not IO.Directory.Exists(ExeFilePath) Then
                Dim retVal As DialogResult = MsgBox(ExeFilePath & " 目标文件不存在,你还要创造它吗?", MsgBoxStyle.Question Or MsgBoxStyle.YesNo)
                If retVal = Windows.Forms.DialogResult.Yes Then
                    IO.Directory.CreateDirectory(ExeFilePath)
                Else
                    Return False
                End If
            End If
            Dim iconNumber As Integer = 0
            Dim CreatDir As String = System.Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
            Dim wShell As New IWshShell_Class
            Dim shortCut As IWshRuntimeLibrary.IWshShortcut
            shortCut = CType(wShell.CreateShortcut(CreatDir & "/" & lnkFile & ".lnk"), IWshShortcut)
            shortCut.TargetPath = ExeFilePath
            shortCut.WindowStyle = 1
            shortCut.Description = iDescription
            shortCut.WorkingDirectory = ""
            shortCut.IconLocation = ExeFilePath & ", " & iconNumber
            shortCut.Save()
            wShell = Nothing
            Return True
        Catch ex As System.Exception
            Return False
        End Try
    End Function
End Class

通过字节搜索获得路径也不慢么:

Public Class LnkFileExePath
    Private m_Stream As FileStream
    Private m_Reader As BinaryReader
    Public Sub New()
    End Sub
    Public Function GetLnkFileInfo(ByVal LnkFile As String) As String
        GetLnkFileInfo = ""
        Dim tmp As String = ""
        Dim i As Integer = 0
        Dim iFilePath As String = ""
        Dim iPos As Integer = 0
        Dim n As Integer = 0
        Try
            m_Stream = New FileStream(LnkFile, FileMode.Open, FileAccess.Read)
            m_Reader = New BinaryReader(m_Stream)
        Catch ex As Exception
            Return ""
        End Try
        Try
            Dim k As Integer = m_Reader.BaseStream.Length
            For i = 260 To k
                m_Reader.BaseStream.Seek(i, SeekOrigin.Begin)
                iFilePath = Nextchars(1024, m_Reader)
                If iFilePath.Substring(1, 2) = ":/" Then
                    iFilePath = iFilePath.Substring(0, InStr(iFilePath, Chr(0)) - 1)
                    If iFilePath.Length > 5 Then
                        If iFilePath.Substring(iFilePath.Length - 4) = ".exe" Then
                            m_Reader.Close()
                            m_Stream.Close()
                            Debug.WriteLine(i & " " & iFilePath)
                            Return iFilePath
                        End If
                    End If
                End If
            Next
        Catch ex As Exception
            m_Reader.Close()
            m_Stream.Close()
            Return ""
        End Try
        m_Reader.Close()
        m_Stream.Close()
        Return ""
    End Function
    Private Function Nextchars(ByVal Num As Integer, ByVal reader As BinaryReader) As String
        Dim ch() As Byte
        ReDim ch(Num - 1)
        reader.Read(ch, 0, ch.Length)
        Return Encoding.Default.GetString(ch, 0, ch.Length)
    End Function
End Class