VBS Newswire

1) Новости сайта
2) Результаты всенародного голосования
3) Новые темы обсуждения на http://vbs.pp.ru/forum
4) Статья: Текстовый файл, как база данных

>>> Новости сайта

• 11.01.2001
  В разделе "FAQ - Статьи" опубликовано произведение Михаила Эскина: "Использование текстового файла, как базы данных".

• 10.01.2001
  Сегодня обновлений будет лом! Обновлен раздел "Жители - Наши проекты". Пополнился раздел "Ссылки". В разделе "FAQ - Статьи" опубликован очень объемный обзор возможностей Visual Basic 5. В разделе "Исходники программ" обновлен модуль для градиентной заливки "Fader", автор: Киселев Сергей. Там же находится новая программа: "Birthday", автор: Double W. В разделе "ActiveX - Прочее" обновлен компонент VBAccelerator Rich Text Box. В разделе "ActiveX - Кнопочки-Украшательства": NeoCaption - таких скинов Вы ещё не видели!

• 07.01.2001
  В разделе "FAQ - на русском": список сообщений Windows. В разделе "Исходники программ": Icon Extractor. Новый вопрос выставлен на всенародное голосование! Обновлен раздел "Ссылки".

>>> Результаты всенародного голосования

Где найти художника для игры?

а) У друзей - 3 (18%)
б) В инете - 2 (12%)
в) На работе - 1 (6%)
г) Я сам художник - 5 (29%)
д) Вот это я и хотел узнать... - 6 (35%)

Всего приняло участие: 17 человек(а)

Новый вопрос!

Оставьте и свой голос - http://vbs.pp.ru

>>> Новые темы обсуждения на http://vbs.pp.ru/forum

Список всех форумов | Visual Basic | Active Server Pages | Базы данных | ActiveX | Мультимедия | Visual Basic для новичков | Работа

Как перейти в следующее поле?
Для Администрации !!!
Закрыть всплывающее окно.
Копирование файла в место, обозначенное переменной a
Получение сетевых дисков и т.п.
Выполнение действия до выхода из Windows (-)
Создание программно-аппаратного комплекса
Реестр
Как проиграть видео файл используя dx7vb.dll
Как расшарить из-под VB папку?

>>> Статья: Текстовый файл, как база данных

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

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

Автор статьи: Михаил Эскин

Ведущий проекта "VBS"
Сергей Никифоров