Board logo

标题: [原创] 双字节字符转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

替作者完善下功能
现在可以支持所有双字节字符了(包括汉字)
  1. Option Explicit
  2. Rem 老刘制作~
  3. Rem 读取二进制函数块感谢一个不知名的老外,设置剪辑版感谢Demon,此外原创~
  4. Rem 转载请注明作者昵称及批处理之家,感谢合作。
  5. Randomize
  6. Const ForReading = 1 , ForWriting = 2
  7. Dim [需转换的文本],FSO
  8. Set FSO = CreateObject("Scripting.FileSystemObject")
  9. [需转换的文本] = Replace( _
  10. InputBox("输入需要转换的文本:" & vbNewLine & "\n会被替换为回车符+换行符") , _
  11. "\n" , vbCrLf)
  12. If [需转换的文本] = "" Then WScript.Quit
  13. Dim [随机文件名]
  14. [随机文件名] = Replace(Rnd,".","")
  15. Dim [文件指针]
  16. Set [文件指针] = _
  17. FSO.CreateTextFile(FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP",True)
  18. [文件指针].Write [需转换的文本]
  19. [文件指针].Close
  20. [ANSI转UTF-8] FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP"
  21. Dim [二进制数组],[元素指针],[UTF-8编码后文本二进制(使用0xHex表示)内容]
  22. [二进制数组] = ReadBinary(FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP")
  23. FSO.DeleteFile FSO.GetSpecialFolder(2)&"\"&[随机文件名]&".TMP",True
  24. For [元素指针] = 0 To UBound([二进制数组])
  25. If Len(Hex([二进制数组]([元素指针]))) = 1 Then
  26. [UTF-8编码后文本二进制(使用0xHex表示)内容] = _
  27. [UTF-8编码后文本二进制(使用0xHex表示)内容] & _
  28. "\x0" & Hex([二进制数组]([元素指针]))
  29. Else
  30. [UTF-8编码后文本二进制(使用0xHex表示)内容] = _
  31. [UTF-8编码后文本二进制(使用0xHex表示)内容] & _
  32. "\x" & Hex([二进制数组]([元素指针]))
  33. End If
  34. Next
  35. [设置剪辑版] [UTF-8编码后文本二进制(使用0xHex表示)内容]
  36. MsgBox "已经替你复制到了剪辑版~"
  37. Rem ANSI转UTF-8
  38. Sub [ANSI转UTF-8](FilePath)
  39. Dim objStream,objFSO
  40. Set objFSO = CreateObject("Scripting.FileSystemObject")
  41. Set objStream = CreateObject("Adodb.Stream")
  42. objStream.Type = 2
  43. objStream.Mode = 3
  44. objStream.Charset = "UTF-8"
  45. If objFSO.FileExists(FilePath) = True Then
  46. Dim Text
  47. Text = objFSO.OpenTextFile(FilePath,ForReading,False).ReadAll
  48. objFSO.DeleteFile FilePath,True
  49. objStream.Open
  50. objStream.WriteText Text
  51. objStream.SaveToFile FilePath
  52. objStream.Close
  53. End If
  54. End Sub
  55. Rem 读二进制
  56. Function ReadBinary(FileName)
  57.   Dim Buf(), I
  58.   With CreateObject("ADODB.Stream")
  59.     .Mode = 3: .Type = 1: .Open: .LoadFromFile FileName
  60.     ReDim Buf(.Size - 1)
  61.     For I = 0 To .Size - 1: Buf(I) = AscB(.Read(1)): Next
  62.     .Close
  63.   End With
  64.   ReadBinary = Buf
  65. End Function
  66. Sub [设置剪辑版](Text)
  67.     With CreateObject("Word.Application")
  68.         .Documents.Add
  69.         .Selection.Text = Text
  70.         .Selection.Copy
  71.         .Quit False
  72.     End With
  73. End Sub
复制代码

作者: 老刘1号    时间: 2023-2-19 23:00

回复 2# jyswjjgdwtdtj


    当年的黑历史,甭管了…




欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2