Хочу внести некоторые дополнения... 1. Драйвер при чтении из файла воспринимает как разделитель строк не только vbCrLf, но и vbCr, и vbLf. И это радует . Но при записи в файл всегда используется vbCrLf.
2. Драйвер умеет работать с файлами в кодировке Unicode. Эта кодировка имеет несколько форматов, в частности: UTF-16LE (основной), UTF-16BE (старший байт в паре стоит первым), UTF-8. Каждый из этих форматов может иметь свой признак (Byte Order Mark или BOM). Это 2-3 байта с определенными значениями в начале файла. Его наличие желательно, т.к. однозначно указывает на формат текста в Unicode. Указав "Юникод" в спецификации Access или CharacterSet=Unicode в файле Schema.ini, можно работать с файлами в формате UTF-16LE. В спецификации Access можно указать и другой формат ("Юникод (Big-Endian)" и "Юникод (UTF-8)"). В Schema.ini это выглядит так:
CharacterSet=Unicode или 1200 - UTF-16LE
CharacterSet=1201 - UTF-16BE
CharacterSet=65001 - UTF-8
Но здесь есть несколько замечаний: а) При чтении из UTF-16LE драйвер "культурно" анализирует BOM и не включает его возвращаемые данные. При создании файла BOM добавляется. В других форматах при создании файла BOM не добавляется, а при чтении включается в имя или значение первого поля. б) Если в читаемом файле BOM отсутствует, то драйвер "думает", что это UTF-16LE (Блокнот, кстати - тоже). Это противоречит правилу в стандарте Unicode, что файл без BOM должен быть в формате UTF-16BE.
3. В статье, в примерах прямого доступа к файлам, наличие BOM не учтено. При создании файла без BOM внешняя программа может и не прочитать его, поэтому пример записи в файл желательно изменить:
'СОЗДАНИЕ ФАЙЛА С UNICODE
f = FreeFile: Open "C:\Файл U.txt" For Binary As f
'Преобразование строки в массив и запись массива выполняется "как есть".
bytArr = "Строка1" & vbCrLf & "Строка2" & vbCrLf & "Строка3" & vbCrLf
Put f, , CByte(&HFF)
Put f, , CByte(&HFE)
Put f, , bytArr
Close f
Вместо функции ReadTextFile предлагаю функцию, которая умеет читать файлы UTF-16LE, UTF-16BE и UTF-8, с BOM и без него. Также предлагаю функцию создания файла в UTF-8.
Function ReadAnyTextFile(sFilePath$, Optional fGetRowsArray As Boolean) As Variant
'Функция читает файлы в формате:
' Обычный (ANSI/OEM и т.п. с однобайтовой кодировкой)
' Unicode (UTF-16 LE, UTF-16 BE)
' UTF-8
'Формат файла определяется по маркеру BOM (первые 2-3 байта в начале файла)
' или анализом.
'Лишние завершающие символы vbCr и/или vbLf исключаются.
'Если fGetRowsArray=0, возвращает содержимое файла.
'Если fGetRowsArray=1, возвращает массив строк (разделитель vbCrLf, vbCr или vbLf).
On Error Resume Next
Dim i&, j&, k%, s$, arr() As Byte, iUtf8%, iUtf16%
i = FreeFile: Open sFilePath$ For Binary Access Read Shared As i
If Err.Number <> 0 Then Err.Clear: Exit Function
j = LOF(i): If j = 0 Then Close i: GoTo Finish
If j >= 4 Then
ReDim arr(1 To 4): Get i, , arr
'Проверяется наличие признака кодировки (первые 2-3 байта).
If arr(1) = &HFF And arr(2) = &HFE And arr(3) <> 0 Then
'Есть признак Unicode(UTF-16 LE). Читаем с 3-го байта.
k = 2: iUtf16 = 1
ElseIf arr(1) = &HFE And arr(2) = &HFF And arr(4) <> 0 Then
'Есть признак Unicode(UTF-16 BE). Читаем с 3-го байта.
k = 2: iUtf16 = 2
ElseIf arr(1) = &HEF And arr(2) = &HBB And arr(3) = &HBF Then
'Есть признак UTF-8. Читаем с 4-го байта.
k = 3: iUtf8 = 1
End If
End If
j = j - k: ReDim arr(1 To j): Get i, 1 + k, arr
Close i
If iUtf16 = 0 And iUtf8 = 0 And (UBound(arr) Mod 2) = 0 Then
'Проверка Unicode. Контролируется значение старшего байта в первом и последнем символе.
'Этого достаточно, если эти символы не "№" и не специальные знаки
' (например - математические или химические).
If arr(2) <= 5 And arr(UBound(arr)) <= 5 Then
iUtf16 = 1
ElseIf arr(1) <= 5 And arr(UBound(arr) - 1) <= 5 Then
iUtf16 = 2
End If
End If
If iUtf16 = 2 Then
'Для UTF-16 BE в цикле меняем местами парные байты.
For i = 1 To j - 1 Step 2
k = arr(i): arr(i) = arr(i + 1): arr(i + 1) = k
Next
End If
If iUtf16 > 0 Then s = arr: GoTo Finish
'Проверка UTF-8
For i = 1 To j - 1
Select Case arr(i)
Case Is <= 127
Case &HC2 To &HDF
'В UTF-8 после байта с таким кодом должен стоять байт с кодом &H80-&HBF
If arr(i + 1) < &H80 Or arr(i + 1) > &HBF Then iUtf8 = 0: Exit For
iUtf8 = 3: i = i + 1
Case &HE0 To &HFF
'В UTF-8 после байта с таким кодом должны стоять 2 байта с кодом &H80-&HBF
If i = j - 1 Then iUtf8 = False: Exit For
If arr(i + 1) < &H80 Or arr(i + 1) > &HBF Then iUtf8 = 0: Exit For
If arr(i + 2) < &H80 Or arr(i + 2) > &HBF Then iUtf8 = 0: Exit For
iUtf8 = 3: i = i + 2
Case Else
iUtf8 = 0: Exit For
End Select
Next
'Если в массиве найдены недопустимые для UTF-8 коды или все коды <=127
If iUtf8 < 3 Then s = StrConv(arr, vbUnicode): GoTo Finish
'Преобразование UTF-8 -> Unicode
For i = 1 To j
'Переменная "k" (код символа) - Integer (2 байта или 16 битов с весом 0-15)
Select Case arr(i)
Case Is <= 127
k = arr(i)
Case &HC2 To &HDF
'6 младших битов 2-го байта переносятся в код с тем же весом (0-5)
k = (arr(i + 1) And &H3F)
'5 младших битов 1-го байта переносятся в код с весом 6-10
k = k + (arr(i) And &H1F) * &H40 'Биты смещаются на 6 позиций влево.
i = i + 1
Case &HE0 To &HFF
'6 младших битов 3-го байта переносятся в код с тем же весом (0-5)
k = (arr(i + 2) And &H3F)
'6 младших битов 2-го байта переносятся в код с весом 6-11
k = k + (arr(i + 1) And &H1F) * &H40 'Биты смещаются на 6 позиций влево.
'4 младших бита 1-го байта переносятся в код с весом 12-15
k = k + (arr(i) And &HF) * &H1000 'Биты смещаются на 12 позиций влево.
i = i + 2
End Select
If k <= 127 Then s = s & Chr(k) Else s = s & ChrW(k)
Next
Finish:
'Исключаются лишние завершающие символы vbCr и/или vbLf
j = Len(s): Erase arr
For i = j To 1 Step -1
k = Asc(Mid$(s, i, 1))
If k <> 13 And k <> 10 Then Exit For
Next
If i < j Then s = Left(s, i)
If Not fGetRowsArray Then ReadAnyTextFile = s: Exit Function
If i <= 1 Then ReadAnyTextFile = Split(s): Exit Function
'Преобразование текста в массив строк.
If InStr(s, vbCrLf) > 0 Then
ReadAnyTextFile = Split(s, vbCrLf)
ElseIf InStr(s, vbLf) > 0 Then
ReadAnyTextFile = Split(s, vbLf)
Else
ReadAnyTextFile = Split(s, vbCr)
End If
End Function
Function CreateFileUTF8(strText As String, strFilePath As String, _
Optional fAppend As Boolean) As Boolean
'Функция создает или дополняет (fAppend=True) файл в формате UTF-8.
'В начало нового файла добавляется признак UTF-8 (3 байта).
'При успешном завершении возвращает True.
'Внимание! Функция не добавляет символ(ы) перевода строки. При необходимости
' они должны быть включены в передаваемый текст.
Dim i&, j&, k&, arr() As Byte
On Error GoTo Func_err
If Len(strText) = 0 Or Len(Trim$(strFilePath)) = 0 Then Exit Function
'Если fAppend=False и файл существует - удаляем.
If Not fAppend Then If Len(Dir$(strFilePath)) Then Kill strFilePath
'Создается массив с запасом 5% от длины текста
ReDim arr(1 To LenB(strText) * 1.05): i = 1
For j = 1 To Len(strText)
'Читаем код символа (Unicode).
k = AscW(Mid$(strText, j, 1))
'При необходимости увеличиваем размер массива
If (UBound(arr) - i) < 3 Then ReDim Preserve arr(1 To UBound(arr) * 1.05 + 3)
If k <= 127 Then
arr(i) = k: i = i + 1
ElseIf k > &H7FF Then
'Формируем значения трех байтов в UTF-8
arr(i) = (k And &HF000) / &H1000 'Биты 12-15 переносятся в биты 0-3 первого байта.
arr(i) = arr(i) Or &HE0 'Добавляется признак 1-го байта (биты 5-7)
arr(i + 1) = (k And &HFC0) / &H40 'Биты 6-11 -> биты 0-5 2-го байта
arr(i + 1) = arr(i + 1) Or &H80 'Добавляется признак 2-го байта (биты 6-7)
arr(i + 2) = (k And &H3F) 'Биты 0-5 -> биты 0-5 3-го байта
arr(i + 2) = arr(i + 2) Or &H80 'Добавляется признак 3-го байта (биты 6-7)
i = i + 3
Else
'Формируем значения двух байтов в UTF-8
arr(i) = (k And &H700) / &H40 'Биты 8-10 -> биты 2-4 1-го байта
arr(i) = arr(i) + (k And &HC0) / &H40 'Биты 6-7 -> биты 0-1 1-го байта
arr(i) = arr(i) Or &HC0 'Добавляется признак 1-го байта (биты 6-7)
arr(i + 1) = (k And &H3F) 'Биты 0-5 -> биты 0-5 2-го байта
arr(i + 1) = arr(i + 1) Or &H80 'Добавляется признак 2-го байта (биты 6-7)
i = i + 2
End If
Next j
'Убираем лишние элементы из массива
If i <= UBound(arr) Then ReDim Preserve arr(1 To i - 1)
'Открываем файл, вычисляем его размер
k = FreeFile: Open strFilePath For Binary As k: j = LOF(k)
If fAppend And j > 0 Then
'Если режим "Добавление" и файл не пустой - добавляем массив в конец файла
Put k, j + 1, arr
Else
'При создании нового файла добавляем массив, начиная с 4-й позиции
Put k, 4, arr
'В первые 3 байта пишем признак UTF-8 (BOM)
ReDim arr(1 To 3): arr(1) = &HEF: arr(2) = &HBB: arr(3) = &HBF
Put k, 1, arr
End If
'Закрываем файл.
Close k: CreateFileUTF8 = True
Func_exit:
Exit Function
Func_err:
MsgBox Err.Description, vbCritical, "Создание файла"
Resume Func_exit
End Function
|