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
