标题: [原创] 双字节字符转16进制utf-8编码工具 For 二维码生成器 [打印本页]
作者: 老刘1号 时间: 2017-4-23 14:00 标题: 双字节字符转16进制utf-8编码工具 For 二维码生成器
本帖最后由 老刘1号 于 2017-4-23 17:53 编辑
批处理版二维码生成器: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 Sub
复制代码
作者: 老刘1号 时间: 2023-2-19 23:00
回复 2# jyswjjgdwtdtj
当年的黑历史,甭管了…
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |