-
Error message on my binary search program
Please i have having:
Run-time error '63':
Bad record number.
I don't know what the problem is.
Option Explicit
'
' Student record user defined type.
'
Private Type StudentData
RegNO As String * 9
ContactAddress As String * 40
StudentName As String * 30
Phone As String * 20
State As String * 15
DOB As String * 14
Sex As String * 10
End Type
'
' Array of students
'
Private StudArray() As StudentData
Private StudRec As StudentData
Private RecCt As Long
Private Sub pShowFileRecord(lngRecord As Long)
'
' Display a record from the file in the textboxes.
'
With StudRec
txtRegNO = .RegNO
txtContactAddress = .ContactAddress
txtStudentName = .StudentName
txtPhone = .Phone
txtState = .State
txtDOB = .DOB
txtSex = .Sex
End With
End Sub
Private Sub ClearRecord()
'
' Clear the text boxes
'
MsgBox "Please Enter a valid Registration number", vbCritical, "Invalid Entry or No Record"
txtRegNO.Text = ""
txtContactAddress.Text = ""
txtStudentName.Text = ""
txtPhone.Text = ""
txtState.Text = ""
txtDOB.Text = ""
txtSex.Text = ""
txtNO.SetFocus 'Set the cursor at the searching textbox
End Sub
Private Sub cmdAbout_Click()
'
'Show about form
'
frmAbout.Show
End Sub
Private Sub cmdAdd_Click()
Dim intNum As Integer
Dim fFile As Integer
fFile = FreeFile ' Get the next available file number
If txtRegNO.Text = "" Then
MsgBox "Please check RegNO!", vbExclamation, "Reg No Must be Filled"
txtRegNO.SetFocus
ElseIf txtContactAddress.Text = "" Then
MsgBox "Please check ContactAddress!", vbExclamation, "Address must be filled"
txtContactAddress.SetFocus
ElseIf txtStudentName.Text = "" Then
MsgBox "Please check Name!", vbExclamation, "Student Name must be filled"
txtStudentName.SetFocus
ElseIf txtPhone.Text = "" Then
MsgBox "Please check the Phone No!", vbExclamation, "Phone No must be filled"
txtPhone.SetFocus
ElseIf txtState.Text = "" Then
MsgBox "Please check the State!", vbExclamation, "State must be filled"
txtState.SetFocus
ElseIf txtDOB.Text = "" Then
MsgBox "Please check the Date Of Birth!", vbExclamation, "DOB must be filled"
txtDOB.SetFocus
ElseIf txtSex.Text = "" Then
MsgBox "Please check the Sex!", vbExclamation, "Sex must be fiiled"
txtSex.SetFocus
End If
'
'Open the file for random access
'
Open "StudList.dat" For Random As #fFile Len = Len(StudRec)
intNum = LOF(fFile) \ Len(StudRec) + 1
'
'Putting all the data into the fields
With StudRec
.RegNO = txtRegNO.Text
.ContactAddress = txtContactAddress.Text
.StudentName = txtStudentName.Text
.Phone = txtPhone.Text
.State = txtState.Text
.DOB = txtDOB.Text
.Sex = txtSex.Text
End With
'
'Put the data
Put #fFile, intNum, StudRec
'
'close the file
Close #fFile
End Sub
Private Sub cmdSearch_Click()
Dim lngMatch As Long
'
' Search the file for a record.
'
lngMatch = BinarySearch(txtNO)
'
' If found, display the record.
'
If lngMatch Then
Call pShowFileRecord(lngMatch)
Else
Call ClearRecord
End If
End Sub
Private Sub cmdTD_Click()
'
'show one form and hide the other
'
frmTD.Show
frmBS.Hide
End Sub
Private Sub Form_Load()
'Declaring the variables
Dim GetStud As StudentData
Dim l As Long
'
'Check if the database is empty or not
'Then Load an array with data from the file and
'load the listbox with the Reg NO from each record.
'
If Len(("StudList.dat")) = 0 Then
MsgBox "File: 'StudList' does not exist.", vbCritical, "File Missing"
Unload Me
Exit Sub
End If
Dim fFile As Integer
fFile = FreeFile ' Get the next available file number
'
'Open the file for random access
'
Open "StudList.dat" For Random As #fFile Len = Len(GetStud)
RecCt = LOF(fFile) / Len(GetStud)
ReDim StudArray(1 To RecCt)
For l = 1 To RecCt 'Searching from the first record to the last record
Get #fFile, l, StudArray(l) 'Get one by one
lstRegNO.AddItem StudArray(l).RegNO
Next
Close #fFile 'Close the file
End Sub
Private Sub lstRegNO_Click()
'
'show listbox items in txtNO
'
txtNO = lstRegNO.Text
End Sub
Private Sub cmdClear_Click()
'
'Clear the whole textboxes
'
txtRegNO.Text = ""
txtContactAddress.Text = ""
txtStudentName.Text = ""
txtPhone.Text = ""
txtState.Text = ""
txtDOB.Text = ""
txtSex.Text = ""
txtNO.Text = ""
End Sub
Private Sub cmdQuit_Click()
'
'Terminate the program
'
End
End Sub
Private Function BinarySearch(strSearchItem As String) As Long
'Declaring the variables
Dim lngFirst As Long
Dim lngLast As Long
Dim lngMiddle As Long
Dim lngLastPass As Long
Dim strItem As String
Dim strValue As String
Dim blnDone As Boolean
Dim fFile As Integer
fFile = FreeFile ' Get the next available file number
'Opening the file as random
'
Open "StudList.dat" For Random As #fFile Len = Len(StudRec)
If LOF(fFile) = 0 Then Close #fFile: Exit Function
'
'Get the record count
'
RecCt = LOF(fFile) / Len(StudRec)
'
' Search a file for an item using a binary search.
' The search is not case sensitive.
' Returned is the index of the matching file element.
'
'
' Initialize the pointers to the first
' and last records.
'
lngFirst = 1
lngLast = RecCt
strItem = UCase$(Trim$(strSearchItem))
'
' If only one record, see if it is the desired one.
'
If lngLast = 1 Then
Get 1, 1, StudRec
If strItem = UCase$(StudRec.RegNO) Then
BinarySearch = 1
Else
BinarySearch = 0
End If
Close 1
Exit Function
End If
'
' Set the pointer to the middle record.
'
lngMiddle = ((lngLast - lngFirst) + 1) \ 2
'
' Apply the binary search criteria until the
' item is found or the file is exhausted.
'
Do Until blnDone
'
' Read a record from the file.
'
Get fFile, lngMiddle, StudRec
strValue = UCase$(StudRec.RegNO)
If strItem = strValue Then
'
' Found it.
'
BinarySearch = lngMiddle
blnDone = True
Exit Do
ElseIf strItem < strValue Then
'
' Direction = down
' Remove the second half of the file.
'
lngLast = lngMiddle
lngMiddle = lngMiddle - ((lngLast - lngFirst) + 1) \ 2
ElseIf strItem > strValue Then
'
' Direction = Up
' Remove the first half of the file.
'
lngFirst = lngMiddle
lngMiddle = lngMiddle + ((lngLast - lngFirst) + 1) \ 2
End If
'
' See if record is still divisible.
'
If (lngMiddle = lngFirst) Or (lngMiddle = lngLast) Then
lngLastPass = lngLastPass + 1
If lngLastPass = 2 Then
lngLastPass = 0
BinarySearch = 0
blnDone = True
End If
End If
Loop
Close #fFile 'Close the file
End Function
Private Sub txtNO_KeyPress(KeyAscii As Integer)
'
' Convert to upper case.
'
KeyAscii = Asc(UCase$(Chr(KeyAscii)))
End Sub
Private Sub txtSex_KeyPress(KeyAscii As Integer)
'
' Convert to upper case.
'
KeyAscii = Asc(UCase$(Chr(KeyAscii)))
End Sub
Private Sub txtRegNO_KeyPress(KeyAscii As Integer)
'
' Convert to upper case.
'
KeyAscii = Asc(UCase$(Chr(KeyAscii)))
End Sub
Similar Threads
-
By jabbarsb in forum ASP.NET
Replies: 1
Last Post: 08-20-2008, 07:50 AM
-
Replies: 1
Last Post: 04-03-2007, 10:38 AM
-
Replies: 10
Last Post: 03-24-2007, 01:42 PM
-
By Urbaud in forum VB Classic
Replies: 6
Last Post: 07-08-2006, 10:48 PM
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Development Centers
-- Android Development Center
-- Cloud Development Project Center
-- HTML5 Development Center
-- Windows Mobile Development Center
|