Создание файла прямого доступа
Задание: Проверка приборов
Программный код:
Dim s As Stud
Dim namefayl As String
Private Sub CmdNew_Click()
Text1.SetFocus
nfayl1 = FreeFile
info = InputBox("Ввести запись? у/п")
If info = "y" Then
Open namefayl For Random As #nfayl1
nz = nz + 1
s.fio = Text1.Text
s.adr = Text4.Text
s.dat = Val(Text5.Text)
s.gr = Text6.Text
's.bal = Val(Text7.Text)
Put #nfayl1, nz, s
'Debug.Print s.fio, s.adr, s.dat, s.gr, s.bal
MsgBox "Запись введена!", vbExclamation
List1.AddItem s.fio
Close nfayl1
End If
End Sub
Private Sub CmdВывод_Click()
'Dim st As String
nfayl1 = FreeFile
Open namefayl For Random As #nfayl1
Do While Not EOF(nfayl1)
Get #nfayl1, , s
Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal
'st = st & s.fio & s.adr & CStr(s.dat) & CStr(s.gr) & CStr(s.bal) & Chr(13)
List1.AddItem s.fio
Loop
'MsgBox st
Close nfayl1
End Sub
Private Sub CmdДобавить_Click()
nfayl2 = FreeFile
Open namefayl For Random As #nfayl2
Do While Not EOF(nfayl2)
Get #nfayl2, , s
Loop
m = Seek(nfayl2)
s.fio = Text1.Text
s.adr = Text4.Text
s.dat = Val(Text5.Text)
s.gr = Text6.Text
's.bal = Val(Text7.Text)
Put #nfayl2, m, s
'Debug.Print s.fio, s.adr, s.dat, s.gr, s.bal
MsgBox "Запись добавлена!", vbExclamation
List1.AddItem s.fio
Close nfayl2
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
'Text7.Text = ""
Text1.SetFocus
End Sub
Private Sub CmdПоиск_Click()
Dim f As String
Dim nz As Integer
nz = 0
nfayl2 = 1
Open namefayl For Random As #nfayl2
f = InputBox("Поиск по первой букве фамилии")
Debug.Print "Результаты поиска"
Do While Not EOF(nfayl2)
Get #nfayl2, , s
'Debug.Print s.fio s.adr s.dat s.gr s.bal
If Left(f, 1) = Left(s.fio, 1) Then
'Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal
Text2.Text = Text2.Text & s.fio & s.adr & s.dat & s.gr & s.bal & Chr(13) & Chr(10)
nz = Loc(nfayl2)
v = MsgBox("Удалить?", vbYesNo)
If v = vbYes Then
s.fio = "": s.adr = "": s.gr = "": s.bal = 0
Put #nfayl2, nz, s
'List1.RemoveItem (nz - 1)
End If
End If
Loop
If nz = 0 Then MsgBox "Запись не найдена!", vbExclamation
Close
End Sub
Private Sub CmdСброс_Click()
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
'Text7.Text = ""
Text1.SetFocus
Text2.Text = ""
List1.Clear
End Sub
Private Sub CmdУдалить_Click()
nfayl1 = 1
nfayl2 = 2
Open namefayl For Random As #nfayl1
Open "D:\A.txt" For Random As #nfayl2
Do While Not EOF(nfayl1)
Get #nfayl1, , s
If Left(s.fio, 1) <> " " Then
n = n + 1
Put #nfayl2, n, s
'Debug.Print s.fio; s.adr; s.dat; s.gr; s.bal
'Debug.Print n
End If
Loop
'nz = List1.Listindex
'List1.RemoveItem nz
MsgBox "Запись удалена!"
Close
Kill namefayl
Name "D:\A.txt" As namefayl
Text2.Text = ""
End Sub
Private Sub Command6_Click()
End
End Sub
'Private Sub UpDown1_Change()
'Text7.Text = Str(UpDown1.Value)
'End Sub
'Private Sub Text7_Change()
'UpDown1.Value = Val(Text7.Text)
'End Sub
Private Sub Form_Load()
info = InputBox("Создать новый файл у/п?")
If info = "y" Then
CmdNew.Enabled = True
End If
MsgBox "Введите имя файла!"
namefayl = Text3.Text
End Sub
Скриншоты:
