Додаток а. Текст програми мовою vba для роботи з файлами прямого доступу

'----------------------------------------------------------------------------------

' Оголосити новий тип даних (запис) який складається з

' наступних складових:

Public Type Запис_Абонента

Номер As Integer ' - Номер по порядку

ПрізвищеІБ As String * 20 ' - Прізвище та ініціали абонента

Адреса As String * 30 ' - Адреса абонента

Телефон As String * 20 ' - Номер телефону абонента

End Type

'----------------------------------------------------------------------------------

' Оголосити змінну для поточного запису

Public Поточний_Запис As Запис_Абонента

' Оголосити масив записів

Public Масив_Записів(1 To 100) As Запис_Абонента

'----------------------------------------------------------------------------------

' Функція для виконання операції запису змін у файл

' Вхідні параметри:

' - Шлях_Файла - Повний шлях до файла бази даних

' - Абонент - Запис абонента, для якого вносяться зміни

' Значення, яке повертає:

' - True, якщо абонента знайдено

' - False, якщо абонента не знайдено

' ----------------------------------------------------------

Function Записати_Зміни(Шлях_Файла As String, _

Абонент_Для_Запису As Запис_Абонента) As Boolean

Dim hFile As Long 'Дескриптор файла

Dim Поточний_Абонент As Запис_Абонента

hFile = FreeFile ' Отримати новий номер дескриптора файлу

Записати_Зміни = False

' Відкрити файл для прямого доступу

Open Шлях_Файла For Random Access Read Write As hFile _

Len = Len(Поточний_Абонент)

' Спроба знайти абонента серед записів у файлі

Do Until EOF(hFile)

' Прочитати поточний запис з файла

Get hFile, , Поточний_Абонент

' Перевірити, чи знайдено у файлі абонента

If Абонент_Для_Запису.Номер = _

Поточний_Абонент.Номер Then

' Записати зміни для абонента та завершити

Put hFile, , Абонент_Для_Запису

GoTo ExitHere

End If

Loop

' Якщо запис не знайдено, то записати у кінець файла

Put hFile, , Абонент_Для_Запису

ExitHere:

Записати_Зміни = True

Close hFile

End Function

'---------------------------------------------------------------------------------- Процедура читання з файлу прямого доступу

' Вхідні параметри:

' - Шлях_Файла - Повний шлях до файла бази даних

' - Абонент - Запис абонента, якого треба знайти

' Значення, яке повертає:

' - True, якщо абонента знайдено

' - False, якщо абонента не знайдено

'----------------------------------------------------------------------------------

Function Читати_Абонента(Шлях_Файла As String, _

Абонент As Запис_Абонента) As Boolean

Dim hFile As Long

Dim Поточний_Абонент As Запис_Абонента

hFile = FreeFile ' Отримати новий номер дескриптора файлу

Читати_Абонента = False

' Відкрити файл для прямого доступу

Open Шлях_Файла For Random Access Read Write As hFile _

Len = Len(Поточний_Абонент)

' Спробувати знайти запис серед існуючих у файлі

Do Until EOF(hFile)

' Читати дані з файлу у "поточний запис"

Get hFile, , Поточний_Абонент

' Якщо номер поточного запису у файлі знайдено

If Поточний_Абонент.Номер = Абонент.Номер Then

Абонент = Поточний_Абонент

Читати_Абонента = True

Exit Do

End If

Loop

Close hFile

End Function

'----------------------------------------------------------------------------------

Sub Прочитати_Абонента()

Dim Абонент As Запис_Абонента, Номер_Для_Пошуку As Integer

Const dhcFile = "C:\Temp\Абоненти.DB"

' Читати абонента з вказаним номером запису

Номер_Для_Пошуку = _