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