Option Explicit. Private Type Друг 'Создана структура для хранении данных о друзьях

Private Type Друг 'Создана структура для хранении данных о друзьях

Fam As String * 20

Name As String * 20

BirthDay As Date

Telephone As Long

End Type

Dim Del As Boolean

Dim Друзья() As Друг 'Обьявлен динамический массив, состоящий из структур

Dim c As Integer

Dim Один_друг As Друг 'Объявлена переменная, представляющая структуру

Dim Количество_записей As Integer

Private Sub Form_Load()

Dim Размер_записи

Dim Размер_файла

Dim j As Integer 'Счетчик цикла

Del = False

DTPicker1.Value = Date

Open "Friends.txt" For Random As #1 Len = Len(Один_друг) 'Открывается файл

Размер_файла = LOF(1) 'Определяется размер файла

Размер_записи = Len(Один_друг) 'Определяется длина записи

Количество_записей = Размер_файла / Размер_записи 'Определяется количество записей в файле

If Количество_записей = 0 Then Exit Sub

ReDim Друзья(Количество_записей) 'Задается размерность динамического массива

For j = 1 To Количество_записей 'Данными из файла заполняется массив

Get #1, j, Один_друг 'Чтение записи

Друзья(j).BirthDay = Один_друг.BirthDay

Друзья(j).Fam = Один_друг.Fam

Друзья(j).Name = Один_друг.Name

Друзья(j).Telephone = Один_друг.Telephone

Next j

Call View_All 'Вызов процедуры для вывода массива в объект ListView

End Sub

Private Sub View_All()

Dim j As Integer 'счетчик цикла

For j = 1 To Количество_записей

Call Add_Record(j) 'Вызов процедуры для заполнения объекта ListView элементами списка

Next j

End Sub

Private Sub Add_Record(Index As Integer) 'Процедура заполнения объекта ListView

Dim ElementSpiska As ListItem

Set ElementSpiska = ListView1.ListItems.Add(,, Str(Index), 0, 0)

ElementSpiska.SubItems(1) = Trim(Друзья(Index).Fam)

ElementSpiska.SubItems(2) = Trim(Друзья(Index).Name)

ElementSpiska.SubItems(3) = Format(Друзья(Index).BirthDay, "Long Date")

ElementSpiska.SubItems(4) = Str(Друзья(Index).Telephone)

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim j As Integer 'Счетчик цикла

Close #1 'Закрытие файла

If Del = True Then 'Если производилось удаление записей,

Kill "Friends.txt" 'удаляется старый файл

Open "Friends.txt" For Random As #1 Len = Len(Один_друг) 'Открывается новый файл с именем старого

For j = 1 To Количество_записей

Один_друг.BirthDay = Друзья(j).BirthDay

Один_друг.Fam = Друзья(j).Fam

Один_друг.Name = Друзья(j).Name

Один_друг.Telephone = Друзья(j).Telephone

Put #1, j, Один_друг 'Перезапись файла после удаления

Next j

Close #1 'Закрытие файла

End If

End Sub