- '用二进制数据读取lnk文件的备注
- Option Explicit
- Dim oFSO, oWshShell, s, i
-
- Set oFSO = CreateObject("Scripting.FileSystemObject")
- Set oWshShell = CreateObject("WScript.Shell")
- s = oWshShell.ExpandEnvironmentStrings("%windir%\System32\CScript.exe")
- If oFSO.FileExists(s) And LCase(WScript.FullName) <> LCase(s) Then
- s = s & " /nologo """ & WScript.ScriptFullName & """ "
- For Each i In WScript.Arguments
- If InStr(i, " ") > 0 Then i = """" & i & """"
- s = s & i & " "
- Next
- oWshShell.Run "cmd.exe /k " & Left(s, Len(s) - 1)
- WScript.Quit()
- End If
-
- s = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Windows Media Player.lnk"
- wsh.Echo StringData(s)
-
- Function StringData(ByVal lnkFilePath)
- Dim oSteam, arrByte, m, s, p
-
- p = Right(LinkInfo(lnkFilePath), 6)
- s = "StringData : " & p & vbCrLf
- Set oSteam = CreateObject("ADODB.Stream")
- oSteam.Type = 1 'adTypeBinary
- oSteam.Mode = 3 'adModeReadWrite
- oSteam.Open()
- oSteam.LoadFromFile lnkFilePath
- oSteam.Position = CLng(p)
-
- If InStr(LinkFlags(lnkFilePath, 1), "HasName") <> 0 Then
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- s = s & " NAME_STRING : " & p & vbCrLf & _
- " CountCharacters : " & p & " = " & m & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- arrByte = oSteam.Read(CLng(m) * 2)
- m = bin2Hex(arrByte, 1, LenB(arrByte))
- s = s & " String : " & p & " = " & unicode2chr(m) & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- Else
- s = s & " NAME_STRING :" & vbCrLf
- End If
-
- If InStr(LinkFlags(lnkFilePath, 1), "HasRelativePath") <> 0 Then
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- s = s & " RELATIVE_PATH : " & p & vbCrLf & _
- " CountCharacters : " & p & " = " & m & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- arrByte = oSteam.Read(CLng(m) * 2)
- m = bin2Hex(arrByte, 1, LenB(arrByte))
- s = s & " String : " & p & " = " & unicode2chr(m) & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- Else
- s = s & " RELATIVE_PATH :" & vbCrLf
- End If
-
- If InStr(LinkFlags(lnkFilePath, 1), "HasWorkingDir") <> 0 Then
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- s = s & " WORKING_DIR : " & p & vbCrLf & _
- " CountCharacters : " & p & " = " & m & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- arrByte = oSteam.Read(CLng(m) * 2)
- m = bin2Hex(arrByte, 1, LenB(arrByte))
- s = s & " String : " & p & " = " & unicode2chr(m) & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- Else
- s = s & " WORKING_DIR :" & vbCrLf
- End If
-
- If InStr(LinkFlags(lnkFilePath, 1), "HasArguments") <> 0 Then
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- s = s & " COMMAND_LINE_ARGUMENTS : " & p & vbCrLf & _
- " CountCharacters : " & p & " = " & m & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- arrByte = oSteam.Read(CLng(m) * 2)
- m = bin2Hex(arrByte, 1, LenB(arrByte))
- s = s & " String : " & p & " = " & unicode2chr(m) & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- Else
- s = s & " COMMAND_LINE_ARGUMENTS :" & vbCrLf
- End If
-
- If InStr(LinkFlags(lnkFilePath, 1), "HasIconLocation") <> 0 Then
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- s = s & " ICON_LOCATION : " & p & vbCrLf & _
- " CountCharacters : " & p & " = " & m & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- arrByte = oSteam.Read(CLng(m) * 2)
- m = bin2Hex(arrByte, 1, LenB(arrByte))
- s = s & " String : " & p & " = " & unicode2chr(m) & vbCrLf
- p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
- Else
- s = s & " ICON_LOCATION :" & vbCrLf
- End If
-
- StringData = s & ": " & p
- oSteam.Close()
- End Function
-
- Function unicode2chr(ByVal m)
- Dim s, i, n
- If Left(m, 2) = "&H" Then m = Right(m, Len(m) - 2)
- s = ""
- n = "&H"
- For i = 1 To Len(m) Step 4
- n = n & Mid(m, i + 2, 1) & Mid(m, i + 3, 1) & Mid(m, i, 1) & Mid(m, i + 1, 1)
- If CLng(n) <> 0 Then s = s & ChrW(CLng(n))
- n = "&H"
- Next
- unicode2chr = s
- End Function
-
- Function gbk2chr(ByVal m)
- Dim s, i, n
- If Left(m, 2) = "&H" Then m = Right(m, Len(m) - 2)
- s = ""
- n = "&H"
- For i = 1 To Len(m) Step 2
- n = n & Mid(m, i, 1) & Mid(m, i + 1, 1)
- If CLng(n) > CLng(&H7F) Then
- i = i + 2
- n = n & Mid(m, i, 1) & Mid(m, i + 1, 1)
- End If
- If CLng(n) <> 0 Then s = s & Chr(CLng(n))
- n = "&H"
- Next
- gbk2chr = s
- End Function
-
- Function LinkInfo(ByVal lnkFilePath)
- Dim oSteam, arrByte, a(17), i, m, s, p
- a(0) = Right(LinkTargetIDList(lnkFilePath), 6)
- If InStr(LinkFlags(lnkFilePath, 1), "HasLinkInfo") = 0 Then
- LinkInfo = "LinkInfo" & vbCrLf & ": " & a(0)
- Exit Function
- End If
- Set oSteam = CreateObject("ADODB.Stream")
- oSteam.Type = 1 'adTypeBinary
- oSteam.Mode = 3 'adModeReadWrite
- oSteam.Open()
- oSteam.LoadFromFile lnkFilePath
- p = a(0)
- oSteam.Position = CLng(p)
- arrByte = oSteam.Read(28)
- m = bin2Hex(arrByte, 4, 1)
- LinkInfo = ": &H" & Right("000" & Hex(CLng(a(0)) + CLng(m)), 4)
- oSteam.Close()
- End Function
-
- Function bin2Hex(ByRef arrByte, ByVal m, ByVal n)
- Dim k, i, s
- k = 1
- If n < m Then k = -1
- s = "&H"
- For i = m To n Step k
- s = s & Right("0" & Hex(AscB(MidB(arrByte, i, 1))), 2)
- Next
- bin2Hex = s
- End Function
-
- Function LinkTargetIDList(ByVal lnkFilePath)
- Dim oSteam, arrByte, m, n, s
- If InStr(LinkFlags(lnkFilePath, 1), "HasLinkTargetIDList") = 0 Then
- LinkTargetIDList = "LinkTargetIDList" & vbCrLf & ": &H004C"
- Exit Function
- End If
- Set oSteam = CreateObject("ADODB.Stream")
- oSteam.Type = 1 'adTypeBinary
- oSteam.Mode = 3 'adModeReadWrite
- oSteam.Open()
- oSteam.LoadFromFile lnkFilePath
- oSteam.Position = &H004C
- arrByte = oSteam.Read(2)
- m = bin2Hex(arrByte, 2, 1)
- LinkTargetIDList = ": &H" & Right("000" & Hex(&H004C + 2 + CLng(m)), 4)
- oSteam.Close()
- End Function
-
- Function LinkFlags(ByVal lnkFilePath, ByVal x)
- Dim oSteam, arrByte, i, m
- Set oSteam = CreateObject("ADODB.Stream")
- oSteam.Type = 1 'adTypeBinary
- oSteam.Mode = 3 'adModeReadWrite
- oSteam.Open()
- oSteam.LoadFromFile lnkFilePath
- oSteam.Position = &H0014
- arrByte = oSteam.Read(4)
- oSteam.Close()
- LinkFlags = bin2Hex(arrByte, 1, 4)
- If x = 0 Then Exit Function
- m = CLng(LinkFlags)
- i = LinkFlags & vbCrLf
- If (m And &H01000000) <> 0 Then i = i & " HasLinkTargetIDList" & vbCrLf
- If (m And &H02000000) <> 0 Then i = i & " HasLinkInfo" & vbCrLf
- If (m And &H04000000) <> 0 Then i = i & " HasName" & vbCrLf
- If (m And &H08000000) <> 0 Then i = i & " HasRelativePath" & vbCrLf
- If (m And &H10000000) <> 0 Then i = i & " HasWorkingDir" & vbCrLf
- If (m And &H20000000) <> 0 Then i = i & " HasArguments" & vbCrLf
- If (m And &H40000000) <> 0 Then i = i & " HasIconLocation" & vbCrLf
- If (m And &H80000000) <> 0 Then i = i & " IsUnicode" & vbCrLf
- If (m And &H00010000) <> 0 Then i = i & " ForceNoLinkInfo" & vbCrLf
- If (m And &H00020000) <> 0 Then i = i & " HasExpString" & vbCrLf
- If (m And &H00040000) <> 0 Then i = i & " RunInSeparateProcess" & vbCrLf
- If (m And &H00100000) <> 0 Then i = i & " HasDarwinID" & vbCrLf
- If (m And &H00200000) <> 0 Then i = i & " RunAsUser" & vbCrLf
- If (m And &H00400000) <> 0 Then i = i & " HasExpIcon" & vbCrLf
- If (m And &H00800000) <> 0 Then i = i & " NoPidlAlias" & vbCrLf
- If (m And &H00000200) <> 0 Then i = i & " RunWithShimLayer" & vbCrLf
- If (m And &H00000400) <> 0 Then i = i & " ForceNoLinkTrack" & vbCrLf
- If (m And &H00000800) <> 0 Then i = i & " EnableTargetMetadata" & vbCrLf
- If (m And &H00001000) <> 0 Then i = i & " DisableLinkPathTracking" & vbCrLf
- If (m And &H00002000) <> 0 Then i = i & " DisableKnownFolderTracking" & vbCrLf
- If (m And &H00004000) <> 0 Then i = i & " DisableKnownFolderAlias" & vbCrLf
- If (m And &H00008000&) <> 0 Then i = i & " AllowLinkToLink" & vbCrLf
- If (m And &H00000001) <> 0 Then i = i & " UnaliasOnSave" & vbCrLf
- If (m And &H00000002) <> 0 Then i = i & " PreferEnvironmentPath" & vbCrLf
- If (m And &H00000004) <> 0 Then i = i & " KeepLocalIDListForUNCTarget" & vbCrLf
- If i <> "" Then i = Left(i, Len(i) - 2)
- LinkFlags = i
- End Function
复制代码
|