[原创] 双字节字符转16进制utf-8编码工具 For 二维码生成器

老刘1号

批处理版二维码生成器：http://www.bathome.net/thread-32908-1-4.html

替作者完善下功能
现在可以支持所有双字节字符了（包括汉字）

Option Explicit
Rem 老刘制作～
Rem 读取二进制函数块感谢一个不知名的老外，设置剪辑版感谢Demon，此外原创～
Rem 转载请注明作者昵称及批处理之家，感谢合作。
Randomize
Const ForReading = 1 , ForWriting = 2
Dim [需转换的文本],FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
[需转换的文本] = Replace( _
	InputBox("输入需要转换的文本：" & vbNewLine & "\n会被替换为回车符+换行符") , _
		"\n" , vbCrLf)
If [需转换的文本] = "" Then WScript.Quit
Dim [随机文件名]
[随机文件名] = Replace(Rnd,".","")
Dim [文件指针]
Set [文件指针] = _
	FSO.CreateTextFile(FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP",True)
[文件指针].Write [需转换的文本]
[文件指针].Close
 
[ANSI转UTF-8] FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP"
 
Dim [二进制数组],[元素指针],[UTF-8编码后文本二进制（使用0xHex表示）内容]
[二进制数组] = ReadBinary(FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP")
FSO.DeleteFile FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP",True
 
For [元素指针] = 0 To UBound([二进制数组])
	If Len(Hex([二进制数组]([元素指针]))) = 1 Then
		[UTF-8编码后文本二进制（使用0xHex表示）内容] = _
			[UTF-8编码后文本二进制（使用0xHex表示）内容] & _
			"\x0" & Hex([二进制数组]([元素指针]))
	Else
		[UTF-8编码后文本二进制（使用0xHex表示）内容] = _
			[UTF-8编码后文本二进制（使用0xHex表示）内容] & _
			"\x" & Hex([二进制数组]([元素指针]))
	End If
Next
 
[设置剪辑版] [UTF-8编码后文本二进制（使用0xHex表示）内容]
 
MsgBox "已经替你复制到了剪辑版～"
 
 
Rem ANSI转UTF-8
Sub [ANSI转UTF-8](FilePath)
	Dim objStream,objFSO
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objStream = CreateObject("Adodb.Stream")
	objStream.Type = 2
	objStream.Mode = 3
	objStream.Charset = "UTF-8"
	If objFSO.FileExists(FilePath) = True Then
		Dim Text
		Text = objFSO.OpenTextFile(FilePath,ForReading,False).ReadAll
		objFSO.DeleteFile FilePath,True
		objStream.Open
		objStream.WriteText Text
		objStream.SaveToFile FilePath
		objStream.Close
	End If
End Sub
 
Rem 读二进制
Function ReadBinary(FileName)
  Dim Buf(), I
  With CreateObject("ADODB.Stream")
    .Mode = 3: .Type = 1: .Open: .LoadFromFile FileName
    ReDim Buf(.Size - 1)
    For I = 0 To .Size - 1: Buf(I) = AscB(.Read(1)): Next
    .Close
  End With
  ReadBinary = Buf
End Function
 
Sub [设置剪辑版](Text)
    With CreateObject("Word.Application")
        .Documents.Add
        .Selection.Text = Text
        .Selection.Copy
        .Quit False
    End With
End SubCOPY

老刘1号

回复 2# jyswjjgdwtdtj


    当年的黑历史，甭管了…