VBScriptバイナリアレイのヘルプが必要です（Windows 10 1607バグ？）

Question

バイナリファイルを読み取り、1バイトを変更してファイルを保存する作業用.vbsファイルがあります。 Windows 1607まで、これは多くの異なるWindowsシステムでうまくいきました。

ただし、Windows 10の1607以降のバージョンでは機能しなくなりました。 コードを変更しましたが、私は1607で正しく動作しませんでしたが、私はまだ data = Mid(data, 1, 21) & Chr(b21) & Mid(data, 23)の問題を抱えています.Windows   10 1607の前に完全に問題なく動作しています。

Iは（60 3）

を取得ADODB.Stream：引数は、間違ったタイプのもので許容範囲外であるか、または互いと競合しています。

このコードは、デスクトップにショートカットを作成し、ショートカットが管理者として実行されるように1バイトの1ビットを変更します。問題のある行をコメントアウトすると、うまくいくように見えます。

これは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) 

それは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（）配列のみを受け入れます。

' 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 

しかし、文字列が最初にマルチバイトに変換する必要があります

ソリューションはmotobitのウェブサイトからこの機能を使用することです。この目的のために別の機能があります：

' 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))