玩酷之家

 找回密码
 立即注册
查看: 64|回复: 0

VB 将字符串保存为txt格式UTF-8文件

[复制链接]
发表于 2021-3-31 16:47:20 | 显示全部楼层 |阅读模式
本帖最后由 Ineverleft 于 2021-3-31 16:50 编辑

  1. Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
  2.         ByVal CodePage As Long, _
  3.         ByVal dwFlags As Long, _
  4.         ByVal lpWideCharStr As Long, _
  5.         ByVal cchWideChar As Long, _
  6.         ByRef lpMultiByteStr As Any, _
  7.         ByVal cchMultiByte As Long, _
  8.         ByVal lpDefaultChar As String, _
  9.         ByVal lpUsedDefaultChar As Long) As Long
  10. ' 将输入文本写进UTF8格式的文本文件
  11. ' 输入
  12. ' strInput:文本字符串
  13. ' strFile:保存的UTF8格式文件路径
  14. ' bBOM:True表示文件带"EFBBBF"头,False表示不带
  15. Public Function WriteUTF8File(strInput As String, strFile As String, Optional bBOM As Boolean = True)
  16.     Dim CP_UTF8 As String
  17.     Dim bByte As Byte
  18.     Dim ReturnByte() As Byte
  19.     Dim lngBufferSize As Long
  20.     Dim lngResult As Long
  21.     Dim TLen As Long
  22.    
  23.     ' 判断输入字符串是否为空
  24.     If Len(strInput) = 0 Then Exit Function
  25.     On Error GoTo errHandle
  26.     ' 判断文件是否存在,如存在则删除
  27. '    If Dir(strFile) <> "" Then Kill strFile
  28.    
  29.     CP_UTF8 = 65001
  30.     TLen = Len(strInput)
  31.     lngBufferSize = TLen * 3 + 1
  32.     ReDim ReturnByte(lngBufferSize - 1)
  33.     lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strInput), TLen, _
  34.         ReturnByte(0), lngBufferSize, vbNullString, 0)
  35.     If lngResult Then
  36.         lngResult = lngResult - 1
  37.         ReDim Preserve ReturnByte(lngResult)
  38.         Open strFile For Binary As #1
  39.         If bBOM = True Then
  40.             bByte = 239
  41.             Put #1, , bByte
  42.             bByte = 187
  43.             Put #1, , bByte
  44.             bByte = 191
  45.             Put #1, , bByte
  46.         End If
  47.         Put #1, , ReturnByte
  48.         Close #1
  49.     End If
  50.     Exit Function
  51. errHandle:
  52.     MsgBox Err.Description, , "错误 - " & Err.Number
  53. End Function

复制代码

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|玩酷之家 ( 鄂ICP备14012049号 )

GMT+8, 2021-4-22 09:38 , Processed in 1.076402 second(s), 17 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表