Михаил Эскин немало сделал для развития русскоязычных VB сайтов. Многие знают его по статьям про ActiveX на VB сайтах, другие читают статьи Михаила уже на его собственном сайте. Михаил родился в Городском роддоме №1 города Астрахани, в “черную пятницу”, ну, так скажем, почти сорок лет назад. По-прежнему живет на Юге, правда теперь уже Германии, в прекрасном городе Мюнхене.

    Довольно часто случается, что в программе необходима маленькая база данных (записей на 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
    tOpenFile.lpstrFilter = sAPIFilter(sFilter)
    tOpenFile.iFilterIndex = iFilterIndex
    If lMaxFileSize > 0 Then
        lMaxSize = lMaxFileSize
    Else
        lMaxSize = 255
    End If 
    sFileNameBuff = sFileName
    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

        Select Case iAction
        Case 1 'ShowOpen
            lApiReturn = GetOpenFileName(tOpenFile)
        Case 2 'ShowSave
            lApiReturn = GetSaveFileName(tOpenFile)
        Case Else 
            Exit Sub
    End Select
    m_cancelled = False
        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

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

Загрузить пример к статье.