天天看點

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