Results 1 to 12 of 12

Thread: Error message on my binary search program

  1. #1

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Error message on my binary search program

    Error mesage that i am experiencing.

    Run-time '63':
    Bad record number





    Code:
    Private Function BinarySearch(strSearchItem As String) As Long
    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
    
        Open "TDStudList.txt" For Random As 1 Len = Len(StudRec)
        Rec = LOF(1) / Len(StudRec)
        
        lngFirst = 1
        lngLast = Rec
        strItem = UCase$(Trim$(strSearchItem))
        
        'If there is only one record check 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
        
        Do Until blnDone
        
            Get 1, lngMiddle, StudRec
            strValue = UCase$(StudRec.RegNO)
            If strItem = strValue Then
                '
                'Item Found
                '
                BinarySearch = lngMiddle
                blnDone = True
                Exit Do
            ElseIf strItem < strValue Then
                '
                'Direction = Down
                'Remove the second half of the records
                
                lngLast = lngMiddle
                lngMiddle = lngMiddle - ((lngLast - lngFirst) + 1) \ 2
            ElseIf strItem > strValue Then
                '
                'Direction = UP
                'Remove the first half of the records
                '
                lngFirst = lngMiddle
                lngMiddle = lngMiddle - ((lngLast - lngFirst) + 1) \ 2
            End If
            '
            'Check if the records are 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 1
                   
    End Function
    Attached Files Attached Files
    Last edited by jerry4prince; Sep 2nd, 2010 at 04:28 PM.

  2. #2
    Frenzied Member some1uk03's Avatar
    Join Date
    Jun 2006
    Location
    London, UK
    Posts
    1,675

    Re: Error message on my binary search program

    1. Use FreeFile to address a file number
    2. Where did u get StudRec from?
    _____________________________________________________________________

    ----If this post has helped you. Please take time to Rate it.
    ----If you've solved your problem, then please mark it as RESOLVED from Thread Tools.



  3. #3
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Re: Error message on my binary search program

    You forgot the pound sign
    Code:
    Open "TDStudList.txt" For Random As #1 Len = Len(StudRec)

  4. #4

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Re: Error message on my binary search program

    I shall put the whole code for you to see.


    Code:
    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 Rec  As Long
    
    Private Sub pShowFileRecord(lngRecord As Long)
        '
        ' Display a record from the file in the textboxes.
        '
        txtRegNO = StudRec.RegNO
        txtContactAddress = StudRec.ContactAddress
        txtStudentName = StudRec.StudentName
        txtPhone = StudRec.Phone
        txtState = StudRec.State
        txtDOB = StudRec.DOB
        txtSex = StudRec.Sex
        
    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 input
       
    End Sub
    
    Private Sub cmdAbout_Click()
        '
        'Show about form
        '
        frmAbout.Show
    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()
        frmTD.Show
        frmBS.Hide
        
    End Sub
    
    Private Sub Form_Load()
        Dim GetStud As StudentData
        Dim l   As Long
        
        '
        'Load an array with data from the file and
        'load the listbox with the Reg NO from each record.
        '
        Open "StudList.dat" For Random As 1 Len = Len(GetStud)
        Rec = LOF(1) / Len(GetStud)
        
        ReDim StudArray(1 To Rec)
        
        For l = 1 To Rec
            Get 1, l, StudArray(l)
            lstRegNO.AddItem StudArray(l).RegNO
        Next
        Close 1
        
    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
    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
    
    
        Open "StudList.dat" For Random As 1 Len = Len(StudRec)
        Rec = LOF(1) / 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 = Rec
        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 1, 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 1
        
    End Function
    
    Private Sub txtNO_KeyPress(KeyAscii As Integer)
        '
        ' Convert to upper case.
        '
        KeyAscii = Asc(UCase$(Chr(KeyAscii)))
        
    End Sub

  5. #5

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Re: Error message on my binary search program

    some1uk03 that is how i got StudRec
    Last edited by jerry4prince; Sep 1st, 2010 at 03:07 PM.

  6. #6
    Frenzied Member some1uk03's Avatar
    Join Date
    Jun 2006
    Location
    London, UK
    Posts
    1,675

    Re: Error message on my binary search program

    You can replace these for more stability:

    Code:
    Private Sub Form_Load()
        Dim GetStud As StudentData
        Dim l   As Long
        
        '
        'Load an array with data from the file and
        'load the listbox with the Reg NO from each record.
        '
        
        If Len(Dir(App.Path & "\Studlist.dat")) = 0 Then
            MsgBox "File: 'Studlist.dat' does not exist.", vbCritical, "File Missing"
            Unload Me
            Exit Sub
        End If
    
    Dim fFile As Integer
    fFile = FreeFile
    
        Open App.Path & "\StudList.dat" For Random As #fFile Len = Len(GetStud)
            Rec = LOF(fFile) / Len(GetStud)
        
            ReDim StudArray(1 To Rec)
        
            For l = 1 To Rec
                Get 1, l, StudArray(l)
                lstRegNO.AddItem StudArray(l).RegNO
            Next
        Close #fFile
        
    End Sub
    Code:
    Private Function BinarySearch(strSearchItem As String) As Long
    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
    
        Open "StudList.dat" For Random As #fFile Len = Len(StudRec)
        If LOF(fFile) = 0 Then Close #fFile: Exit Function
        
        Rec = 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 = Rec
        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
        
    End Function
    _____________________________________________________________________

    ----If this post has helped you. Please take time to Rate it.
    ----If you've solved your problem, then please mark it as RESOLVED from Thread Tools.



  7. #7

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Re: Error message on my binary search program

    I am still having an error in the program.

    Run-time error'63':

    Bad record number.

    I just don't know what it is, pls do help me out.

  8. #8
    Frenzied Member some1uk03's Avatar
    Join Date
    Jun 2006
    Location
    London, UK
    Posts
    1,675

    Re: Error message on my binary search program

    Theres something wrong with the PROJECT you uploaded. I can't extract it. Keeps on giving errors.
    _____________________________________________________________________

    ----If this post has helped you. Please take time to Rate it.
    ----If you've solved your problem, then please mark it as RESOLVED from Thread Tools.



  9. #9

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Re: Error message on my binary search program

    i will try to upload it again. How can i upload another one pls
    Last edited by jerry4prince; Sep 7th, 2010 at 07:41 AM.

  10. #10

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Error message on my binary search program

    This is the project i last posted and it was having error.
    Attached Files Attached Files

  11. #11
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,974

    Re: Error message on my binary search program

    Duplicate threads merged - please post each question (or variation of it) only once.

    i will try to upload it again. How can i upload another one pls
    Click on "Post reply" or "Go Advacnced" to see the full editor, which includes "Manage Attachments".

  12. #12

    Thread Starter
    Member
    Join Date
    Aug 2010
    Posts
    48

    Re: Error message on my binary search program

    Quote Originally Posted by some1uk03 View Post
    Theres something wrong with the PROJECT you uploaded. I can't extract it. Keeps on giving errors.
    i have uploaded another project, it will work this time. Thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width