1 #Region "Microsoft.VisualBasic::0965289e3eaf0038712d540a7382413e, Microsoft.VisualBasic.Core\Text\IO\TextFileEncodingDetector.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module TextFileEncodingDetector
35     
36     '         Properties: TextCodings
37     
38     '         Function: DetectBOMBytes, DetectSuspiciousUTF8SequenceLength, DetectTextByteArrayEncoding, (+2 Overloads) DetectTextFileEncoding, DetectUnicodeInByteSampleByHeuristics
39     '                   IsCommonUSASCIIByte, ToString
40     
41     
42     ' /********************************************************************************/
43
44 #End Region
45
46 Imports System.Text
47 Imports System.IO
48 Imports System.Text.RegularExpressions
49
50 Namespace Text
51
52     ''' <summary>
53     ''' Encoding fileEncoding = TextFileEncodingDetector.DetectTextFileEncoding("you file path",Encoding.Default);
54     ''' </summary>
55     ''' <remarks></remarks>
56     Public Module TextFileEncodingDetector
57
58         Public ReadOnly Property TextCodings As Dictionary(Of String, System.Text.Encoding) =
59             New Dictionary(Of String, Encoding) From {
60  _
61             {"ascii", System.Text.Encoding.ASCII},
62             {"unicode", System.Text.Encoding.Unicode},
63             {"utf8", System.Text.Encoding.UTF8}
64         }
65
66         Public Function ToString(data As Generic.IEnumerable(Of Byte), Optional encoding As String = ""As String
67             If Not String.IsNullOrEmpty(encoding) Then encoding = encoding.ToLower
68             Dim TextEncoding As System.Text.Encoding = If(String.IsNullOrEmpty(encoding) OrElse Not TextCodings.ContainsKey(encoding), System.Text.Encoding.Default, TextCodings(encoding))
69             Return TextEncoding.GetString(data.ToArray)
70         End Function
71
72         '
73         '* Simple class to handle text file encoding woes (in a primarily English-speaking tech
74         '* world).
75         '*
76         '* - This code is fully managed, no shady calls to MLang (the unmanaged codepage
77         '* detection library originally developed for Internet Explorer).
78         '*
79         '* - This class does NOT try to detect arbitrary codepages/charsets, it really only
80         '* aims to differentiate between some of the most common variants of Unicode
81         '* encoding, and a "default" (western / ascii-based) encoding alternative provided
82         '* by the caller.
83         '*
84         '* - As there is no "Reliable" way to distinguish between UTF-8 (without BOM) and
85         '* Windows-1252 (in .Net, also incorrectly called "ASCII") encodings, we use a
86         '* heuristic - so the more of the file we can sample the better the guess. If you
87         '* are going to read the whole file into memory at some point, then best to pass
88         '* in the whole byte byte array directly. Otherwise, decide how to trade off
89         '* reliability against performance / memory usage.
90         '*
91         '* - The UTF-8 detection heuristic only works for western text, as it relies on
92         '* the presence of UTF-8 encoded accented and other characters found in the upper
93         '* ranges of the Latin-1 and (particularly) Windows-1252 codepages.
94         '*
95         '* - For more general detection routines, see existing projects / resources:
96         '* - MLang - Microsoft library originally for IE6, available in Windows XP and later APIs now (I think?)
97         '* - MLang .Net bindings: http://www.codeproject.com/KB/recipes/DetectEncoding.aspx
98         '* - CharDet - Mozilla browser's detection routines
99         '* - Ported to Java then .Net: http://www.conceptdevelopment.net/Localization/NCharDet/
100         '* - Ported straight to .Net: http://code.google.com/p/chardetsharp/source/browse
101         '*
102         '* Copyright Tao Klerks, Jan 2010, tao@klerks.biz
103         '* Licensed under the modified BSD license:
104         '*
105         '
106         'Redistribution and use in source and binary forms, with or without modification, are
107         'permitted provided that the following conditions are met:
108         '
109         '- Redistributions of source code must retain the above copyright notice, this list of
110         'conditions and the following disclaimer.
111         '- Redistributions in binary form must reproduce the above copyright notice, this list
112         'of conditions and the following disclaimer in the documentation and/or other materials
113         'provided with the distribution.
114         '- The name of the author may not be used to endorse or promote products derived from
115         'this software without specific prior written permission.
116         '
117         'THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
118         'INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
119         'A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
120         'DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
121         'BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
122         'PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
123         'WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
124         'ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY
125         'OF SUCH DAMAGE.
126         '
127         '*
128         '
129
130         Const _defaultHeuristicSampleSize As Long = &H10000
131
132         ''' <summary>
133         ''' completely arbitrary - inappropriate for high numbers of files / high speed requirements
134         ''' </summary>
135         ''' <param name="InputFilename"></param>
136         ''' <param name="DefaultEncoding"></param>
137         ''' <returns></returns>
138         ''' <remarks></remarks>
139         Public Function DetectTextFileEncoding(InputFilename As StringOptional DefaultEncoding As Encoding = NothingAs Encoding
140             Using textfileStream As FileStream = IO.File.OpenRead(InputFilename)
141                 If DefaultEncoding Is Nothing Then
142                     DefaultEncoding = System.Text.Encoding.Default
143                 End If
144                 Return DetectTextFileEncoding(textfileStream, DefaultEncoding, _defaultHeuristicSampleSize)
145             End Using
146         End Function
147
148         Public Function DetectTextFileEncoding(InputFileStream As FileStream, DefaultEncoding As Encoding, HeuristicSampleSize As LongAs Encoding
149             If InputFileStream Is Nothing Then
150                 Throw New ArgumentNullException("Must provide a valid Filestream!""InputFileStream")
151             End If
152
153             If Not InputFileStream.CanRead Then
154                 Throw New ArgumentException("Provided file stream is not readable!""InputFileStream")
155             End If
156
157             If Not InputFileStream.CanSeek Then
158                 Throw New ArgumentException("Provided file stream cannot seek!""InputFileStream")
159             End If
160
161             Dim encodingFound As Encoding = Nothing
162             Dim originalPos As Long = InputFileStream.Position
163
164             InputFileStream.Position = 0
165
166             'First read only what we need for BOM detection
167
168             Dim bomBytes As Byte() = New Byte(If(InputFileStream.Length > 4, 4, InputFileStream.Length) - 1) {}
169             InputFileStream.Read(bomBytes, 0, bomBytes.Length)
170
171             encodingFound = DetectBOMBytes(bomBytes)
172
173             If encodingFound IsNot Nothing Then
174                 InputFileStream.Position = originalPos
175                 Return encodingFound
176             End If
177
178             'BOM Detection failed, going for heuristics now.
179             ' create sample byte array and populate it
180             Dim sampleBytes As Byte() = New Byte(If(HeuristicSampleSize > InputFileStream.Length, InputFileStream.Length, HeuristicSampleSize) - 1) {}
181
182             Call Array.Copy(bomBytes, sampleBytes, bomBytes.Length)
183
184             If InputFileStream.Length > bomBytes.Length Then
185                 InputFileStream.Read(sampleBytes, bomBytes.Length, sampleBytes.Length - bomBytes.Length)
186             End If
187
188             InputFileStream.Position = originalPos
189
190             'test byte array content
191             encodingFound = DetectUnicodeInByteSampleByHeuristics(sampleBytes)
192
193             If encodingFound IsNot Nothing Then
194                 Return encodingFound
195             Else
196                 Return DefaultEncoding
197             End If
198         End Function
199
200         Public Function DetectTextByteArrayEncoding(TextData As Byte(), DefaultEncoding As Encoding) As Encoding
201             If TextData Is Nothing Then
202                 Throw New ArgumentNullException("Must provide a valid text data byte array!""TextData")
203             End If
204
205             Dim encodingFound As Encoding = DetectBOMBytes(TextData)
206
207             If encodingFound IsNot Nothing Then
208                 Return encodingFound
209             Else
210                 'test byte array content
211                 encodingFound = DetectUnicodeInByteSampleByHeuristics(TextData)
212
213                 If encodingFound IsNot Nothing Then
214                     Return encodingFound
215                 Else
216                     Return DefaultEncoding
217                 End If
218             End If
219
220         End Function
221
222         Public Function DetectBOMBytes(BOMBytes As Byte()) As Encoding
223             If BOMBytes Is Nothing Then
224                 Throw New ArgumentNullException("Must provide a valid BOM byte array!""BOMBytes")
225             End If
226
227             If BOMBytes.Length < 2 Then
228                 Return Nothing
229             End If
230
231             If BOMBytes(0) = &HFF AndAlso BOMBytes(1) = &HFE AndAlso (BOMBytes.Length < 4 OrElse BOMBytes(2) <> 0 OrElse BOMBytes(3) <> 0) Then
232                 Return Encoding.Unicode
233             End If
234
235             If BOMBytes(0) = &HFE AndAlso BOMBytes(1) = &HFF Then
236                 Return Encoding.BigEndianUnicode
237             End If
238
239             If BOMBytes.Length < 3 Then
240                 Return Nothing
241             End If
242
243             If BOMBytes(0) = &HEF AndAlso BOMBytes(1) = &HBB AndAlso BOMBytes(2) = &HBF Then
244                 Return Encoding.UTF8
245             End If
246
247             If BOMBytes(0) = &H2B AndAlso BOMBytes(1) = &H2F AndAlso BOMBytes(2) = &H76 Then
248                 Return Encoding.UTF7
249             End If
250
251             If BOMBytes.Length < 4 Then
252                 Return Nothing
253             End If
254
255             If BOMBytes(0) = &HFF AndAlso BOMBytes(1) = &HFE AndAlso BOMBytes(2) = 0 AndAlso BOMBytes(3) = 0 Then
256                 Return Encoding.UTF32
257             End If
258
259             If BOMBytes(0) = 0 AndAlso BOMBytes(1) = 0 AndAlso BOMBytes(2) = &HFE AndAlso BOMBytes(3) = &HFF Then
260                 Return Encoding.GetEncoding(12001)
261             End If
262
263             Return Nothing
264         End Function
265
266         Public Function DetectUnicodeInByteSampleByHeuristics(SampleBytes As Byte()) As Encoding
267             Dim oddBinaryNullsInSample As Long = 0
268             Dim evenBinaryNullsInSample As Long = 0
269             Dim suspiciousUTF8SequenceCount As Long = 0
270             Dim suspiciousUTF8BytesTotal As Long = 0
271             Dim likelyUSASCIIBytesInSample As Long = 0
272
273             'Cycle through, keeping count of binary null positions, possible UTF-8
274             ' sequences from upper ranges of Windows-1252, and probable US-ASCII
275             ' character counts.
276
277             Dim currentPos As Long = 0
278             Dim skipUTF8Bytes As Integer = 0
279
280             While currentPos < SampleBytes.Length
281                 'binary null distribution
282                 If SampleBytes(currentPos) = 0 Then
283                     If currentPos Mod 2 = 0 Then
284                         evenBinaryNullsInSample += 1
285                     Else
286                         oddBinaryNullsInSample += 1
287                     End If
288                 End If
289
290                 'likely US-ASCII characters
291                 If IsCommonUSASCIIByte(SampleBytes(currentPos)) Then
292                     likelyUSASCIIBytesInSample += 1
293                 End If
294
295                 'suspicious sequences (look like UTF-8)
296                 If skipUTF8Bytes = 0 Then
297                     Dim lengthFound As Integer = DetectSuspiciousUTF8SequenceLength(SampleBytes, currentPos)
298
299                     If lengthFound > 0 Then
300                         suspiciousUTF8SequenceCount += 1
301                         suspiciousUTF8BytesTotal += lengthFound
302                         skipUTF8Bytes = lengthFound - 1
303                     End If
304                 Else
305                     skipUTF8Bytes -= 1
306                 End If
307
308                 currentPos += 1
309             End While
310
311             '1: UTF-16 LE - in english / european environments, this is usually characterized by a
312             ' high proportion of odd binary nulls (starting at 0), with (as this is text) a low
313             ' proportion of even binary nulls.
314             ' The thresholds here used (less than 20% nulls where you expect non-nulls, and more than
315             ' 60% nulls where you do expect nulls) are completely arbitrary.
316
317             If ((evenBinaryNullsInSample * 2.0) / SampleBytes.Length) < 0.2 AndAlso ((oddBinaryNullsInSample * 2.0) / SampleBytes.Length) > 0.6 Then
318                 Return Encoding.Unicode
319             End If
320
321             '2: UTF-16 BE - in english / european environments, this is usually characterized by a
322             ' high proportion of even binary nulls (starting at 0), with (as this is text) a low
323             ' proportion of odd binary nulls.
324             ' The thresholds here used (less than 20% nulls where you expect non-nulls, and more than
325             ' 60% nulls where you do expect nulls) are completely arbitrary.
326
327             If ((oddBinaryNullsInSample * 2.0) / SampleBytes.Length) < 0.2 AndAlso ((evenBinaryNullsInSample * 2.0) / SampleBytes.Length) > 0.6 Then
328                 Return Encoding.BigEndianUnicode
329             End If
330
331             '3: UTF-8 - Martin Dürst outlines a method for detecting whether something CAN be UTF-8 content
332             ' using regexp, in his w3c.org unicode FAQ entry:
333             ' http://www.w3.org/International/questions/qa-forms-utf-8
334             ' adapted here for C#.
335             Dim potentiallyMangledString As String = Encoding.ASCII.GetString(SampleBytes)
336             Dim UTF8Validator As New Regex("\A(" & "[\x09\x0A\x0D\x20-\x7E]" & "|[\xC2-\xDF][\x80-\xBF]" & "|\xE0[\xA0-\xBF][\x80-\xBF]" & "|[\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}" & "|\xED[\x80-\x9F][\x80-\xBF]" & "|\xF0[\x90-\xBF][\x80-\xBF]{2}" & "|[\xF1-\xF3][\x80-\xBF]{3}" & "|\xF4[\x80-\x8F][\x80-\xBF]{2}" & ")*\z")
337
338             If UTF8Validator.IsMatch(potentiallyMangledString) Then
339                 'Unfortunately, just the fact that it CAN be UTF-8 doesn't tell you much about probabilities.
340                 'If all the characters are in the 0-127 range, no harm done, most western charsets are same as UTF-8 in these ranges.
341                 'If some of the characters were in the upper range (western accented characters), however, they would likely be mangled to 2-byte by the UTF-8 encoding process.
342                 ' So, we need to play stats.
343
344                 ' The "Random" likelihood of any pair of randomly generated characters being one
345                 ' of these "suspicious" character sequences is:
346                 ' 128 / (256 * 256) = 0.2%.
347                 '
348                 In western text data, that is SIGNIFICANTLY reduced - most text data stays in the <127
349                 ' character range, so we assume that more than 1 in 500,000 of these character
350                 ' sequences indicates UTF-8. The number 500,000 is completely arbitrary - so sue me.
351                 '
352                 ' We can only assume these character sequences will be rare if we ALSO assume that this
353                 ' IS in fact western text - in which case the bulk of the UTF-8 encoded data (that is
354                 ' not already suspicious sequences) should be plain US-ASCII bytes. This, I
355                 ' arbitrarily decided, should be 80% (a random distribution, eg binary data, would yield
356                 ' approx 40%, so the chances of hitting this threshold by accident in random data are
357                 ' VERY low).
358
359                 'suspicious sequences
360                 'all suspicious, so cannot evaluate proportion of US-Ascii
361                 If (suspiciousUTF8SequenceCount * 500000.0 / SampleBytes.Length >= 1) AndAlso (SampleBytes.Length - suspiciousUTF8BytesTotal = 0 OrElse likelyUSASCIIBytesInSample * 1.0 / (SampleBytes.Length - suspiciousUTF8BytesTotal) >= 0.8) Then
362                     Return Encoding.UTF8
363                 End If
364             End If
365
366             Return Nothing
367         End Function
368
369         Private Function IsCommonUSASCIIByte(testByte As ByteAs Boolean
370             'lf
371             'cr
372             'tab
373             'common punctuation
374             'digits
375             'common punctuation
376             'capital letters
377             'common punctuation
378             'lowercase letters
379             If testByte = &HA OrElse testByte = &HD OrElse testByte = &H9 OrElse (testByte >= &H20 AndAlso testByte <= &H2F) OrElse (testByte >= &H30 AndAlso testByte <= &H39) OrElse (testByte >= &H3A AndAlso testByte <= &H40) OrElse (testByte >= &H41 AndAlso testByte <= &H5A) OrElse (testByte >= &H5B AndAlso testByte <= &H60) OrElse (testByte >= &H61 AndAlso testByte <= &H7A) OrElse (testByte >= &H7B AndAlso testByte <= &H7E) Then
380                 'common punctuation
381                 Return True
382             Else
383                 Return False
384             End If
385         End Function
386
387         Private Function DetectSuspiciousUTF8SequenceLength(SampleBytes As Byte(), currentPos As LongAs Integer
388             Dim lengthFound As Integer = 0
389
390             If SampleBytes.Length >= currentPos + 1 AndAlso SampleBytes(currentPos) = &HC2 Then
391                 If SampleBytes(currentPos + 1) = &H81 OrElse SampleBytes(currentPos + 1) = &H8D OrElse SampleBytes(currentPos + 1) = &H8F Then
392                     lengthFound = 2
393                 ElseIf SampleBytes(currentPos + 1) = &H90 OrElse SampleBytes(currentPos + 1) = &H9D Then
394                     lengthFound = 2
395                 ElseIf SampleBytes(currentPos + 1) >= &HA0 AndAlso SampleBytes(currentPos + 1) <= &HBF Then
396                     lengthFound = 2
397                 End If
398             ElseIf SampleBytes.Length >= currentPos + 1 AndAlso SampleBytes(currentPos) = &HC3 Then
399                 If SampleBytes(currentPos + 1) >= &H80 AndAlso SampleBytes(currentPos + 1) <= &HBF Then
400                     lengthFound = 2
401                 End If
402             ElseIf SampleBytes.Length >= currentPos + 1 AndAlso SampleBytes(currentPos) = &HC5 Then
403                 If SampleBytes(currentPos + 1) = &H92 OrElse SampleBytes(currentPos + 1) = &H93 Then
404                     lengthFound = 2
405                 ElseIf SampleBytes(currentPos + 1) = &HA0 OrElse SampleBytes(currentPos + 1) = &HA1 Then
406                     lengthFound = 2
407                 ElseIf SampleBytes(currentPos + 1) = &HB8 OrElse SampleBytes(currentPos + 1) = &HBD OrElse SampleBytes(currentPos + 1) = &HBE Then
408                     lengthFound = 2
409                 End If
410             ElseIf SampleBytes.Length >= currentPos + 1 AndAlso SampleBytes(currentPos) = &HC6 Then
411                 If SampleBytes(currentPos + 1) = &H92 Then
412                     lengthFound = 2
413                 End If
414             ElseIf SampleBytes.Length >= currentPos + 1 AndAlso SampleBytes(currentPos) = &HCB Then
415                 If SampleBytes(currentPos + 1) = &H86 OrElse SampleBytes(currentPos + 1) = &H9C Then
416                     lengthFound = 2
417                 End If
418             ElseIf SampleBytes.Length >= currentPos + 2 AndAlso SampleBytes(currentPos) = &HE2 Then
419                 If SampleBytes(currentPos + 1) = &H80 Then
420                     If SampleBytes(currentPos + 2) = &H93 OrElse SampleBytes(currentPos + 2) = &H94 Then
421                         lengthFound = 3
422                     End If
423                     If SampleBytes(currentPos + 2) = &H98 OrElse SampleBytes(currentPos + 2) = &H99 OrElse SampleBytes(currentPos + 2) = &H9A Then
424                         lengthFound = 3
425                     End If
426                     If SampleBytes(currentPos + 2) = &H9C OrElse SampleBytes(currentPos + 2) = &H9D OrElse SampleBytes(currentPos + 2) = &H9E Then
427                         lengthFound = 3
428                     End If
429                     If SampleBytes(currentPos + 2) = &HA0 OrElse SampleBytes(currentPos + 2) = &HA1 OrElse SampleBytes(currentPos + 2) = &HA2 Then
430                         lengthFound = 3
431                     End If
432                     If SampleBytes(currentPos + 2) = &HA6 Then
433                         lengthFound = 3
434                     End If
435                     If SampleBytes(currentPos + 2) = &HB0 Then
436                         lengthFound = 3
437                     End If
438                     If SampleBytes(currentPos + 2) = &HB9 OrElse SampleBytes(currentPos + 2) = &HBA Then
439                         lengthFound = 3
440                     End If
441                 ElseIf SampleBytes(currentPos + 1) = &H82 AndAlso SampleBytes(currentPos + 2) = &HAC Then
442                     lengthFound = 3
443                 ElseIf SampleBytes(currentPos + 1) = &H84 AndAlso SampleBytes(currentPos + 2) = &HA2 Then
444                     lengthFound = 3
445                 End If
446             End If
447
448             Return lengthFound
449         End Function
450     End Module
451 End Namespace