高手是否可以整理出一个函数?
我这里有两个过程,希望可以做出函数调用,
Option Explicit
Dim DAT() As Byte, DAT1() As Byte
Dim Z As String
Dim i As Long
Private Sub SaveToUTF8_Click()
On Error GoTo OutError
Dim zAsc As Long 'Ascii码暂存
Dim L As Long '字节计数
CD.Flags = &H200A
CD.DialogTitle = "另存为"
CD.Filter = "UTF-8文本(*.txt)|*.txt"
CD.ShowSave
If CD.FileName = "" Then Exit Sub
For i = 1 To Len(Text1)
Z = Mid(Text1, i, 1): zAsc = Asc(Z)
If zAsc > 0 Then '如果不是汉字
ReDim Preserve DAT(L + 1) As Byte
DAT(L) = zAsc: L = L + 1
Else
ReDim Preserve DAT(L + 3) As Byte
DAT1 = Z
DAT(L) = (DAT1(1) And 240) / 16 Or 224
DAT(L + 1) = (DAT1(1) And 15) * 4 + ((DAT1(0) And 192) / 64) Or 128
DAT(L + 2) = DAT1(0) And 63 Or 128
L = L + 3
End If
Next
ReDim DAT1(2) As Byte
DAT1(0) = &HEF: DAT1(1) = &HBB: DAT1(2) = &HBF
Open CD.FileName For Binary As #1
Put #1, , DAT1
Put #1, , DAT
OutError:
Close
End Sub
Private Sub OpenFile_Click()
On Error GoTo InErr
Dim ST As String
Dim LFile As Long '文件长度
CD.Flags = &H200C
CD.DialogTitle = "打开"
CD.Filter = "文本文件(*.txt)|*.txt"
CD.ShowOpen
ST = CD.FileName
If ST = "" Then Exit Sub
LFile = FileLen(ST) - 1
ReDim DAT(LFile) As Byte, DAT1(1) As Byte
Open ST For Binary As #1
Get #1, , DAT
If DAT(0) = &HEF And DAT(1) = &HBB And DAT(2) = &HBF Then
ST = ""
For i = 3 To LFile
If DAT(i) < 128 Then
ST = ST & Chr(DAT(i))
Else
DAT1(1) = ((DAT(i) And 15) * 16 + (DAT(i + 1) And 60) / 4)
DAT1(0) = (DAT(i + 1) And 3) * 64 + (DAT(i + 2) And 63)
Z = DAT1: ST = ST & Z: i = i + 2
End If
Next
Else: ST = StrConv(DAT, vbUnicode)
End If
Text1 = ST: ST = ""
InErr:
Close
End Sub
笔者声明:
因为目前网上还找不到用VB编写的类似代码,所以如果哪位兄弟
要将本代码转发到别的网站,请注明“转自新帆新闻组”以及笔者的
网名。