Summery

Windows 10 Command Prompt with Unicode(UTF-16LE） Option export text data unsuccessfully.
It very often happens.
So, UTF-16 File opend adodb.stream text, loaded and readed. Next, adodb streame text type Open and Write utf-16
and save.

発生させる方法

検索しても見つからないので、日本語環境でのみ発生しているのかもしれません。
E:\というドライブがあるとします。

`E:\`に♥㈲èéêëｱｲｳｴｵქართული.txtというようなファイル名を作ります。他に英語名のファイルや日本語名のファイルが数個あります。
Win+Rから`cmd /u` で起動します。
`Cd /d "E:\"`でEドライブに移動します
`Dir /b > Dirrst.txt`を作ります
Notepadで開きます。
ファイルサイズが数キロバイト程度では文字化けしてMACとか表示されます。
ファイルサイズが数10Kb程度の場合にはたまに文字化けします。

原因はBOMがない？

CMD /U で
Dir /b > result.txt
(カレントフォルダがC:\hogeなど普通のフォルダ）
で実行した場合、ほぼ間違いなく失敗します。
Check a file's Byte Order Mark (BOM) to determine its text encoding Rob van der Woude's Scripting Pages
で紹介されているスクリプトを使うと、
4300
6400
などでUnknownとなります。

BOMは許容されていないが？

UTF-16LEの解説ではBOMは許容されていないはずですが、BOMがないと読み込めません。
よくわからないのは、ファイルサイズが大きくなるとヘッダーが違っても正常に読み込まれる場合があることです。

原因はSCSU？

SCSU（英語: Standard Compression Scheme for Unicode）はUnicodeのテキストを表すために必要なバイト数を削減するためのUnicode技術標準である[1]。特にテキストが1つまたは少数の言語ごとの文字ブロックの文字をほとんど使用している場合に用いられる。128以上255以下の範囲の値を128文字の特定のブロック内のオフセットに動的にマッピングすることにより行なわれる。符号化器の初期状態は、NULLやTAB、CR、LF以外のC0制御文字を含まないASCII、およびISO-8859-1の既存の文字列をSCSU文字列として処理する。ほとんどのアルファベットは隣接するUnicode符号点のブロックに存在するため、アルファベットの小文字とASCII句読点、またはアルファベットの大文字の枠内に収まる句読点が用いられたテキストは1文字につき1バイトで符号化できる。他のほとんどの句読点は、非ロックシフトを介して1文字あたり2バイトで符号化できる。SCSUは、アルファベット以外の言語を処理するために内部でUTF-16に切り替えることもできる。

この表記からすると、小さいサイズほど必ず文字化けするこの現象と合致します。もしかするとSCSUになったりならなかったりするのかもしれません。

ADODB.Streamの欠点を使用する

Binaryの書き込みはとても面倒

Binaryで開いてBOMを削除するパターンは人気ですが、書き込むパターンは難しいです。

ADODB.Streamの欠点

ADODB.StreamオブジェクトのSaveToFileメソッドでUTF-8形式のファイルを作成した場合、ファイルの先頭にBOM(Byte Order Mark)が付加されてしまいます。これを解決するための方法を整理します。
ADODB.SｔreamはUTF-8のファイルを開いて、再度保存すると勝手にBOMを追加してしまいます。
それで、削除するコードも造られます。
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12174965337
このテクニックは重要なのですが、
外字を使うのはやめてくれ！ Unicodeへの移行を呼びかけるMicrosoftの公式ブログ記事が話題に
今や「メモ帳」でさえテキストファイルをUnicodeで保存する時代！ Shift_JISはやめよう
そのまえにこういう挙動について解決しないMicorosoftが偉そうに何を言っているのだろうか。なんでこう自分の会社の製品の欠陥に関心がないんですかね。信じがたい企業だ。

欠点を逆手にとる

しかし、ここで気が付きました。
バイナリでBOMを付加するのがだめなら、テキストで開いてテキストで保存すればいいのではないか。
もしUTF-8で起きることがUTF-16で起きれば良いわけです。
ただし、これは作ったファイルが上記のような経緯で作られた古いNotepadではUnidoce新しいNotePadではUTF-16LEとなっているテキストファイルであることが前提となります。
本当に恥ずかしいのですが、Check a file's Byte Order Mark (BOM) to determine its text encoding Rob van der Woude's Scripting Pages
このコードを借ります。他の文字コードはスルーして、Unknownになったテキストファイルのヘッダーの文字列の取得するというのが見当たらないし、作れません。

ポイント文字コードの判定は他力本願

vbscript

WScript.Echo "File Name : " & strFile & vbcrlf _
& "First 4 bytes : " & strHead & vbcrlf _
& "Matching BOM : " & strBOM & vbcrlf _
& "File Encoding : " & strType
AddBomUTF16(strFile) 'Unknownに入ったら壊れたものとみなして強制的にBOMを付与
WScript.Quit intRC

この行に至るまでに主要なコードは判定されてUnknownになります。
そこでAddBomUTF16(strFile)がコールされます。つまり、正常なヘッダーのUTF-16LEはこの時点でBOM追加されません。

ポイント

文字化けしているファイルをUTF-16 テキストで開き、読み込んだ後、再度テキストでWriteして、それを新しいファイル名で保存します。新しいファイル名がすでに存在しているときは既存のファイルは削除します。
つまりAdodbStreamを使い、UTF-16 テキストで開き、それをReadで全部メモリに読み込み、もう一度UTF-16テキストで書き込み保存します。
このようにするとBinaryで開く必要がありません。これだけでBOMが追加されます。

VBScript

Sub AddBomUTF16(strFile)
Dim ab, r : Set ab = CreateObject("ADODB.Stream")
Dim SO : Set SO = CreateObject("Scripting.FileSystemObject")
Dim WSH :: Set WSH = CreateObject("Wscript.Shell")
Dim Shell: Set Shell = CreateObject("Shell.Application")
Dim strExt, strBase ,strParent
Dim DT , NS, Pars
With SO
' ファイルが存在しないなら終了
If .FileExists(strFile) = False Then Wscript.Quit
' bom追加後のファイルにはBaseNameの末尾にaddUtf16BOMを追加するため、ファイル名を分解する
strExt = .GetExtensionName(strFile)
strBase = .GetBaseName(strFIle)
'ParentFolderはE:\のようなドライブのルートの場合、取得できない。これを判定して、ルートの場合にはドライブを取得する。

IF .GetFile(strFile).Parentfolder.Isrootfolder then
StrParent = .GetFile(strFile).Drive & "\"
Else
strParent = .GetParentFolderName(strFile)
end If
' 更新日時を一致させて、検索の便をはかるため取得
DT = so.Getfile(strFile).DateLastModified
End WIth

ab.Type = 2 'adTypeText
ab.Charset = "UTF-16"
ab.Open
ab.LoadFromFile strfile
r = ab.ReadText(-1)
ab.Close '全部読み込んで取得後閉じる。このため、メモリが小さいと大きいファイルは処理ができない。
ab.Type = 2 'adTypeText
ab.Charset = "UTF-16"
ab.Open '再度UTF-16
ab.WriteText r, 0
if so.fileexists(strParent & "\" & StrBase & "addUtf16BOM." & strExt) Then so.Deletefile(strParent & "\" & StrBase & "addUtf16BOM." & strExt)
ab.SaveToFile strParent & "\" & StrBase & "addUtf16BOM." & strExt
ab.Close
Set ab = Nothing
Set NS = Shell.Namespace( strParent)
Set Pars = NS.ParseName( StrBase & "addUtf16BOM." & strExt)
Pars.ModifyDate = Dt
Wscript.Echo "Add Bom"
Set Shell = Nothing
set so = Nothing

End sub

スクリプト全体

Rob van der Woude氏に感謝します。
いつかはオリジナル化したいのですが、高度過ぎて見通しが立ちません。
adodb.streamでUTF-16LEにBOMを付与する方法の欠点は後述します。

VBScript"C:\Hoge\Cs_AddUTF_16LEBOM.VBS"

Option Explicit
' https://en.wikipedia.org/wiki/Byte_order_mark
' https://www.tipsfound.com/vba/18013
'Encoding Hex BOM
'======== =======
'BOCU-1 FB EE 28
'GB-18030 84 31 95 33
'SCSU 0E FE FF
'UTF-1 F7 64 4C
'UTF-7 2B 2F 76 (38|39|2B|2F)
'UTF-8 EF BB BF
'UTF-16 (BE) FE FF
'UTF-16 (LE) FF FE
'UTF-32 (BE) 00 00 FE FF
'UTF-32 (LE) FF FE 00 00
'UTF-EBCDIC DD 73 66 73

Const adTypeBinary = 1
Const adTypeText = 2

Dim i, intRC
Dim dicBOMs, objFSO, objStream
Dim strBOM, strFile, strHead, strType, strUTF7

If WScript.Arguments.Unnamed.Count <> 1 Then Syntax
If WScript.Arguments.Named.Count > 0 Then Syntax

intRC = 0
strFile = WScript.Arguments.Unnamed(0)
strType = "Unknown"
strUTF7 = "38;39;2B;2F" ' Allowed values for 4th byte of UTF-7 BOM

Set objFSO = CreateObject( "Scripting.FileSystemObject" )
If Not objFSO.FileExists( strFile ) Then Syntax
Set objFSO = Nothing

Set dicBOMs = CreateObject( "Scripting.Dictionary" )
dicBOMs.Add "0000FEFF", "UTF-32 (BE)"
dicBOMs.Add "0EFEFF", "SCSU"
dicBOMs.Add "2B2F76", "UTF-7" ' First 3 bytes of BOM only, 4th byte can have several values
dicBOMs.Add "84319533", "GB-18030"
dicBOMs.Add "DD736673", "UTF-EBCDIC"
dicBOMs.Add "EFBBBF", "UTF-8"
dicBOMs.Add "F7644C", "UTF-1"
dicBOMs.Add "FBEE28", "BOCU-1"
dicBOMs.Add "FEFF", "UTF-16 (BE)"
dicBOMs.Add "FFFE", "UTF-16 (LE)"
dicBOMs.Add "FFFE0000", "UTF-32 (LE)"

On Error Resume Next
Set objStream = CreateObject( "ADODB.Stream" )
objStream.Open
objStream.Type = adTypeBinary
objStream.LoadFromFile strFile
If Err Then intRC = 1
objStream.Position = 0
strHead = ""
For i = 0 To 3
strHead = strHead & UCase( Right( "0" & Hex( AscB( objStream.Read( 1 ) ) ), 2 ) )
If Err Then intRC = 1
Next
objStream.Close
Set objStream = Nothing
On Error Goto 0

If intRC = 1 Then Syntax

For i = 8 To 4 Step -2 ' Try the longest match (4 bytes) first, next try 3 bytes, finally try 2 bytes
If strType = "Unknown" Then
strBOM = Left( strHead, i )
If dicBOMs.Exists( strBOM ) Then
If dicBOMs( strBOM ) = "UTF-7" Then
If InStr( strUTF7, Right( strHead, 2 ) ) Then strType = "UTF-7"
Else
strType = dicBOMs( strBOM )
End If
End If
End If
Next

If strType = "Unknown" Then intRC = 1

WScript.Echo "File Name : " & strFile & vbcrlf _
& "First 4 bytes : " & strHead & vbcrlf _
& "Matching BOM : " & strBOM & vbcrlf _
& "File Encoding : " & strType
AddBomUTF16(strFile) 'Unknownに入ったら壊れたものとみなして強制的にBOMを付与
WScript.Quit intRC


Sub Syntax
Dim strMsg
strMsg = vbCrLf _
& "CheckBOM.vbs, Version 1.00" _
& vbCrLf _
& "Check a file's Byte Order Mark (BOM) to determine its text encoding" _
& vbCrLf & vbCrLf _
& "Usage: CheckBOM.vbs textfilename" _
& vbCrLf & vbCrLf _
& "Note: The file encoding is displayed on screen, e.g. ""UTF-7"" or" _
& vbCrLf _
& " ""UTF-32 (LE)"", or ""Unknown"" if not recognized." _
& vbCrLf _
& " Check this script's source code for a list of recognized BOMs." _
& vbCrLf & vbCrLf _
& "Written by Rob van der Woude" _
& vbCrLf _
& "http://www.robvanderwoude.com"
WScript.Echo strMsg
WScript.Quit 1
End Sub


Sub AddBomUTF16(strFile)
Dim ab, r : Set ab = CreateObject("ADODB.Stream")
Dim SO : Set SO = CreateObject("Scripting.FileSystemObject")
Dim WSH :: Set WSH = CreateObject("Wscript.Shell")
Dim Shell: Set Shell = CreateObject("Shell.Application")
Dim strExt, strBase ,strParent
Dim DT , NS, Pars
With SO
If .FileExists(strFile) = False Then Wscript.Quit
strExt = .GetExtensionName(strFile)
strBase = .GetBaseName(strFIle)
IF .GetFile(strFile).Parentfolder.Isrootfolder then
StrParent = .GetFile(strFile).Drive & "\"
Else
strParent = .GetParentFolderName(strFile)
end If

DT = so.Getfile(strFile).DateLastModified
End WIth

ab.Type = 2
ab.Charset = "UTF-16"
ab.Open
ab.LoadFromFile strfile
r = ab.ReadText(-1)
ab.Close
ab.Type =adTypeText
ab.Charset = "UTF-16"
ab.Open
ab.WriteText r, 0
if so.fileexists(strParent & "\" & StrBase & "addUtf16BOM." & strExt) Then so.Deletefile(strParent & "\" & StrBase & "addUtf16BOM." & strExt)
ab.SaveToFile strParent & "\" & StrBase & "addUtf16BOM." & strExt
ab.Close
Set ab = Nothing
Set NS = Shell.Namespace( strParent)
Set Pars = NS.ParseName( StrBase & "addUtf16BOM." & strExt)
Pars.ModifyDate = Dt
Wscript.Echo "Add Bom"
Set Shell = Nothing
set so = Nothing

End sub

コマンドラインでは現在変換できないので失敗したときはこれを使う

つまるところコマンドラインで変換する方法は現在無理です。cmd /uは以前はBOMつきで出力していました。
PowershellもBOM付きのようです。しかし失敗するときがあります。
このとき、こちらを使います。
昔から同じなのか、バグなのかわかりません。

この方法の欠点

メモ帳で正常に開けるが、`FF FE`のヘッダーがないUTF-16LE形式のテキストファイルが存在しており、その場合にはこのスクリプトでBOMを追加すると文字化けするという問題があります。adodbの欠陥でしょう。
なお、そういうファイルはサイズが10数キロバイトのときに出現しました。
必ず変換後のファイルと、元のファイルの中身を見てください。
全文を読み込むという性質から、メモリが小さいと失敗する可能性もあります。

## 現在のところ法則性がありません本当は借りずに済ませたいのですが、BOMなしという判定って難しいですね。ヘッダーがBOMではなくてもUTF-16LEとして開けるファイルがあるため問題が複雑です。なにか法則性があればいいのですが。だれかご存じでしたら教えてください。 Windowsの日本語に限ると、UTF-8はメモ帳でBOMなしで開けるようになったので、事実上BOMを判定して、BOMを追加する必要があるのは日本語環境では、UTF-16LEのみのはずです。