本帖最后由 老刘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
|
发表于 2017-4-23 14:00:30