Тектовый файл, как база данных

Дата публикации статьи: 09.07.2003 00:00

Довольно часто случается, что в программе необходима маленькая база данных (записей на 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 function

  '****************************************************


'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' общее количество записей

  Private CurrentEntries As Integer' номер текущей записи

  With dlgDb

  .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

  '****************************************************


Public Property Let ID(ByVal vData As Integer)

  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 With


End If

  End If

flagChange = 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

Поле для деятельности у Вас еще есть (можно, например, создать кнопку промежуточного сохранения БД или кнопку "Сохранить как…"), но основа для работы уже создана.