Приложение 5. Пример обработки типизированных файлов.
Создать на МД 2 файла прямого доступа с данными о складах:
1. Код склада, ФИО директора, удаленность от центра (км),
температура в помещении, метраж (кв.м)
2. Код склада, стоимость 1 кв.м, срок сдачи (сутки)
Вывести содержимое файлов на экран. Получить выходной документ в
форме:
3. Код склада, ФИО директора, стоимость сдачи, удаленность от
центра, температура в помещении.
Обеспечить возможность:
- добавления новых записей в файл;
- удаления записи с заданным номером из файла;
- корректировки в файле записи с заданным номером;
- сортировки записей в файле по задаваемому полю и ключу.
Объявляем пользовательские типы данных и необходимые
переменные в соответствии с условием задачи:
Private Type Rec1
kod As Integer
FIO As String * 15
dist As Single
t As Integer
pl As Integer
End Type
Private Type Rec2
kod As Integer
stm As Currency
srok As Byte
End Type
Private Type Rec3
kod As Integer
FIO As String * 15
obst As Currency
dist As Single
t As Integer
End Type
Private zap1 As Rec1, zap2 As Rec2, zap3 As Rec3
Private x As Rec3, y As Rec3
Private kolzap%, nRec%, b As Boolean
Процедура вывода на экран условия задачи:
Private Sub Form_Load()
Label1 = " Создать на МД 2 файла прямого доступа с данными о
складах: " & vbCrLf & _
" 1. Код склада, ФИО директора, удаленность от центра (км),
температура в помещении, метраж (кв.м) " & vbCrLf & _
" 2. Код склада, стоимость 1 кв.м, срок сдачи (сутки)" & vbCrLf & _
" Вывести содержимое файлов на экран. Получить выходной
документ в форме: " & vbCrLf & _
" 3. Код склада, ФИО директора, стоимость сдачи, удаленность от
центра, " & vbCrLf & " температура в помещении.
Отсортировать его по ключевому полю. " & vbCrLf & _
" Обеспечить возможность:" & vbCrLf & _
" - добавления новых записей в файл;" & vbCrLf & _
" - удаления записи с заданным номером из файла;" & vbCrLf & _
" - корректировки в файле записи с заданным номером;" & vbCrLf
& “ - сортировки записей в файле по заданному полю и ключу. "
End Sub
Процедура создания файла первой таблицы:
Private Sub mnuMakeFile1_Click()
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
Do
zap1.kod = InputBox("Введите код склада")
zap1.FIO = InputBox("Введите ФИО директора")
zap1.dist = Val(InputBox("Введите удаленность склада от центра
(км)"))
zap1.t = InputBox("Введите температуру в помещении складад")
zap1.pl = InputBox("Введите метраж складского помещения")
Put #1, , zap1
Loop Until MsgBox("Продолжить ввод данных ?", 36) = vbNo
Close #1
End Sub
Процедура создания файла второй таблицы:
Private Sub mnuMakeFile2_Click()
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
Do
zap2.kod = InputBox("Введите код склада")
zap2.stm = InputBox("Введите стоимость аренды 1 кв. м.")
zap2.srok = InputBox("Введите срок сдачи (суток)")
Put #2, , zap2
Loop Until MsgBox("Продолжить ввод данных ?", 36) = vbNo
Close #2
End Sub
Процедура просмотра содержимого файла первой таблицы:
Private Sub mnuViewTab1_Click()
Dim i%, j%
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
kolzap = LOF(1) \ Len(zap1)
fg1.Cols = 5: fg1.Rows = 1
fg1.Clear
fg1.FormatString = "^ Код |< ФИО дирек. |> Расстояние |^ Температура
|^ Метраж "
For i = 1 To kolzap
fg1.Rows = fg1.Rows + 1
Get #1, , zap1
fg1.TextMatrix(i, 0) = zap1.kod
fg1.TextMatrix(i, 1) = zap1.FIO
fg1.TextMatrix(i, 2) = zap1.dist
fg1.TextMatrix(i, 3) = zap1.t
fg1.TextMatrix(i, 4) = zap1.pl
Next i
Close #1
End Sub
Процедура просмотра содержимого файла второй таблицы:
Private Sub mnuViewTab2_Click()
Dim i%, j%
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
kolzap = LOF(2) \ Len(zap2)
fg2.Cols = 3: fg2.Rows = 1
fg2.Clear
fg2.FormatString = "^ Код |> Стоимость 1 кв. м. |^ Срок (сутки) "
For i = 1 To kolzap
fg2.Rows = fg2.Rows + 1
Get #2, , zap2
fg2.TextMatrix(i, 0) = zap2.kod
fg2.TextMatrix(i, 1) = zap2.stm
fg2.TextMatrix(i, 2) = zap2.srok
Next i
Close #2
End Sub
Процедура создания файла выходного документа:
Private Sub mnuDokument_Click()
Dim i%, j%, stoim@
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
Open CurDir$ & "\docum.dat" For Random As #3 Len = Len(zap3)
kolzap = LOF(1) \ Len(zap1)
For i = 1 To kolzap
fg3.Rows = fg3.Rows + 1
Get #1, , zap1
zap3.kod = zap1.kod
zap3.FIO = zap1.FIO
zap3.dist = zap1.dist
zap3.t = zap1.t
Seek #2, 1
For j = 1 To kolzap
Get #2, , zap2
If zap1.kod = zap2.kod Then
stoim = zap2.stm * zap1.pl * zap2.srok: Exit For
End If
Next j
zap3.obst = stoim
Put #3, , zap3
Next i
Close
Open CurDir$ & "\docum.dat" For Random As #3 Len = Len(zap3)
kolzap = LOF(3) \ Len(zap3)
fg3.Clear
fg3.Cols = 5: fg3.Rows = 1
fg3.FormatString = "^ Код |< ФИО директора |> Общая стоимость
аренды |> Расстояние (км)|^ Температура (град.)"
For i = 1 To kolzap
fg3.Rows = fg3.Rows + 1
Get #3, , zap3
fg3.TextMatrix(i, 0) = zap3.kod
fg3.TextMatrix(i, 1) = zap3.FIO
fg3.TextMatrix(i, 2) = zap3.obst
fg3.TextMatrix(i, 3) = zap3.dist
fg3.TextMatrix(i, 4) = zap3.t
Next i
Close #3
End Sub
Процедура удаления из файлов информации о складе с заданным
кодом:
Private Sub mnuDel_Click()
Dim num1%, num2%, i%, kd%
kd = InputBox("Введите код склада, данные о котором нужно удалить
из обоих файлов ")
Open CurDir$ & "\Newsklad.dat" For Random As #4 Len = Len(zap1)
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
kolzap = LOF(1) \ Len(zap1)
По введенному коду находим в 1-ой таблице номер удаляемой из нее
записи
For i = 1 To kolzap
Get #1, i, zap1
If zap1.kod = kd Then num1 = i: Exit For
Next i
Циклически сдвигаем все записи, начиная с num1 + 1 и до конца
файла, вверх
i = num1 + 1
Do While Not EOF(1)
Get #1, i, zap1
Put #1, i - 1, zap1
i = i + 1
Loop
Переписываем все записи от первой до предпоследней из 1-го
файла в 4-ый
For i = 1 To kolzap - 1
Get #1, i, zap1
Put #4, i, zap1
Next i
Close #1
Close #4
Уничтожаем первый файл
Kill CurDir$ & "\sklad1.dat"
Даем третьему файлу имя уничтоженного первого
Name CurDir$ & "\Newsklad.dat" As CurDir$ & "\sklad1.dat"
Close #1
Call mnuViewTab1_Click
Повторяем всю процедуру удаления для записей 2-ой таблицы
Open CurDir$ & "\Newsklad.dat" For Random As #4 Len = Len(zap2)
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
kolzap = LOF(2) \ Len(zap2)
По введенному коду находим во 2-ой таблице номер удаляемой из
нее записи
For i = 1 To kolzap
Get #2, i, zap2
If zap2.kod = kd Then num2 = i: Exit For
Next i
Циклически сдвигаем все записи, начиная с num2 + 1 и до конца
файла, вверх
i = num2 + 1
Do While Not EOF(2)
Get #2, i, zap2
Put #2, i - 1, zap2
i = i + 1
Loop
Переписываем все записи от первой до предпоследней из 2-го
файла в 4-ый
For i = 1 To kolzap - 1
Get #2, i, zap2
Put #4, i, zap2
Next i
Close #2
Close #4
Уничтожаем первый файл
Kill CurDir$ & "\sklad2.dat"
Даем второму файлу имя уничтоженного первого
Name CurDir$ & "\Newsklad.dat" As CurDir$ & "\sklad2.dat"
Close #2
Call mnuViewTab2_Click
End Sub
Процедура добавления в файлы новой информации о складах:
Private Sub mnuAdd_Click()
Dim i%
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
Do
Добавляем новые записи в первую таблицу
kolzap = LOF(1) \ Len(zap1)
Seek #1, kolzap + 1
zap1.kod = InputBox("Введите код склада")
zap1.FIO = InputBox("Введите ФИО директора")
zap1.dist = Val(InputBox("Введите удаленность склада от центра"))
zap1.t = InputBox("Введите температуру в помещениях склада")
zap1.pl = InputBox("Введите площадь помещений склада")
Put #1, , zap1
Добавляем новые записи во вторую таблицу
kolzap = LOF(2) \ Len(zap2)
Seek #2, kolzap + 1
zap2.kod = zap1.kod
zap2.stm = InputBox("Введите стоимость аренды 1 кв. м. склада")
zap2.srok = InputBox("Введите срок сдачи помещений в аренду")
Put #2, , zap2
Loop Until MsgBox("Продолжить ввод данных ?", 36) = vbNo
Close
Выводим на экран новое состояние обеих таблиц
Call mnuViewTab1_Click
Call mnuViewTab2_Click
End Sub
Процедура редактирования данных в заданном поле заданной записи в заданном файле (в заданной таблице):
Private Sub mnuEdit_Click()
Dim st$, stp$, kd%, i%, nom%
Корректируем задаваемое поле задаваемой записи в
задаваемой таблице
st = InputBox("Введите имя таблицы, в которой требуется" & vbCrLf & _
"изменить информацию о складе (tab1 или tab2)")
fg1.Rows = 3
If st = "tab1" Then
fg1.Clear: fg1.Cols = 5
fg1.FormatString = "^ Код |< ФИО дирек. |> Расстояние |^ Температура
|^ Метраж "
Open CurDir$ & "\sklad1.dat" For Random As #1 Len = Len(zap1)
kd = InputBox("Введите код склада, информация о котором требует
корректировки")
kolzap = LOF(1) \ Len(zap1)
For i = 1 To kolzap
Get #1, , zap1
If zap1.kod = kd Then
nom = i
fg1.TextMatrix(1, 0) = zap1.kod
fg1.TextMatrix(1, 1) = zap1.FIO
fg1.TextMatrix(1, 2) = zap1.dist
fg1.TextMatrix(1, 3) = zap1.t
fg1.TextMatrix(1, 4) = zap1.pl
stp = InputBox("Введите имя требующего корректировки поля
записи")
Select Case stp
Case "kod"
zap1.kod = InputBox("Введите новое значение кода")
fg1.TextMatrix(1, 0) = zap1.kod
Case "FIO"
zap1.FIO = InputBox("Введите новое значение ФИО")
fg1.TextMatrix(1, 1) = zap1.FIO
Case "dist"
zap1.dist = InputBox("Введите новое значение расстояния")
fg1.TextMatrix(1, 2) = zap1.dist
Case "t"
zap1.t = InputBox("Введите новое значение температуры")
fg1.TextMatrix(1, 3) = zap1.t
Case "pl"
zap1.pl = InputBox("Введите новое значение площади")
fg1.TextMatrix(1, 4) = zap1.pl
End Select
Exit For
End If
Next i
Seek #1, nom
Put #1, , zap1
Close #1
Call mnuViewTab1_Click
Корректируем задаваемое поле задаваемой записи во второй из
Таблиц
ElseIf st = "tab2" Then
fg2.Clear: fg2.Cols = 3
fg2.FormatString = "^ Код |> Стоимость 1 кв. м. |^ Срок (сутки) "
Open CurDir$ & "\sklad2.dat" For Random As #2 Len = Len(zap2)
kd = InputBox("Введите код склада, информация о котором требует
корректировки")
kolzap = LOF(2) \ Len(zap2)
For i = 1 To kolzap
Get #2, , zap2
If zap2.kod = kd Then
nom = i
fg2.TextMatrix(1, 0) = zap2.kod
fg2.TextMatrix(1, 1) = zap2.stm
fg2.TextMatrix(1, 2) = zap2.srok
stp = InputBox("Введите имя требующего корректировки поля
записи")
Select Case stp
Case "kod"
zap2.kod = InputBox("Введите новое значение кода")
fg2.TextMatrix(1, 0) = zap2.kod
Case "stm"
zap2.stm = InputBox("Введите новое значение стоимости аренды
1-го кв. м.")
fg2.TextMatrix(1, 1) = zap2.stm
Case "srok"
zap2.srok = InputBox("Введите новое значение срока сдачи в
аренду")
fg2.TextMatrix(1, 2) = zap2.srok
End Select
Exit For
End If
Next i
Seek #2, nom
Put #2, , zap2
Close #2
Call mnuViewTab2_Click
End If
End Sub
Процедура, меняющая местами две соседние записи в файле:
Private Sub Replace()
Seek #3, nRec
Put #3, , y
Put #3, , x
b = True
End Sub
Процедура сортировки записей в файле выходного документа:
Private Sub mnuSort_Click()
Dim s$, ks%
Open CurDir$ & "\docum.dat" For Random As #3 Len = Len(zap3)
s = "": b = True
kolzap = LOF(3) \ Len(zap3)
s = InputBox("Введите имя поля, по которому нужно сортировать" &
vbCrLf & " записи: kod, FIO, obst, dist, t")
ks = InputBox("Введите ключ сортировки :" & vbCrLf & " -1: по
убыванию;" & vbCrLf & " 1: по возрастанию")
Do While b = True
b = False: nRec = 1
Seek #3, 1
Do While nRec < kolzap
Читаем из файла две соседние записи с номерами n_rec и n_rec + 1
Seek #3, nRec
Get #3, , x
Get #3, , y
Сравниваем имена полей с введенным именем и с помощью
процедуры Replace меняем местами в файле прочитанные записи в
соответствии с условиями сортировки
Select Case s
Case "kod"
If ks * x.kod > ks * y.kod Then Replace
Case "FIO"
Select Case ks
Case -1
If x.FIO < y.FIO Then Replace
Case 1
If x.FIO > y.FIO Then Replace
End Select
Case "obst"
If ks * x.obst > ks * y.obst Then Replace
Case "dist"
If ks * x.dist > ks * y.dist Then Replace
Case "t"
If ks * x.t > ks * y.t Then Replace
End Select
nRec = nRec + 1
Loop
Loop
Close #3
Open CurDir$ & "\docum.dat" For Random As #3 Len = Len(zap3)
kolzap = LOF(3) \ Len(zap3)
Выводим на экран отсортированный по задаваемому полю
выходной документ
fg3.Clear
fg3.Cols = 5: fg3.Rows = 1
fg3.FormatString = "^ Код |< ФИО директора |> Общая стоимость
аренды |> Расстояние (км)|^ Температура (град.)"
For i = 1 To kolzap
fg3.Rows = fg3.Rows + 1
Get #3, , zap3
fg3.TextMatrix(i, 0) = zap3.kod
fg3.TextMatrix(i, 1) = zap3.FIO
fg3.TextMatrix(i, 2) = zap3.obst
fg3.TextMatrix(i, 3) = zap3.dist
fg3.TextMatrix(i, 4) = zap3.t
Next i
Close #3
End Sub
Процедура завершения работы приложения:
Private Sub mnuExit_Click()
End
End Sub
Ниже приведен возможный вид рабочей формы данного проекта.
Уяснив различия в использовании операторов при обработке файлов с произвольным и последовательным доступом, изложенные в разделе 9.6, эту же задачу можно решить и с использованием файла с последовательным доступом.