需要 VBScript 二进制数组帮助（Windows 10 1607 错误？）

Question

我有一个工作 .vbs 文件，它读取二进制文件，更改一个字节并保存文件。在 Windows 1607 之前，这在许多不同的 Windows 系统上都可以正常工作。

但是，现在对于 1607 及更高版本的 Windows 10，它不再有效！ 我已经更改了代码，因为我在 1607 中不再正常工作的读取文件代码，但我仍然遇到问题 data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23) 在 Windows 10 1607 之前完美运行的行！

我明白了

(60, 3) ADODB.Stream: 参数类型错误、超出可接受范围或相互冲突。

此代码在桌面上创建一个快捷方式，然后更改一个字节的一位，以便快捷方式以管理员身份运行。如果我注释掉有问题的行，那么它似乎可以工作。

这是 Windows 10 1607 VBScript 中的错误吗？

' Make shortcut on Desktop and Set as Run As Admin
Q = Chr(34)
Dim fso
Dim curDir
Dim WinScriptHost

If WScript.Arguments.Count < 2 Then 
    WScript.Echo "Please run CreateShortcuts.cmd"
    WScript.Quit
End If

' --- SET Target and Desktop Link Name from command line ---

strTargetName = WScript.Arguments.Item(0) 
strLinkName = WScript.Arguments.Item(1)

'Target - e.g.    %windir%\system32\cmd.exe /c C:\"temp\MakePartImage_AutoRun_FAT32.cmd"

Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strWinDir =WshShell.ExpandEnvironmentStrings("%windir%")
strSysDir = strWinDir & "\System32"
strMyDir = fso.GetParentFolderName(wscript.ScriptFullName) 
strDesktop = WshShell.SpecialFolders("Desktop")
strCurDir = WshShell.CurrentDirectory   ' e.g. C:\temp

strMyDirSpecial = Mid(strMyDir, 1, 3) & Q & Mid(strMyDir, 4) & "\" & strTargetName & Q
Set oMyShortCut= WshShell.CreateShortcut(strDesktop + "\" & strLinkName)
oMyShortCut.WindowStyle = 1                              '1=default 3=max  7=Min
oMyShortCut.TargetPath = Q & strSysDir & "\cmd.exe"  & Q
oMyShortCut.Arguments=  " /c " & strMyDirSpecial
oMyShortcut.IconLocation = "%windir%\system32\cmd.exe"
oMyShortCut.WorkingDirectory = Q & strMyDir & Q
oMyShortCut.Save
Set fso = Nothing

'read binary geometry into byte array
Dim stream, data
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1
stream.LoadFromFile(strDesktop + "\" & strLinkName)
data = stream.Read
stream.Close
WScript.Echo "BYTES 16-23 " & Hex(Asc(Mid(data, 16, 1))) & " " & Hex(Asc(Mid(data, 17, 1))) & " " & Hex(Asc(Mid(data, 18, 1))) & " " & Hex(Asc(Mid(data, 19, 1))) & " " & Hex(Asc(Mid(data, 20, 1))) & " " & Hex(Asc(Mid(data, 21, 1))) & " " & Hex(Asc(Mid(data, 22, 1))) & " " & Hex(Asc(Mid(data, 23, 1)))
' --- PATCH .LNK FILE to set byte 21 bit 5  for Admin rights
Dim b21
b21 = Asc(Nid(data, 22, 1)) Or 32    'set bit 6  0x20    
' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
WScript.Echo "BYTES 16-23 " & Hex(Asc(Mid(data, 16, 1))) & " " & Hex(Asc(Mid(data, 17, 1))) & " " & Hex(Asc(Mid(data, 18, 1))) & " " & Hex(Asc(Mid(data, 19, 1))) & " " & Hex(Asc(Mid(data, 20, 1))) & " " & Hex(Asc(Mid(data, 21, 1))) & " " & Hex(Asc(Mid(data, 22, 1))) & " " & Hex(Asc(Mid(data, 23, 1)))

Const adTypeBinary = 1
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write data
BinaryStream.SaveToFile strDesktop+"\" & strLinkName, adSaveCreateOverWrite

WScript.Echo "Shortcut " & strLinkName & " created on Desktop."

Answer 1

' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)

此行会导致问题，因为它将数据类型从 Byte() 更改为 String。这将说明它：

WScript.Echo TypeName(data)
' THIS NEXT LINE CAUSES PROBLEMS!
data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
WScript.Echo TypeName(data)

ADODB Stream.Write 函数只接受 Byte() 数组。

解决方法是使用motobit网站上的这个功能：

' http://www.motobit.com/tips/detpg_binarytostring/
Function MultiByteToBinary(MultiByte)
  '� 2000 Antonin Foller, http://www.motobit.com
  ' MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
  ' Using recordset
  Dim RS, LMultiByte, Binary
  Const adLongVarBinary = 205
  Set RS = CreateObject("ADODB.Recordset")
  LMultiByte = LenB(MultiByte)
  If LMultiByte>0 Then
    RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
    RS.Open
    RS.AddNew
      RS("mBinary").AppendChunk MultiByte & ChrB(0)
    RS.Update
    Binary = RS("mBinary").GetChunk(LMultiByte)
  End If
  MultiByteToBinary = Binary
End Function

但字符串需要先转换为多字节。为此，还有另一个功能：

' http://www.motobit.com/help/regedit/pa26.htm
'Converts unicode string to a multibyte string
Function StringToMB(S)
  Dim I, B
  For I = 1 To Len(S)
    B = B & ChrB(Asc(Mid(S, I, 1)))
  Next
  StringToMB = B
End Function

所以，这就是让它工作的方法：

data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)
data = MultiByteToBinary(StringToMB(data))