大文本、定宽、中英文混编的UTF-8文本导入方案

duzili

注意标题，是定宽的，是中英文混编的，而且是大文本--最少数十兆吧。如果没有这三限定条件，utf-8文本导入数据库并不是什么难事，我也不用抓狂。

----------------------------------------------------------------------------------------------------------------------------------------------------------
如果你的文本是定宽文本，而且是中英文混编，转换之后你将发现数据长度发生变化了...这是因为，UTF-8使用一至四个字节为每个字符编码，如果要转换定宽文本，首先你要知道文本的具体编码。不过大多数情况下，utf-8编码都是三个字节来存储中文。
对于access或sql server来说，UTF-8文本支持的并不好，而fox pro或oracle及其他数据库对utf-8支持的很好。在sql server中，如果手动导入utf-8文本，没问题，它可以正确识别。但要是用bcp工具或t-sql导入，抱歉，sql server明确告诉你不支持。而在access中，导入后会发生错位！--它把中文当做两个字符处理...
  
首先解决Utf-8转换的问题。
很多人会想到使用  ADODB.Stream   Microsoft ActiveX Data Objects 2.5  ）进行转换，但是如果这个文本文件很大，比如说20M，   其速度将是很难容忍。  所幸微软提供了一个api函数MultiByteToWideChar ，其速度还令人满意。

然后解决3个字节的问题。
我对utf-8文本的编码没有太多研究，也没精力和能力去研究，所以复杂问题简单化，每个GBK编码汉字后面加个空格不三个字节吗！
循环读取文本文件的每一行，判断每个字符的ascii码，如果小于0，则是非ascii文字，就给这个字符后面加一个空格，最后再拼接成完整的一行...写入....完成。举例来说，对“101001现金001        123412345”这样的文本，最后将变成‘101001现 金 001        123412345 ’。尽管每个汉字后面都有个空格，感觉挺怪异，但是好像是我能够想到的最好办法了....

在我的方法中，UTF-8转换是在内存中进行的，这是速度的关键所在。 所以，我没有采用逐行读取文本文件的模式，而是采用块读取的模式。即按照1024的整数倍（倍数根据内存大小设置），将文本读入到内存中，然后进行UTF-8转换。本来想将汉字加空格也放在内存中进行，但好像速度提升不明显。经过测试，这个速度还是很快，数百兆的文本文件，不到一分钟就转换完毕--当然我用的是服务器......

这个代码是我在2008年写的，当时我在澳门。当时时间紧迫，现在回过头来看，变量定义都在偷懒，连 Dim iii As Long 这样的定义都写出来了，汗颜啊！

弹指一挥间，尼玛已经四年了。

另外，对utf-8文本导入到微软数据库的问题，若有大侠有更好的解决方法，烦请告知。我一度想放弃sql server和access，要不是老了学不动了，早就当叛徒投降oracle。不过说实话，oracle的性能还是牛哄哄的


以下是代码，一共三个函数：
utf8Filetransfor  转换UTf-8文本，进行文本块分割。
Utf8ToUnicode 将utf-8文本转换为GBK。转换函数使用了api函数MultiByteToWideChar
writeGBKtext     将每个中文字符后面加上空格，并写入到新文本文件中

调用方法：
utf8Filetransfor(utf8file As String, newtextfile As String)

1. Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
   
2. Private Const CP_UTF8 = 65001
   
3. 
   
4. Function Utf8ToUnicode(ByRef Utf() As Byte) As String
   
5. Dim msg As String
   
6.     Dim lRet As Long
   
7.     Dim lLength As Long
   
8.     Dim lBufferSize As Long
   
9.     lLength = UBound(Utf) - LBound(Utf) + 1
   
10.     If lLength <= 0 Then Exit Function
    
11.     lBufferSize = lLength * 2
    
12.     Utf8ToUnicode = String$(lBufferSize, Chr(0))
    
13.     lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
    
14.     If lRet <> 0 Then
    
15.         Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
    
16.     End If
    
17.     Exit Function
    
18. End Function
    
19. 
    
20. 
    
21. 
    
22. 
    
23. Sub utf8Filetransfor(utf8file As String, newtextfile As String)
    
24. 'On Error GoTo errexit:
    
25. 
    
26.     DoEvents
    
27.     Dim f_txtstream As TextStream
    
28.     Dim fso As New FileSystemObject, fle As File
    
29. Dim Stg_read As String
    
30. Dim iii As Long
    
31. iii = 1
    
32.     Dim sfFileName As String    '文件名
    
33.     Dim sReadData As String
    
34.     Dim Fn As Long
    
35.     Dim lFileLong As Double    '存储文件大小，如果文件大小超过double值的范围，就会出错
    
36.     Dim lReadL As Double    '存储下一读取位置，如果超过double值的范围，就会出错
    
37.     Dim LreadNow As Double
    
38.     Dim utfbyte() As Byte    '存储读取出来的字节
    
39.     Dim DAT() As Byte, DAT1() As Byte
    
40.     Dim ii As Long     '循环变量
    
41.     Dim Sutf As String, s_tmp As String
    
42.     sfFileName = utf8file
    
43. 
    
44. 
    
45.     LreadNow = 1    '已经读写完毕的文件位置，初始为1
    
46.     Dim lng_Split As Long    '定义分割的块数
    
47. 
    
48.     b = 3
    
49.     lReadL = 1024 * b '每次读入数据的长度字节长度,除以整行字节数后,余数不要太大,因为后面要进行行结束符的判断
    
50.     lng_Split = 1
    
51. 
    
52.     Fn = FreeFile
    
53. 
    
54.     If Dir(newtextfile) <> "" Then Kill newtextfile
    
55.     fso.CreateTextFile newtextfile
    
56.     Set fle = fso.GetFile(newtextfile)
    
57.     Set f_txtstream = fle.OpenAsTextStream(ForWriting)
    
58. 
    
59.     Open sfFileName For Binary As #Fn '以二进制打开文本文件
    
60.     lFileLong = LOF(Fn)    '取得文件的大小
    
61.     If lFileLong < lReadL Then lReadL = lFileLong    '如果设定的每次读入长度小于文件长度，则每次读入长度等于文件长度
    
62. 
    
63. 
    
64. 
    
65. 
    
66.     Do While LreadNow < lFileLong
    
67. 
    
68.         ReDim DAT(lReadL), DAT1(1)    '分配内存空间.分配n*1024较好，速度会更快
    
69. 
    
70.         DoEvents
    
71.         Seek #Fn, LreadNow    '在 Open 语句打开的文件中，设置下一个读/写操作的位置
    
72.         Get #Fn, , DAT   '  ＊读取等于分割大小的二进制数据到内存数组＊/
    
73. 
    
74.         '-----以下代码判断是否读取的是整行-------------------
    
75.         If DAT(lReadL) <> &HD Then
    
76.             For ii = 1 To lReadL
    
77.                 If DAT(lReadL - ii) = &HD Then '判断是否是整行
    
78. 
    
79.                     lReadL = lReadL - ii
    
80. 
    
81. 
    
82.                     ReDim DAT(lReadL), DAT1(1)    '分配内存空间.分配n*1024较好，速度会更快
    
83.                     Seek #Fn, LreadNow    '在 Open 语句打开的文件中，设置下一个读/写操作的位置
    
84.                     Get #Fn, , DAT   '  ＊读取等于分割大小的二进制数据到内存数组＊/
    
85. 
    
86.                     Exit For
    
87. 
    
88.                 End If
    
89.             Next
    
90. 
    
91.         End If
    
92.         LreadNow = LreadNow + lReadL + 1
    
93.         l1.Caption = Format(Int(LreadNow / 1024), "##,###") & "kb"
    
94.         '----------over------------------------------------'
    
95.         Stg_read = ""
    
96. Stg_read = Utf8ToUnicode(DAT)
    
97. 'Debug.Print Stg_read
    
98.      f_txtstream.Write Stg_read
    
99. 
    
100.         '-=====不使用open方法的原因是,每一次使用Print之后,会产生一个空行================
     
101.       '   Open newtextfile For Append As 2#    '打开新文件，如果不存在，则创建一个
     
102.       '        Write #2, Stg_read       '写入文本
     
103.               
     
104.      '    Close 2#
     
105.         '=============================================================
     
106.         lReadL = 2500 * b '每次读入数据的长度字节长度,除以整行字节数后,余数不要太大,因为后面要进行行结束符的判断
     
107. 
     
108.         If lReadL >= lFileLong Or LreadNow = lFileLong Then Exit Do    '如果块大小等于文件大小，不用循环，直接退出
     
109. 
     
110.         If LreadNow > lFileLong Then lFileLong = lFileLong - LreadNow
     
111. 
     
112. 
     
113. 
     
114.     Loop
     
115.     Close #Fn
     
116.     f_txtstream.Close
     
117. 
     
118.     Set f_txtstream = Nothing
     
119.     Set fle = Nothing
     
120. 
     
121. 
     
122. 
     
123. 
     
124.     Set fso = Nothing
     
125. writeGBKtext utf8file & "bak", utf8file
     
126. If Command = "" Or IsNull(Command) = True Then MsgBox "txtfile trim successful!"
     
127. Exit Sub
     
128. errexit:
     
129. If Err = 5 Then msg = "maybe have two reasons:" & Chr(10) & "1.This textfile's code not is Utf-8" & Chr(10) & "2.This textfile include  East Asian language's words,but your computer not setup it"
     
130. 
     
131.    
     
132. If Command = "" Or IsNull(Command) = True Then MsgBox "error :" & Err.Number & "," & Err.Description & Chr(10) & msg, vbCritical, "err"
     
133. 
     
134. End Sub
     
135. 
     
136. 
     
137. 
     
138. 
     
139. Sub writeGBKtext(gbkfileName As String, UTFflileNAme As String) '文本整理
     
140. 
     
141. Dim fso As New FileSystemObject
     
142. Dim jj As Long
     
143.     Dim ss_line As String, ss_new As String, ss_mid As String '存储旧的gbk单行文本，存储新的一行文本，存储单个文本
     
144.     Dim ii As Integer, int_txtlong As Integer '存储单行文件循环变量
     
145. 
     
146. jj = 1
     
147. 
     
148.     If Dir(gbkfileName & "x") <> "" Then Kill gbkfileName & "x" '判断新文件是否存在，如果存在则删除
     
149.     Open gbkfileName & "x" For Append As 2# '打开新文件，如果不存在，则创建一个
     
150. 
     
151. 
     
152. 
     
153.     Open gbkfileName For Input As 1# '打开已经transfor为gbk编码的文本文件
     
154. 
     
155.     Do Until EOF(1) 'gbk文件循环开始
     
156.     DoEvents
     
157.         Line Input #1, ss_line '读入一行到ss_line
     
158.         ss_new = "" 'ss_new赋值为空
     
159.         ss_mid = "" 'ss_mid
     
160. 
     
161.         int_txtlong = Len(ss_line)
     
162.         For ii = 1 To int_txtlong '从第一个字符开始循环，取得每一个字的ascii码
     
163.             ss_mid = Mid(ss_line, ii, 1) '取得一个字
     
164.             If Asc(ss_mid) < 0 Then '判断字符asc码，如果小于0，则是非ascii文字
     
165.                 ss_new = ss_new & ss_mid & " "
     
166.             Else
     
167.                 ss_new = ss_new & ss_mid
     
168.             End If
     
169.         Next
     
170. 
     
171.         Print #2, ss_new '写入文本
     
172.         jj = jj + 1
     
173.          ' l1.Caption = Format(Int((jj * int_txtlong) / 1024), "##,###") & "kb" '计算的不准确，将就一下
     
174.       
     
175.     Loop
     
176. 
     
177.     Close #1
     
178.     Close 2#
     
179. l1.Caption = ""
     
180. fso.DeleteFile UTFflileNAme
     
181. fso.DeleteFile gbkfileName
     
182. Name gbkfileName & "x" As UTFflileNAme
     
183. Set fso = Nothing
     
184. End Sub
     

复制代码

tmtony

坐个沙发