Довольно часто случается, что в программе необходима маленькая база данных
(записей на 50-200, не более). Так что же? Брать mdb-шный файл (что само по себе
"кусаемо" по объемам) плюс привязывать к нему для работы библиотеки ADO (или
DAO). Не слишком ли "жирно" для 50 записей?
В данной статье я хочу показать вариант сохранения базы данных в текстовом
файле. Попутно будет рассмотрено еще несколько вопросов. Итак:
- сохранение БД в файле формата txt, используя объектно-ориентированный
подход к программированию;
- работа с диалоговыми окнами открытия и сохранения файлов через
API-функции и построение собственного класса для этого;
- работа с VB 6 Class Builder Utility
- считывание и запись информации в файлы последовательного доступа,
используя библиотеку FSO (FileSystemObject).
Для тех, кто не желает утруждать себя чтением, может просто скопировать
программку, демонстрирующую все изложенное в данной статье. Всех остальных я
проведу пошагово от начала до конца. В результате получим упрощенный вариант
телефонного справочника.
Шаг 1. Откройте новый проект и
создайте форму, аналогичную, нарисованной ниже.
Текстовые поля называются txtLastName, txtFirstName, txtNumber. Первая
колонка кнопок носит названия cmdDB, с индексами соответственно от 0 до 2;
вторая колонка – cmdEdit (Index = 0 to 2); и наконец кнопки внизу, заведующие
перемещением по записям – cmdMove (Index = 0 to 3). Лейбл-индикатор номера
записи носит имя lblID.
Шаг 2. Для поиска файла можно
использовать стандартный элемент управления CommonDialog. При желании, можно
построить диалоговую форму самому (с помощью стандартных встроенных ЭУ: Dir,
Drive, File). И, наконец, можно использовать API-функции, напрямую обращаясь к
библиотекам Windows. Рассмотрим последнюю возможность, но сделаем специальный
класс для работы с диалоговым окном. Впоследствии Вы сможете многократно
использовать этот класс в различных своих программах.
Здесь нам поможет утилита для создания классов. Выберите меню Add-Ins/Ad-In Manager… и в диалоговом окне отметьте опцию
VB 6 Class Builder Utility. Нажмите ОК. А теперь выберите непосредственно это
меню Add-Ins/Class Builder Utility… Cоздадим новый
класс и назовем его clsCommonDialog. Для этого выберите меню File/New/Class… Замените предлагаемое по-умолчанию имя
Class1 на выбранное нами и подтвердите нажатием на кнопку "ОК". Теперь создадим
свойства для этого класса (меню File/New/Property…).
Все они перечислены ниже в таблице:
| Action |
Integer |
| APIReturn |
Long |
| CancelError |
Boolean |
| DefaultExt |
String |
| DialogTitle |
String |
| ExtendedError |
Long |
| FileName |
String |
| FileTitle |
String |
| Filter |
String |
| FilterIndex |
Integer |
| Flags |
Long |
| hdc |
Long |
| InitDir |
String |
| MaxFileSize |
Long |
И два метода (меню File/New/Method…): ShowOpen и
ShowSave. Оба метода без аргументов.
Закроем утилиту, подтвердив произведенные изменения. И перейдем в только что
созданный класс.
Для работы нам понадобится три API-функции и один Type:
Private m_cancelled As Boolean
'API функция для ShowOpen method
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
'API функция для ShowSave method
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OpenFilename) As Long
'API функция для возвращения расширенной информации об ошибке
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
'Type
Private Type OpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
iFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Для свойств Action, APIReturn и ExtendedError удалим блоки с Property Let –
эти свойства только для чтения.
Теперь займемся методами. И тот и другой
метод у нас опираются на одну и ту же процедуру ShowFileDialog, только с разными
индексами:
Public Sub ShowOpen()
'вывод на экран диалога "Открыть файл"
ShowFileDialog (1)
End Sub
Public Sub ShowSave()
'вывод на экран диалога "Сохранить файл"
ShowFileDialog (2)
End Sub
Вся суть этого класса как раз и заключается в процедуре ShowFileDialog. В ней
происходит передача значений из свойств в объект tOpenFile, для последующего
использования в API-функциях.
Private Sub ShowFileDialog(ByVal iAction As Integer)
Dim tOpenFile As OpenFilename
Dim lMaxSize As Long
Dim sFileNameBuff As String
Dim sFileTitleBuff As String
On Error GoTo ShowFileDialogError
'инициализация буфера
iAction = iAction 'Action property
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
tOpenFile.lStructSize = Len(tOpenFile)
tOpenFile.hwndOwner = lhdc
'Замена "|" на Chr(0)
tOpenFile.lpstrFilter = sAPIFilter(sFilter)
tOpenFile.iFilterIndex = iFilterIndex
'определение размера буфера от свойства MaxFileSize
If lMaxFileSize > 0 Then
lMaxSize = lMaxFileSize
Else
lMaxSize = 255
End If
sFileNameBuff = sFileName
'заполнение пробелами до 255
While Len(sFileNameBuff) < lMaxSize - 1
sFileNameBuff = sFileNameBuff & " "
Wend
'обрежем до длины lMaxFileSize - 1
If lMaxFileSize = 0 Then
sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxSize - 1)
Else
sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxFileSize - 1)
End If
'установим в конце нулевой знак
sFileNameBuff = sFileNameBuff & Chr$(0)
tOpenFile.lpstrFile = sFileNameBuff
If lMaxFileSize <> 255 Then
tOpenFile.nMaxFile = 255
End If
'операции, аналогичные вышеисполненным
sFileTitleBuff = sFileTitle
While Len(sFileTitleBuff) < lMaxSize - 1
sFileTitleBuff = sFileTitleBuff & " "
Wend
If lMaxFileSize = 0 Then
sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxSize -1)
Else
sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxFileSize- 1)
End If
sFileTitleBuff = sFileTitleBuff & Chr$(0)
tOpenFile.lpstrFileTitle = sFileTitleBuff
tOpenFile.lpstrInitialDir = sInitDir
tOpenFile.lpstrTitle = sDialogTitle
tOpenFile.Flags = lFlags
tOpenFile.lpstrDefExt = sDefaultExt
'выполним GetOpenFileName API-функцию
Select Case iAction
Case 1 'ShowOpen
lApiReturn = GetOpenFileName(tOpenFile)
Case 2 'ShowSave
lApiReturn = GetSaveFileName(tOpenFile)
Case Else
Exit Sub
End Select
m_cancelled = False
'Возвращение дескриптора от API-функции GetOpenFileName
Select Case lApiReturn
Case 0 'нажата кнопка Cancel
'генерация ошибки
m_cancelled = True
Exit Sub
Case 1 'пользователь выбрал или ввел файл
'Используем внутреннюю процедуру sLeftOfNull
'для получения пути и имени файла
sFileName = sLeftOfNull(tOpenFile.lpstrFile)
sFileTitle = sLeftOfNull(tOpenFile.lpstrFileTitle)
Case Else 'если произошла ошибка вызываем CommDlgExtendedError
lExtendedError = CommDlgExtendedError
End Select
Exit Sub
ShowFileDialogError:
Exit Sub
End Sub
И теперь еще две вспомогательные функции.
Функция "разбирающая" значение фильтра и заменяющая знак"|" на Chr(0)
Private Function sAPIFilter(sIn)
Dim lChrNdx As Long
Dim sOneChr As String
Dim sOutStr As String
For lChrNdx = 1 To Len(sIn)
sOneChr = Mid$(sIn, lChrNdx, 1)
If sOneChr = "|" Then
sOutStr = sOutStr & Chr$(0)
Else
sOutStr = sOutStr & sOneChr
End If
Next
sOutStr = sOutStr & Chr$(0)
sAPIFilter = sOutStr
End Function
И функция "обрезающая" пробелы в названии пути и имени файла:
Private Function sLeftOfNull(ByVal sIn As String)
Dim lNullPos As Long
sLeftOfNull = sIn
lNullPos = InStr(sIn, Chr$(0))
If lNullPos > 0 Then
sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
End If
End Function
Класс для работы с диалоговым окном "Открытие-Сохранение файла" –
готов.
Шаг 3. Создадим код для кнопки
создания файла. В разделе деклараций объявим класс для работы с диалоговым
окном:
Private dlgDb As New clsCommonDialog
А теперь сам код:
With dlgDb
.DialogTitle = "Создать текстовую БД"
.Filter = "Текстовые БД (*.tdb)|*.tdb"
.FilterIndex = 1
.ShowOpen
End With
Шаг 4. Итак, мы ввели название для
файла, нажали "OK" – теперь необходимо физически создать файл с этими
параметрами. С первой версии VB существуют встроенные функции открытия и
сохранения файлов:
Open pathname For [Input| Output| Append] As filenumber
[Len = buffersize]
Open pathname For [Random] As
filenumber Len = buffersize
Open pathname For
Binary As filenumber
В VB 6.0 появилась новая возможность для этого, а именно модель объекта
файловой системы – File System Object (FSO), о которой мало кто знает. Для того,
чтобы использовать эту библиотеку выберите меню Project/References… В открывшемся диалоговом окне выберите
"Microsoft Scripting Runtime"
Лирическое отступление 1. На данный
момент библиотека может работать (редактировать) только с файлами
последовательного доступа. Будем надеяться, что в VB 7 появится возможность
работать так же и с бинарными файлами и с файлами произвольного
доступа.
В разделе деклараций объявим переменные для работы с этой библиотекой:
Private fso As New FileSystemObject ' "верхний" объект
библиотеки FSO
Private tsOpen As TextStream '
Private tsSave As TextStream 'текстовые потоки библиотеки FSO
Private tsNew As TextStream '
Лирическое отступление 2. Кроме
раннего связвывания FSO можно также создать и поздним связыванием,
например:
Set fso =
CreateObject("Scripting.FileSystemObject")
Преимуществом позднего связывания является то, что
данный синтаксис будет работать не только в Visual Basic, но и в
VBScript.
Лирическое отступление 3. Кроме
выбранных нами FileSystemObject (главного объекта группы, управляющего
дисками, папками и файлами) и TextStream (текстовый поток – позволяющий
создавать, читать и записывать текстовые файлы последовательного доступа),
модель FSO содержит еще три основных объекта. Это Drive (собирает
информацию о дисках, присоединенных к системе), Folder (создает, удаляет
и перемещает папки) и Files (создает, удаляет и перемещает
файлы)
Добавляем в код строки создания файла, а затем его закрываем, изменяем
заголовок формы и приравниваем переменные-счетчики (их объявление так же
необходимо вынести в раздел деклараций) к нулю.
Private CountEntries As Integer' общее количество записей<BR>
Private CurrentEntries As Integer' номер текущей записи<BR>
With dlgDb<BR>
.DialogTitle = "Создать текстовую БД"
.Filter = "Текстовые БД (*.tdb)|*.tdb"
.FilterIndex = 1
.ShowOpen
'создание текстового файла последовательного доступа
Set tsNew = fso.CreateTextFile(.FileName, True)
'закрытие файла
tsNew.Close
'изменение заголовка
Caption = "Demo FSO as DB (" & .FileTitle & ")"
End With
'установка счетчиков
CountEntries = 0
CurrentEntries = 0
Шаг 5. Теперь займемся созданием
класса, отвечающего за работу с записями. Снова обратимся к утилите для создания
классов. Выберите меню Add-Ins/Class Builder Utility…
В открывшемся мастере выберите меню File/New/Collection… В поле Name введите имя коллекции, в
нашем случае - colDB. Справа в диалоговом окне выберите опцию New Class (т.е.
коллекция будет основана на новом классе) и назовите класс clsDB. Подтвердите
нажатием клавиши ОК. Не выходя из мастера, создадим и сам класс (меню File/New/Class…) и также нажмем кнопку ОК. Добавим свойства
в класс clsDB: LastName, FirstName, Number, ID. Для добавления каждого свойства
выбирается меню File/New/Property…, заносится имя и
тип (в данном случае для первых трех – String, для последнего – Integer. После
этого мастер можно закрыть. Когда он запросит сохранение введенной информации –
подтвердите это. В автоматически созданном коде, необходимо провести небольшуюю
корректировку – удалить все, что относится к свойству Key, созданному
автоматически по-умолчанию. В итоге получим:
Класс clsDB, со следующим кодом
Option Explicit
'Internal variables
Private mvarLastName As String
Private mvarFirstName As String
Private mvarNumber As String
Private mvarID As Integer
'Properties
mvarID = vData
End Property
Public Property Get ID() As Integer
ID = mvarID
End Property
Public Property Let Number(ByVal vData As String)
mvarNumber = vData
End Property
Public Property Get Number() As String
Number = mvarNumber
End Property
Public Property Let FirstName(ByVal vData As String)
mvarFirstName = vData
End Property
Public Property Get FirstName() As String
FirstName = mvarFirstName
End Property
Public Property Let LastName(ByVal vData As String)
mvarLastName = vData
End Property
Public Property Get LastName() As String
LastName = mvarLastName
End Property
И коллекцию colDB
Option Explicit
'Внутренние переменные
Private mCol As Collection
'Методы
Public Function Add(LastName As String, FirstName As String, _
Number As String, ID As Integer) As clsDB
'создаем новый объект
Dim objNewMember As clsDB
Set objNewMember = New clsDB
'set the properties passed into the method
objNewMember.LastName = LastName
objNewMember.FirstName = FirstName
objNewMember.Number = Number
objNewMember.ID = ID
mCol.Add objNewMember
'возвращаем созданный объект
Set Add = objNewMember
'а теперь освобождаем память
Set objNewMember = Nothing
End Function
Public Sub Remove(vntIndexKey As Variant)
mCol.Remove vntIndexKey
End Sub
'Свойства
Public Property Get Item(vntIndexKey As Variant) As clsDB
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Property Get NewEnum() As IUnknown
Set NewEnum = mCol.[_NewEnum]
End Property
'Инициализация и закрытие коллекции
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
Шаг 6. Перейдем в форму. В разделе
деклараций объявим новую переменную, опирающуся на только что созданную
коллекцию colDB.
Private colTxtDB As colDB 'объектная модель БД
А в код добавим строку:
Set colTxtDB = New
colDB
Вот собственно говоря и все для создания нового пустого файла для базы
данных.
Шаг 7. Теперь напишем код пересылки
данных из объектной модели БД в текстовые поля формы.
Private Sub DBInForm(Index As Integer)
txtLastName.Text = colTxtDB(Index).LastName
txtFirstName.Text = colTxtDB(Index).FirstName
txtNumber.Text = colTxtDB(Index).Number
lblID.Caption = "Номер записи: " & colTxtDB(Index).ID
End Sub
Шаг 8. Создадим код для кнопок
редактирования.
Для кнопки "Добавить" запись: Увеличиваем счетчик общего количества записей
на 1, текущую запись нумеруем последней, используем метод Add из коллекции colDB
и пересылаем данные в форму.
CountEntries = CountEntries + 1
CurrentEntries = CountEntries
colTxtDB.Add txtLastName.Text, txtFirstName.Text, txtNumber.Text, CurrentEntries
DBInForm CurrentEntries
Для кнопки "Изменить" запись: присваиваем новые значения в БД из каждого поля
и пересылаем данные в форму.
If CountEntries = 0 Then Exit Sub
colTxtDB(CurrentEntries).LastName = txtLastName.Text
colTxtDB(CurrentEntries).FirstName = txtFirstName.Text
colTxtDB(CurrentEntries).Number = txtNumber.Text
DBInForm CurrentEntries
Для кнопки "Удалить" запись: после подтверждения удаления из БД удаляем
текущую запись. Если запись была последней, переходим к предпоследней, в
противном случае она автоматически становится следующей. Уменьшаем счетчик
общего количества записей на 1 и пересылаем текущую запись в форму.
If CountEntries = 0 Then Exit Sub
If MsgBox("Удалить текущую запись?", vbYesNo + vbDefaultButton2 + vbQuestion, _
"Удаление записи") = vbYes Then
colTxtDB.Remove CurrentEntries
If CurrentEntries = CountEntries Then
CurrentEntries = CurrentEntries - 1
End If
CountEntries = CountEntries - 1
DBInForm CurrentEntries
End If
Здесь же необходимо позаботиться об отслеживании изменений в БД. Для этого в
разделе деклараций объявим переменную-флаг:
Private
flagChange As Boolean
И в коде, после всех манипуляций с кнопками редактирования, этот флаг
установим.
flagChange=True
К этой переменной мы будем обращаться при закрытии файла для сохранения
измененных записей.
Шаг 9. Вернемся к кнопкам cmdDB.
Опишем код для открытия уже существующего файла. Начальная часть кода, работа с
классом clsCommonDialog остается той же самой, а вот работа с FSO – будет
отличаться.
Создаем новую коллекцию colTxtDB
Set colTxtDB = New
colDB
Сначала откроем текстовый поток
Set tsOpen =
fso.OpenTextFile(.FileName, ForReading)
Затем считаем первую строку из файла, которая будет содержать информацию о
количестве записей в БД.
CountEntries =
tsOpen.ReadLine
Далее в цикле For-Next считываем все записи и с помощью метода Add добавляем
их (не забудте объявить внутренние переменные для этой манипуляции)
For i = 1 To CountEntries
strLastname = tsOpen.ReadLine
strFirstName = tsOpen.ReadLine
strNumber = tsOpen.ReadLine
intID = tsOpen.ReadLine
colTxtDB.Add strLastname, strFirstName, strNumber, intID
Next
После считывания информации не забудте закрыть файл
tsOpen.Close
Изменяем заголовок файла, текущую запись делаем первой и пересылаем ее в
БД.
Caption = "Demo FSO as DB (" & .FileTitle &
")"
CurrentEntries = 1
DBInForm CurrentEntries
Шаг 10. Далее необходимо
позаботиться о сохранении информации. Для этого создадим процедуру CloseFile.
Для того, чтобы она заработала необходимо изменение flagChange и подтверждение
сохранения пользователем. Работа с диалоговым окном та же самая, несколько
изменится заголовок и используется метод ShowSave, вместо ShowOpen.
If flagChange Then 'если были произведены изменения в БД
If MsgBox("Сохранить произведенные изменения в базе данных?", _
vbYesNo + vbQuestion, "Закрытие программы") = vbYes Then
With dlgDb
.DialogTitle = "Сохранение текстовой БД"
.Filter = "Текстовые БД (*.tdb)|*.tdb"
.FilterIndex = 1
.ShowSave
Далее открываем текстовый поток для записи и записываем первую строку – количество записей.
Set tsSave = fso.OpenTextFile(.FileName, ForWriting)
tsSave.WriteLine CountEntries
Последовательно записываем все записи и закрываем файл. Флаг изменений устанавливаем в False.
For i = 1 To CountEntries
tsSave.WriteLine colTxtDB(i).LastName
tsSave.WriteLine colTxtDB(i).FirstName
tsSave.WriteLine colTxtDB(i).Number
tsSave.WriteLine colTxtDB(i).ID
Next
tsSave.Close
End WithEnd If
End IfflagChange = False
Шаг 11. В кодах для кнопок создания
и открытия файлов внесем проверку на уже открытый файл. Если открыт – закрываем
его и уничтожаем объект коллекции.
If Len(Caption) > 14 Then 'надпись длиннее чем "Demo FSO as DB"
CloseFile
Set colTxtDB = Nothing
End If
Шаг 12. При выходе из программы
сохраняем файл и обнуляем все объекты
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
CloseFile
'очистка памяти
Set colTxtDB = Nothing
Set tsOpen = Nothing
Set tsSave = Nothing
Set tsNew = Nothing
Set fso = Nothing
End Sub
Шаг 13. Осталось совсем чуть-чуть
написать код для передвижения по записям. Производим позиционирование текущей
записи:
Переход к первой записи
CurrentEntries = 1
Переход к последней записи
CurrentEntries =
CountEntries
Переход к предыдущей записи
CurrentEntries =
CurrentEntries - 1
Переход к следующей записи
CurrentEntries =
CurrentEntries + 1
Далее делаем проверку, чтобы номер записи не выходил за диапазон базы данных.
If CurrentEntries < 1 Then
CurrentEntries = 1
ElseIf CurrentEntries > CountEntries Then
CurrentEntries = CountEntries
End If
И наконец пересылаем текущую запись в форму.
DBInForm CurrentEntries
Сравните полученные у Вас записи с кодами
Поле для деятельности у Вас еще есть (можно, например, создать кнопку
промежуточного сохранения БД или кнопку "Сохранить как…"), но основа для работы
уже создана.