Board logo

标题: [技术讨论] VBS个别lnk文件不能读取备注的研究 [打印本页]

作者: czjt1234    时间: 2024-3-27 10:07     标题: VBS个别lnk文件不能读取备注的研究

开始菜单中的 Windows Media Player 的快捷方式
win7 C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Windows Media Player.lnk
win10 C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Accessories\Windows Media Player.lnk
win11 C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Accessories\Windows Media Player Legacy.lnk

在使用 WScript.Shell 和 Shell.Application 对象读取其备注时
win7正常,但win10和win11会报错
  1. '读取 Windows Media Player 快捷方式的备注,win10
  2. Set oWshShell = CreateObject("WScript.Shell")
  3. s = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Accessories\Windows Media Player.lnk"
  4. Set oWshShortcut = oWshShell.CreateShortcut(s)
  5. MsgBox oWshShortcut.Description
复制代码
  1. '读取 Windows Media Player 快捷方式的备注,win10
  2. Set oShell = CreateObject("Shell.Application")
  3. s = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Accessories\Windows Media Player.lnk"
  4. Set oShellLinkObject = oShell.NameSpace(17).ParseName(s).GetLink
  5. MsgBox oShellLinkObject.Description
复制代码
打开该lnk文件的属性,可以看到win10和win11环境下,备注为空
但是一个备注为空的lnk文件,读取备注应该是空字符串""

根据微软的lnk文件的二进制说明
https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-shllink/16cb4ca1-9339-4d0c-a68d-bf1d6cc0f943
读取 Windows Media Playerr.lnk 快捷方式的备注
结果为 @%systemroot%\syswow64\unregmp2.exe,-155

测试,把其它快捷方式的备注改为 @%systemroot%\syswow64\unregmp2.exe,-155
结果也是属性无法显示备注,vbs无法读取备注

测试,把快捷方式的备注改为 @%systemroot%\system32\unregmp2.exe,-155
结果是属性可以正常显示备注,vbs可以正常读取备注

备份 syswow64\unregmp2.exe 和 system32\unregmp2.exe 文件
再把这两个文件互换,结果还是
@%systemroot%\system32\unregmp2.exe,-155 正常
@%systemroot%\syswow64\unregmp2.exe,-155 报错

说明与文件无关,而是win10和win11锁定了syswow64
锁定快捷方式的备注不能读取syswow64里的文件

测试,用syswow64\WScript.exe在32环境下运行上述的2个vbs
结果均能正常显示

此时再查看属性,发现可以正常显示备注
包括备份到其它盘的 Windows Media Player.lnk 也能正常显示

说明此时已经解锁了syswow64
快捷方式的备注可以读取syswow64里的文件了

再用二进制读取解锁后的 Windows Media Player.lnk
结果没变 @%systemroot%\syswow64\unregmp2.exe,-155

win10和win11虚拟机恢复镜像后,可以复现上述操作

猜测,这是win10和win11的一个bug
毕竟微软和波音一样,裁减了99%的测试员
作者: czjt1234    时间: 2024-3-27 10:07

  1. '用二进制数据读取lnk文件的备注
  2. Option Explicit
  3. Dim oFSO, oWshShell, s, i
  4. Set oFSO = CreateObject("Scripting.FileSystemObject")
  5. Set oWshShell = CreateObject("WScript.Shell")
  6. s = oWshShell.ExpandEnvironmentStrings("%windir%\System32\CScript.exe")
  7. If oFSO.FileExists(s) And LCase(WScript.FullName) <> LCase(s) Then
  8.     s = s & " /nologo """ & WScript.ScriptFullName & """ "
  9.     For Each i In WScript.Arguments
  10.         If InStr(i, " ") > 0 Then i = """" & i & """"
  11.         s = s & i & " "
  12.     Next
  13.     oWshShell.Run "cmd.exe /k " & Left(s, Len(s) - 1)
  14.     WScript.Quit()
  15. End If
  16. s = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Windows Media Player.lnk"
  17. wsh.Echo StringData(s)
  18. Function StringData(ByVal lnkFilePath)
  19.     Dim oSteam, arrByte, m, s, p
  20.     p = Right(LinkInfo(lnkFilePath), 6)
  21.     s = "StringData               : " & p & vbCrLf
  22.     Set oSteam = CreateObject("ADODB.Stream")
  23.     oSteam.Type = 1    'adTypeBinary
  24.     oSteam.Mode = 3    'adModeReadWrite
  25.     oSteam.Open()
  26.     oSteam.LoadFromFile lnkFilePath
  27.     oSteam.Position = CLng(p)
  28.     If InStr(LinkFlags(lnkFilePath, 1), "HasName") <> 0 Then
  29.         arrByte = oSteam.Read(2)
  30.         m = bin2Hex(arrByte, 2, 1)
  31.         s = s & "  NAME_STRING            : " & p & vbCrLf & _
  32.                 "    CountCharacters      : " & p & " = " & m & vbCrLf
  33.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  34.         arrByte = oSteam.Read(CLng(m) * 2)
  35.         m = bin2Hex(arrByte, 1, LenB(arrByte))
  36.         s = s & "    String               : " & p & " = " & unicode2chr(m) & vbCrLf
  37.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  38.     Else
  39.         s = s & "  NAME_STRING            :" & vbCrLf
  40.     End If
  41.     If InStr(LinkFlags(lnkFilePath, 1), "HasRelativePath") <> 0 Then
  42.         arrByte = oSteam.Read(2)
  43.         m = bin2Hex(arrByte, 2, 1)
  44.         s = s & "  RELATIVE_PATH          : " & p & vbCrLf & _
  45.                 "    CountCharacters      : " & p & " = " & m & vbCrLf
  46.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  47.         arrByte = oSteam.Read(CLng(m) * 2)
  48.         m = bin2Hex(arrByte, 1, LenB(arrByte))
  49.         s = s & "    String               : " & p & " = " & unicode2chr(m) & vbCrLf
  50.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  51.     Else
  52.         s = s & "  RELATIVE_PATH          :" & vbCrLf
  53.     End If
  54.     If InStr(LinkFlags(lnkFilePath, 1), "HasWorkingDir") <> 0 Then
  55.         arrByte = oSteam.Read(2)
  56.         m = bin2Hex(arrByte, 2, 1)
  57.         s = s & "  WORKING_DIR            : " & p & vbCrLf & _
  58.                 "    CountCharacters      : " & p & " = " & m & vbCrLf
  59.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  60.         arrByte = oSteam.Read(CLng(m) * 2)
  61.         m = bin2Hex(arrByte, 1, LenB(arrByte))
  62.         s = s & "    String               : " & p & " = " & unicode2chr(m) & vbCrLf
  63.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  64.     Else
  65.         s = s & "  WORKING_DIR            :" & vbCrLf
  66.     End If
  67.     If InStr(LinkFlags(lnkFilePath, 1), "HasArguments") <> 0 Then
  68.         arrByte = oSteam.Read(2)
  69.         m = bin2Hex(arrByte, 2, 1)
  70.         s = s & "  COMMAND_LINE_ARGUMENTS : " & p & vbCrLf & _
  71.                 "    CountCharacters      : " & p & " = " & m & vbCrLf
  72.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  73.         arrByte = oSteam.Read(CLng(m) * 2)
  74.         m = bin2Hex(arrByte, 1, LenB(arrByte))
  75.         s = s & "    String               : " & p & " = " & unicode2chr(m) & vbCrLf
  76.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  77.     Else
  78.         s = s & "  COMMAND_LINE_ARGUMENTS :" & vbCrLf
  79.     End If
  80.     If InStr(LinkFlags(lnkFilePath, 1), "HasIconLocation") <> 0 Then
  81.         arrByte = oSteam.Read(2)
  82.         m = bin2Hex(arrByte, 2, 1)
  83.         s = s & "  ICON_LOCATION          : " & p & vbCrLf & _
  84.                 "    CountCharacters      : " & p & " = " & m & vbCrLf
  85.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  86.         arrByte = oSteam.Read(CLng(m) * 2)
  87.         m = bin2Hex(arrByte, 1, LenB(arrByte))
  88.         s = s & "    String               : " & p & " = " & unicode2chr(m) & vbCrLf
  89.         p = "&H" & Right("000" & Hex(CLng(oSteam.Position)), 4)
  90.     Else
  91.         s = s & "  ICON_LOCATION          :" & vbCrLf
  92.     End If
  93.     StringData = s & ": " & p
  94.     oSteam.Close()
  95. End Function
  96. Function unicode2chr(ByVal m)
  97.     Dim s, i, n
  98.     If Left(m, 2) = "&H" Then m = Right(m, Len(m) - 2)
  99.     s = ""
  100.     n = "&H"
  101.     For i = 1 To Len(m) Step 4
  102.         n = n & Mid(m, i + 2, 1) & Mid(m, i + 3, 1) & Mid(m, i, 1) & Mid(m, i + 1, 1)
  103.         If CLng(n) <> 0 Then s = s & ChrW(CLng(n))
  104.         n = "&H"
  105.     Next
  106.     unicode2chr = s
  107. End Function
  108. Function gbk2chr(ByVal m)
  109.     Dim s, i, n
  110.     If Left(m, 2) = "&H" Then m = Right(m, Len(m) - 2)
  111.     s = ""
  112.     n = "&H"
  113.     For i = 1 To Len(m) Step 2
  114.         n = n & Mid(m, i, 1) & Mid(m, i + 1, 1)
  115.         If CLng(n) > CLng(&H7F) Then
  116.             i = i + 2
  117.             n = n & Mid(m, i, 1) & Mid(m, i + 1, 1)
  118.         End If
  119.         If CLng(n) <> 0 Then s = s & Chr(CLng(n))
  120.         n = "&H"
  121.     Next
  122.     gbk2chr = s
  123. End Function
  124. Function LinkInfo(ByVal lnkFilePath)
  125.     Dim oSteam, arrByte, a(17), i, m, s, p
  126.     a(0) = Right(LinkTargetIDList(lnkFilePath), 6)
  127.     If InStr(LinkFlags(lnkFilePath, 1), "HasLinkInfo") = 0 Then
  128.         LinkInfo = "LinkInfo" & vbCrLf & ": " & a(0)
  129.         Exit Function
  130.     End If
  131.     Set oSteam = CreateObject("ADODB.Stream")
  132.     oSteam.Type = 1    'adTypeBinary
  133.     oSteam.Mode = 3    'adModeReadWrite
  134.     oSteam.Open()
  135.     oSteam.LoadFromFile lnkFilePath
  136.     p = a(0)
  137.     oSteam.Position = CLng(p)
  138.     arrByte = oSteam.Read(28)
  139.     m = bin2Hex(arrByte, 4, 1)
  140.     LinkInfo = ": &H" & Right("000" & Hex(CLng(a(0)) + CLng(m)), 4)
  141.     oSteam.Close()
  142. End Function
  143. Function bin2Hex(ByRef arrByte, ByVal m, ByVal n)
  144.     Dim k, i, s
  145.     k = 1
  146.     If n < m Then k = -1
  147.     s = "&H"
  148.     For i = m To n Step k
  149.         s = s & Right("0" & Hex(AscB(MidB(arrByte, i, 1))), 2)
  150.     Next
  151.     bin2Hex = s
  152. End Function
  153. Function LinkTargetIDList(ByVal lnkFilePath)
  154.     Dim oSteam, arrByte, m, n, s
  155.     If InStr(LinkFlags(lnkFilePath, 1), "HasLinkTargetIDList") = 0 Then
  156.         LinkTargetIDList = "LinkTargetIDList" & vbCrLf & ": &H004C"
  157.         Exit Function
  158.     End If
  159.     Set oSteam = CreateObject("ADODB.Stream")
  160.     oSteam.Type = 1    'adTypeBinary
  161.     oSteam.Mode = 3    'adModeReadWrite
  162.     oSteam.Open()
  163.     oSteam.LoadFromFile lnkFilePath
  164.     oSteam.Position = &H004C
  165.     arrByte = oSteam.Read(2)
  166.     m = bin2Hex(arrByte, 2, 1)
  167.     LinkTargetIDList = ": &H" & Right("000" & Hex(&H004C + 2 + CLng(m)), 4)
  168.     oSteam.Close()
  169. End Function
  170. Function LinkFlags(ByVal lnkFilePath, ByVal x)
  171.     Dim oSteam, arrByte, i, m
  172.     Set oSteam = CreateObject("ADODB.Stream")
  173.     oSteam.Type = 1    'adTypeBinary
  174.     oSteam.Mode = 3    'adModeReadWrite
  175.     oSteam.Open()
  176.     oSteam.LoadFromFile lnkFilePath
  177.     oSteam.Position = &H0014
  178.     arrByte = oSteam.Read(4)
  179.     oSteam.Close()
  180.     LinkFlags = bin2Hex(arrByte, 1, 4)
  181.     If x = 0 Then Exit Function
  182.     m = CLng(LinkFlags)
  183.     i = LinkFlags & vbCrLf
  184.     If (m And &H01000000)  <> 0 Then i = i & "  HasLinkTargetIDList"         & vbCrLf
  185.     If (m And &H02000000)  <> 0 Then i = i & "  HasLinkInfo"                 & vbCrLf
  186.     If (m And &H04000000)  <> 0 Then i = i & "  HasName"                     & vbCrLf
  187.     If (m And &H08000000)  <> 0 Then i = i & "  HasRelativePath"             & vbCrLf
  188.     If (m And &H10000000)  <> 0 Then i = i & "  HasWorkingDir"               & vbCrLf
  189.     If (m And &H20000000)  <> 0 Then i = i & "  HasArguments"                & vbCrLf
  190.     If (m And &H40000000)  <> 0 Then i = i & "  HasIconLocation"             & vbCrLf
  191.     If (m And &H80000000)  <> 0 Then i = i & "  IsUnicode"                   & vbCrLf
  192.     If (m And &H00010000)  <> 0 Then i = i & "  ForceNoLinkInfo"             & vbCrLf
  193.     If (m And &H00020000)  <> 0 Then i = i & "  HasExpString"                & vbCrLf
  194.     If (m And &H00040000)  <> 0 Then i = i & "  RunInSeparateProcess"        & vbCrLf
  195.     If (m And &H00100000)  <> 0 Then i = i & "  HasDarwinID"                 & vbCrLf
  196.     If (m And &H00200000)  <> 0 Then i = i & "  RunAsUser"                   & vbCrLf
  197.     If (m And &H00400000)  <> 0 Then i = i & "  HasExpIcon"                  & vbCrLf
  198.     If (m And &H00800000)  <> 0 Then i = i & "  NoPidlAlias"                 & vbCrLf
  199.     If (m And &H00000200)  <> 0 Then i = i & "  RunWithShimLayer"            & vbCrLf
  200.     If (m And &H00000400)  <> 0 Then i = i & "  ForceNoLinkTrack"            & vbCrLf
  201.     If (m And &H00000800)  <> 0 Then i = i & "  EnableTargetMetadata"        & vbCrLf
  202.     If (m And &H00001000)  <> 0 Then i = i & "  DisableLinkPathTracking"     & vbCrLf
  203.     If (m And &H00002000)  <> 0 Then i = i & "  DisableKnownFolderTracking"  & vbCrLf
  204.     If (m And &H00004000)  <> 0 Then i = i & "  DisableKnownFolderAlias"     & vbCrLf
  205.     If (m And &H00008000&) <> 0 Then i = i & "  AllowLinkToLink"             & vbCrLf
  206.     If (m And &H00000001)  <> 0 Then i = i & "  UnaliasOnSave"               & vbCrLf
  207.     If (m And &H00000002)  <> 0 Then i = i & "  PreferEnvironmentPath"       & vbCrLf
  208.     If (m And &H00000004)  <> 0 Then i = i & "  KeepLocalIDListForUNCTarget" & vbCrLf
  209.     If i <> "" Then i = Left(i, Len(i) - 2)
  210.     LinkFlags = i
  211. End Function
复制代码

作者: jyswjjgdwtdtj    时间: 2024-3-29 23:00

那要是改了syswow64里文件的lnk的目标文件 description还会读去不了吗^_^
作者: czjt1234    时间: 2024-3-30 05:59

回复 3# jyswjjgdwtdtj


    读不了,测试过的,忘写了
作者: jyswjjgdwtdtj    时间: 2024-3-30 20:44

回复 4# czjt1234


    那把一个lnk文件的目标文件改成syswow64里的文件在改成别的,description可以读取吗




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2