VB、VBS 、ASP、VBA 利用ADODB.Stream實現GB2312和UTF8編碼轉換

    先前說到，想用 ADODB.Stream 實現GB2312和UTF8編碼轉換 未果，找了下，找到個文章：《利用ADO STREAM實現GB2312和UTF8編碼轉換》，試了下，在VB和VBA都沒問題，但是在 ASP 和 VBS 下面就不成了，原因就是我一直糾結的，adoStream.Write bytes 失敗！

    於是又專門找了一下 VBS 下 Byte 數組的定義方法（https://www.jb51.net/article/33247.htm），將上面的《利用ADO STREAM實現GB2312和UTF8編碼轉換》 代碼改造了一下，終於實現了 VBS 和 ASP 下可用的 ADODB.Stream GB2312 和 UTF8 編碼轉換：

ps: GB2312 轉 UTF-8 得到的是一個 Variant 數組，因爲用於 Base64 或 MD5 編碼時不需要 UTF-8 的標識頭“&HEFBBBF”因此輸出的數組改造刪除了頭三字節 &HEFBBBF , 而且原文代碼中得到的是一個 byte 數組，不能直接用於 base64 和 MD5 編碼，也即：ustr(0) 報錯，必須使用 ascb(midb(ustr,i+1,1)) 才能得到可直接操作的數組，參見: e(19) 。 UTF-8 轉 GB2312 得到的則是 unicode 字符串

'- ------------------------------------------- -
'  函數說明：GB2312轉換爲UTF8 去除 頭部三字節
'- ------------------------------------------- -
Public Function GB2312ToUTF8(strIn)
    Dim adoStream, ustr, i, outarr()
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 2 'adTypeText
    adoStream.Open
    adoStream.WriteText strIn
    adoStream.Position = 0
    adoStream.Type = 1 'adTypeBinary
    'msgbox adoStream.size    
    ustr = adoStream.Read()
    'redim Preserve ustr(adoStream.size-1)
    adoStream.Close
    'WScript.Echo VarType(ustr), TypeName(ustr),"ustr"
    'msgbox ascb(midb(ustr,3,1))
    ReDim outarr(UBound(ustr) - 3)
    For i = 3 To UBound(ustr)
        outarr(i - 3) = ascb(midb(ustr,i+1,1))
    Next
    GB2312ToUTF8 = outarr
    'WScript.Echo VarType(outarr), TypeName(outarr)
    set adoStream=nothing
End Function

public function Varr2hexstr(a)  '-------轉換 Variant 數組爲十六進制字符串
	dim i,S
    For i = 0 To UBound(a)
        S=S & Right("00" & Hex(a(i)), 2)
    Next
    Varr2hexstr=S
End Function

public function HexStr2ByteArr(S) '-------轉換十六進制字符串爲 Bytes 數組（真,可寫入ADODB.Stream.Write）
	Dim xmldoc, node, bytes
	Set xmldoc = CreateObject("Msxml2.DOMDocument") 
	Set node = xmldoc.CreateElement("binary") 
	node.DataType = "bin.hex" 
	'demon.tw 的十六進制值爲 
	'64 65 6D 6F 6E 2E 74 77
	'node.Text = "64656D6F6E2E7477"
	node.Text = S
	bytes = node.NodeTypedValue 
	'WScript.Echo VarType(bytes), TypeName(bytes),"bytes"
    set xmldoc=nothing
    set node=nothing	
	HexStr2ByteArr=bytes
End Function

'- ------------------------------------------- -
'  函數說明：UTF8轉換爲GB2312 As String
'- ------------------------------------------- -
Public Function UTF8ToGB2312(varIn)
    Dim adoStream,bytes,S
	
	S="EFBBBF" & Varr2hexstr(varIn)
	bytes=HexStr2ByteArr(s)
        
    Set adoStream = CreateObject("ADODB.Stream")
    adoStream.Charset = "utf-8"
    adoStream.Type = 1 'adTypeBinary
    adoStream.Open
    adoStream.Write bytes
    adoStream.Position = 0
    adoStream.Type = 2 'adTypeText
    UTF8ToGB2312 = adoStream.ReadText()
    adoStream.Close
    
    set adoStream=nothing

End Function

使用 Msxml2.DOMDocument 實現了 VBS 中 Byte 數組的創建，並且結果可以用於 ADODB.Stream.Write 。

使用範例如下：

    Dim a,d,e
    a = "123中文，？αabc"
    e = GB2312ToUTF8(a)
	msgbox e(19)
    d = UTF8ToGB2312(e)    
    msgbox d

注意： chrB，ascB ，CByte 在 VBS 和 ASP 中都無法得到 8209 Bytes() 的真字節數組。

詳情參考：

Dim x(9), i 
For i = 0 To 9 
x(i) = ascb(chrb(65+i)) 
Next
WScript.Echo VarType(x), TypeName(x),"x"

此記！