Отправляет email-рассылки с помощью сервиса Sendsay

Программирование и готовые решения

Подписаться Бесплатная «Серебряная» новостная рассылка . Подписчиков 5.409 RSS
←   Март 2002   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://blog.leadersoft.ru
Открыта: 29-08-2000

Автор
leadersoft.ru

Статистика

5.409 подписчиков
0 за неделю
←   Все выпуски   →

Access 2000 - программирование и готовые решения


Служба Рассылок Subscribe.Ru

Выпуск 36. Структура и чтение DBF файлов

Подписка: "Access 2000 - программирование и готовые решения"
Автор:       Виктор Конюков, Leader Access, LTD
Дата:         29.03.2002
Сайт:         http://www.leadersoft.ru
Почта:       support@leadersoft.ru
  Новости
    29.03.2002. Вышла рассылка для специалистов "Профессионально об Access". Разосланы подписчикам образцы договора на разработку базы данных и техническое задание с примерами интерфейса.
    19.03.2002. Добавилась визитка профессионального разработчика баз данных Microsoft Access: Kapitulsky Alexander.
Статья:  Структура и чтение DBF файлов
Пример:  http://www.leadersoft.ru/subscribe/zip/la_convert.mdb
   DBF файл (dbase) один из самых популярных форматов баз данных. Связано это с тем, что он самый "древний" из баз данных. Первые его версии появились аж в 1983 году. Конечно, за такой длительный срок существования было разработано много разных баз данных, и  постоянно встречаются dbf файлы из которых необходимо "вытащить" информацию.
    Форматы файлов разделяются на версии  II, III, IV и т.п. При этом надо отметить, что "значительных" отличий от версии к версии нет. Таким образом, достаточно изучить методы чтения одного типа файлов и уже далее легко можно доработать программу под другие форматы.
    Зачем это нужно. Иногда, работая с базой данных после присоединения таблиц, драйвер возвращает неправильные текстовые данные (нарушена кодировка символов). Возможен вариант, когда Вам необходимо считать memo поля, а Access не позволяет это сделать. Поэтому, чтобы себя свободно чувствовать в этой области, надо изучить и загрузку данных без dbf драйверов.
    Вся статья разбита на 3 части, где сначала идет описание dbf файла IV версии, а далее описание dbf функций, а потом их применение в VBA.
Структура файла. 
    Каждый файл состоит из трех частей: заголовка, описания записей и собственно данных. Ниже представлено короткое описание каждого из разделов.
I. Описание заголовка
Смещение Длина в байтах Содержание
0 1 Номер версии dBase 
Биты 0-2 - dBase версия (03H для версий III и IV)
Бит 3 - индикатор полей памяти
Биты 4-6 - зарезервированы для SQL
Бит 7 - Признак наличия DBT файлов dbase III+
1 3 Дата последнего изменения (в формате ГГММДД)
4 4 Количество записей в базе данных
8 2 Длина заголовочной записи в байтах
10 2 Длина записи данных в байтах
12 2  Резервные
14 1  Признак пересылок
15 1  Признак кодирования ( 1-данные закодированы)
16 12  Зарезервированы для сетевой версии
28 1  Признак наличия/отсутствия мультииндексных файлов 01Н - имеется MDX файл, 00H - отсутствует MDX файл
29 3  Резервные
32 32*N  Описание N полей записи данных (по 32 байта на каждое поле)
32+32*N+1 1  Признак конца заголовочной записи (0DH)
 
   
II. Описание полей в Dbase IV (Всего не более 255 полей)
Смещение Длина в байтах Содержание
0 11  Имя поля в ASCII - кодах. Пустые места = 00H
11 1  Тип поля в ASCII - кодах (С, N, F, L, D, M)
C - символьный (ASCII символы)
N - 1 числовой (0...9)
F - 2 числовой (0...9)
L - Логический (YyNnTtFf)
D - Дата (ГГММДД)
M - заметки, номер блока DBT файла
12 4  Адрес поля в памяти (для внутреннего использования dbase)
16 1  Длина поля в байтах (не более 255 символов)
17 1  Количество знаков после десятичной точки в байтах для числовых полей, иначе 0
18 2  Зарезервировано для многопользовательских систем 
20 1  Идентификатор рабочей области
21 2  Зарезервировано для многопользовательских систем
23 1  Используется программой SET FIELDS
24 8  Зарезервировано
 
 
III. Данные в базе данных
Смещение Длина в байтах Содержание
0 1  Байт, содержащий отметку об удалении записи. Если запись удалена он равен *, иначе " " (blank)
1 Сумма длин полей  Запись хранится в виде строки ASCII символов без разделяющих знаков
 1AH - конец действительной области данных

Комментарии.
    Помните, что записи в базе данных не удаляются, а помечаются символом звездочки. Таким образом, даже удалив их они не уничтожаются, а только отмечаются "флажками" как удаленные. Поэтому если Вы желаете, чтобы в базе данных не было лишней информации, ее необходимо сжимать, а еще лучше, создавать новую базу данных и импортировать туда все объекты старой базы. Это будет верно для Access и других профессиональных баз данных.
 
Функции чтения DBF файла
    Данный пример взят из файла la_convert.mdb. Сохраните код в любом текстовом файле, а потом импортируйте его в свой модуль из редактора VBA.
' Start-->
Attribute VB_Name = "basDbfConverter"
Option Compare Database
Option Explicit
'***************************************************************
' Подписка: "Access 2000 - программирование и готовые решения"
' Тема: Работа с внешним dbf файлом версии III или IV
' Версия: 1 от 26.03.2002
' Автор: Copyright © LeaderAccess, LTD
' Сайт: http://www.leadersoft.ru
' Почта: support@leadersoft.ru
' Примечание: Ссылка на автора и программу обязательна!
'
Const alfaWin As String = "абвгдеёжзийклмнопрстуфхцчшщьэъюяАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЬЭЪЮЯ№ыЫ"
Const alfaDos As String = " ЎўЈ¤Ґс¦§Ё©Є«¬­®ЇабвгдежзиймнкопЂЃ‚ѓ„…р†‡€‰Љ‹ЊЌЋЏђ‘’“”∙–—™њќљћџьл›"

' Заголовок, прочитанный в буфер
Public Type dbfBufHeader
buf As String * 4 ' Номер версии и дата
RecordCount As Long ' Число записей
HeaderLength As Integer ' Длина заголовка
RecordLength As Integer ' Длина записи
End Type

' Характеристика поля базы данных
Public Type dbfFields
Name As String ' Название поля
Type As String ' Тип поля
Length As Integer ' Длина поля
Dec As Integer ' Число знаков после запятой
End Type

' Данные по записи
Public Type dbfRecord
Mark As String ' 1 байт. Флаг маркировки: * - удалена или " "
Data() As String ' Данные всех полей
End Type

' Полная информация по заголовку
Public Type dbfHeader
VersionNumber As Integer ' Номер версии
LastUpdate As Date ' Дата последнего обновления
HeaderLength As Integer ' Длина заголовка
RecordCount As Long ' Число записей
RecordLength As Integer ' Длина записи
NumberFields As Integer ' Число полей
FileSize As Long ' Размер файла
PathDBF As String ' Имя файла
PathDBT As String ' Имя файла
TableAccess As String ' Таблица в Mdb файле
Fields() As dbfFields ' Данные по полям
Record As dbfRecord ' Информация по 1 записи
DBF As Integer ' Указатель на DBF файл
DBT As Integer ' Указатель на MEMO файл
End Type

'==============================================================
' Прочитать данные о заголовке dbf файла
' и сохранить данные в структуре hDbf
'
Function dbfReadHeader(hDbf As dbfHeader, strPath As String, strTableAccess As String) As Long
Dim bufHdr As dbfBufHeader ' Заголовок - буфер
hDbf.DBF = FreeFile() ' Создаем указатель
With hDbf
Open strPath For Binary As #.DBF
Get #.DBF, , bufHdr ' Читаем заголовок
.PathDBF = strPath
.TableAccess = strTableAccess
.VersionNumber = Asc(Left$(bufHdr.buf, 1)) And (7) ' Номер версии
.LastUpdate = dbfReadDate(Mid$(bufHdr.buf, 2, 3)) ' Дата
.RecordCount = bufHdr.RecordCount ' Число записей
.HeaderLength = bufHdr.HeaderLength ' Длина заголовка
.RecordLength = bufHdr.RecordLength ' Длина записи
.NumberFields = (hDbf.HeaderLength - 33) / 32 ' Число полей
.FileSize = 1 + .HeaderLength + .RecordLength * .RecordCount ' Длина файла

' Проверка версии
If .VersionNumber <> 3 Then
dbfReadHeader = -1 ' Это не DBase Файл
Exit Function
End If

' Проверка числа записей
If .RecordCount = 0 Then
dbfReadHeader = -2 ' Нет записей
Exit Function
End If

' Меняем в заголовке число полей
ReDim .Fields(.NumberFields - 1)
' Выделяем память для данных 1 записи
ReDim .Record.Data(.NumberFields - 1)
End With

' Нет ошибок
dbfReadHeader = 0
End Function

'==============================================================
' Цель. Прочитать данные из заголовка
' о полях: Имя, Тип, Длина, Дес. точка
'
Function dbfReadNameFields(hDbf As dbfHeader) As Long
Dim i As Long, buf As String, hEof As String
With hDbf
Seek #.DBF, 33 ' Устанавливаем позицию
buf = Space$(32) ' Выделяем память
For i = 0 To .NumberFields - 1
Get #.DBF, , buf ' Читаем строку длиной 32 байта
.Fields(i).Name = Trim(dbfTrimString(Left$(buf, 11), 11))
.Fields(i).Type = Mid$(buf, 12, 1)
.Fields(i).Length = Asc(Mid$(buf, 17, 1))
.Fields(i).Dec = Asc(Mid$(buf, 18, 1))
Next i
hEof = Input$(1, #.DBF) ' Конец заголовка
If Asc(hEof) <> 13 Then
dbfReadNameFields = False ' Плохой заголовок
Else
dbfReadNameFields = True ' Правильная структура
End If
End With
End Function

'==============================================================
' Сохраняем данные о полях в таблице
'
Function dbfSaveNameFields(hDbf As dbfHeader) As Long
Dim i As Long, s As String
Dim dbs As DAO.Database, tdf As DAO.TableDef

With hDbf
' Удаляем ненужную таблицу
On Error Resume Next
DoCmd.DeleteObject acTable, .TableAccess
Err.Clear

' Создаем поля
Set dbs = CurrentDb
Set tdf = dbs.CreateTableDef(.TableAccess) 'Создаем таблицу
For i = 0 To .NumberFields - 1
s = .Fields(i).Name
Select Case .Fields(i).Type
Case "C": tdf.Fields.Append tdf.CreateField(s, dbText, hDbf.Fields(i).Length)
Case "D": tdf.Fields.Append tdf.CreateField(s, dbDate)
Case "F": tdf.Fields.Append tdf.CreateField(s, dbFloat)
Case "M": tdf.Fields.Append tdf.CreateField(s, dbMemo)
Case "L": tdf.Fields.Append tdf.CreateField(s, dbBoolean)
Case "N": tdf.Fields.Append tdf.CreateField(s, dbDouble)
End Select
Next i
End With
dbs.TableDefs.Append tdf 'Добавляем таблицу
End Function

'==============================================================
' Прочитаем 1 запись в базу данных
'
Sub dbfReadRecord(hDbf As dbfHeader, NumRec As Long)
Dim buf As String, pos As Long, i As Long
Dim ss As String, p As Long

With hDbf
' Выделяем память
buf = Space$(.RecordLength)
' Находим позицию
Seek #.DBF, 1 + .HeaderLength + (NumRec - 1) * .RecordLength
' Читаем запись
Get #.DBF, , buf
' Чтение метки удаления "*" и " "
.Record.Mark = Left(buf, 1)
' Установка позиции
pos = 2
' Разбор данных
For i = 0 To .NumberFields - 1
' Выбор полей
ss = Mid(buf, pos, .Fields(i).Length)
ss = dbfTrimString(ss, CLng(.Fields(i).Length))

' Настройка некоторых полей
Select Case hDbf.Fields(i).Type
Case "D" ' dd/mm/yyyy
ss = Right$(ss, 2) + "/" + Mid$(ss, 5, 2) + "/" + Left$(ss, 4)
Case "L" ' Логическое поле T,Y или F,N
Select Case UCase$(ss)
Case "Y", "T": ss = "True"
Case "N", "F": ss = "False"
Case Else: ss = "?"
End Select
Case Else
End Select
' Назначаем данные
.Record.Data(i) = ss
' Определяем позицию следующего поля
pos = pos + .Fields(i).Length
Next i
End With
End Sub

'==============================================================
' Сохраняем данные 1 записи в таблице
'
Function dbfSaveRecord(hDbf As dbfHeader) As Long
Dim i As Long, p As Long, dbs As Database, rst As DAO.Recordset, buf As String, sn As String
On Error GoTo 999
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(hDbf.TableAccess)
With hDbf
rst.AddNew
For i = 0 To .NumberFields - 1
buf = .Record.Data(i) ' Nz(Trim(.Record.Data(i)), " ")
sn = .Fields(i).Name
Select Case .Fields(i).Type
Case "C": rst(sn).Value = CStr(buf)
Case "D": rst(sn).Value = CDate(buf)
Case "M": rst(sn).Value = buf
Case "L": rst(sn).Value = CBool(buf)
Case "N", "F":
p = InStr(buf, ".")
If p Then buf = Left(buf, p - 1) & "," & Mid(buf, p + 1)
rst(sn).Value = CDbl(buf)
End Select
Next i
rst.Update
End With
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function
999:
Err.Clear
Resume Next
End Function

'==============================================================
' Программа для конвертации строки из Dos в Windows и наоборот
'
Public Function dbfReadDate(buf As String) As Date
On Error Resume Next
dbfReadDate = DateValue( _
1900 + Asc(Mid$(buf, 1, 1)) & "/" & _
Asc(Mid$(buf, 2, 1)) & "/" & _
Asc(Mid$(buf, 3, 1)))
Err.Clear
End Function

'==============================================================
' Программа для конвертации строки из Dos в Windows и наоборот
'
Public Function dbfStrConv(strData As String, buf1 As String, buf2 As String) As String
Dim i As Long, strChar As String, p As Long

' Конвертирование строки
dbfStrConv = ""
For i = 1 To Len(strData)
strChar = Mid(strData, i, 1)
p = InStr(1, buf1, strChar)
If p > 0 Then
dbfStrConv = dbfStrConv & Mid(buf2, p, 1)
Else
dbfStrConv = dbfStrConv & strChar
End If
Next
End Function

'==============================================================
' Обрезаем ненужные данные из строки dbf
'
Public Function dbfTrimString(strData As String, lngData As Long) As String
Dim p1 As Long, p2 As Long
' Конвертируем строку из Dos в Windows
strData = dbfStrConv(strData, alfaDos, alfaWin)
' Определяем пустые данные
For p1 = 1 To lngData
If Asc(Mid(strData, p1, 1)) >= 32 Then Exit For
Next
For p2 = p1 To lngData
If Asc(Mid(strData, p2, 1)) < 32 Then Exit For
Next
dbfTrimString = Mid(strData, p1, p2 - p1)
End Function
'<--End
 
Применение DBF функций
    Выше были описаны функции для чтения dbf файла. Ниже приводится код для работы с dbase файлом. Программу можно привязать для кнопки butRead в вашей форме.
' Start-->
'==============================================================
' Читаем DBF файл и его данные
Private Sub butRead_Click()
Dim i As Long
Dim hDbf As dbfHeader ' Заголовок

' Чтение заголовка
i = dbfReadHeader(hDbf, Me.strPath, "dbfTable")
If i < 0 Then
Select Case i
Case -1: MsgBox "Неправильная версия файла", vbCritical, "Не Dbase файл"
Case -2: MsgBox "Нет записей в файле", vbCritical, "Dbase файл"
End Select
Exit Sub
End If

' Чтение/сохранение полей
If dbfReadNameFields(hDbf) = True Then
dbfSaveNameFields hDbf
Else
MsgBox "Плохой заголовок", vbCritical, "Dbase файл"
End If

' Чтение/Сохрание записи
For i = 1 To hDbf.RecordCount
dbfReadRecord hDbf, i ' Читаем запись
dbfSaveRecord hDbf ' Сохраняем прочитанную запись
Next

' Закрытие файла
If hDbf.DBF > 0 Then Close #hDbf.DBF

' Вывод информации в форме
dbfPrintHeader hDbf
End Sub
' <--End
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное