Valhalla Legends Forums Archive | Visual Basic Programming | Binary Filing

AuthorMessageTime
moone
I'm trying to add mutliple names/time into a binary file, but I'm not sure on how to get it started with, lead me in the right direction.

[code]
Dim i As Integer
Dim sFilename As String
Dim c_info As i_Calender
Dim strDate() As String

strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"

Open sFilename For Binary Access Write As #1
        For i = 1 To lstAppointments.ListItems.Count
            With c_info
            .Date = "[date =" & strDate(1) & "]"
            .Patient = lstAppointments.ListItems(i).Text
            .Time = lstAppointments.ListItems(i).ListSubItems(1).Text
            End With
        Next i
           
    Put #1, , c_info
    lstAppointments.ListItems.Remove 1

    Close #1
[/code]
May 21, 2006, 5:42 AM
Ringo
Dude, this is a Battle.net Bot Development forum. :P
But to answer your question, for when it gets moved to the trash can/VB forum, you need to put the filled UDT in the file every loop if you want to save all of them.
Try somthing like this to save/load:
[code]
'save
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim c_info() As i_Calender
Dim strDate() As String
strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"
If lstAppointments.ListItems.Count > 0 Then
    ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        For i = 0 To lstAppointments.ListItems.Count - 1
            With c_info(i)
                .Date = "[date =" & strDate(1) & "]"
                .Patient = lstAppointments.ListItems(i).Text
                .Time = lstAppointments.ListItems(i).ListSubItems(1).Text
            End With
        Next i
    Put #sFileNum, , c_info()
    lstAppointments.ListItems.Clear
    Close #sFileNum
End If
[/code]
[code]
'load
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim c_info() As i_Calender
sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        Get #sFileNum, , c_info()
        For i = 0 To UBound(c_info)
            lstAppointments.ListItems.Add(, , c_info(i).Patient).ListSubItems(1).Text = c_info(i).Time
        Next i
    Close #sFileNum
End If
[/code]

Hope this helps.
May 21, 2006, 6:55 AM
moone
Thanks Ringo.
I get abunch of errors, here's the errors I get, tried to fix them but couldn't.

[code]
'save
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strDate() As String
strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"
If lstAppointments.ListItems.Count > 0 Then
    ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        For i = 0 To lstAppointments.ListItems.Count - 1
            With c_info(i)
                .Date = "[date =" & strDate(1) & "]"
                .Patient = lstAppointments.ListItems(i).Text
                .Time = lstAppointments.ListItems(i).ListSubItems(1).Text
            End With
        Next i
    Put #sFileNum, , c_info()
    lstAppointments.ListItems.Clear
    Close #sFileNum
End If
[/code]

Index out of bounds:
[code]
.Patient = lstAppointments.ListItems(i).Text
[/code]

[code]
'load
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
On Error Resume Next
sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        Get #sFileNum, , c_info()
        For i = 0 To UBound(c_info)
            lstAppointments.ListItems.Add(, , c_info(i).Patient).ListSubItems(1).Text = c_info(i).Time
        Next i
    Close #sFileNum
With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With
[/code]

subscript out of range:
[code]
For i = 0 To UBound(c_info)
[/code]
May 21, 2006, 3:32 PM
rabbit
Start at 1.
May 21, 2006, 5:14 PM
moone
Doesn't help.
May 21, 2006, 6:03 PM
Topaz
For i = 0 to UBound(c_Info) - 1
May 21, 2006, 6:26 PM
moone
Doesn't help either, Topaz :/

edit:
I got the loading working I think.
[code]
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
    sFileNum = FreeFile
    ReDim c_info(0)
    Open sFilename For Binary As #sFileNum
        Get #sFileNum, , c_info()
        For i = 0 To UBound(c_info)
            lstAppointments.ListItems.Add , , c_info(i).Patient
            lstAppointments.ListItems(1).ListSubItems.Add , , c_info(i).Time
        Next i
        Close #sFileNum
With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With
[/code]

Now need help for saving..

[code]
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strDate() As String
strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"
If lstAppointments.ListItems.Count > 0 Then
    'ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
    ReDim c_info(0)
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        For i = 0 To lstAppointments.ListItems.Count
            With c_info(i)
                .Date = "[date =" & strDate(1) & "]"
                .Patient = lstAppointments.ListItems(1).Text
                .Time = lstAppointments.ListItems(1).ListSubItems(1).Text
            End With
        Next i
    Put #sFileNum, , c_info()
    lstAppointments.ListItems.Clear
    Close #sFileNum
End If
[/code]

Subscript out of range on:
[code]
With c_info(i)
[/code]
May 21, 2006, 6:33 PM
rabbit
God.  You suck at debugging.  When you get that error, hover over "i" before you stop it.
May 21, 2006, 7:33 PM
warz
haha. :-p
May 21, 2006, 7:35 PM
moone
Well, I got it saving mutliple things, but when I remove it off the listview, it really doesn't update it for some reason, can't seem to get it fixed. Here's what I have so far:

writing:
[code]
Dim i As Integer
    Dim sFilename As String
    Dim sFileNum  As Integer
    Dim strDate() As String
   
    strDate = Split(frmCalenderInformation.Caption, ":")
    sFilename = App.Path & "\Appointments.dat"

    If lstAppointments.ListItems.Count > 0 Then
        'ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
       
        ReDim c_info(0)
       
        sFileNum = FreeFile
       
        Open sFilename For Binary Access Write As #1
           
            For i = 0 To lstAppointments.ListItems.Count - 1
               
                If i > 0 Then ReDim Preserve c_info(UBound(c_info) + 1)
               
                With c_info(i)
                    .Date = "[date =" & strDate(1) & "]"
                    .Patient = lstAppointments.ListItems(i + 1).Text
                    .Time = lstAppointments.ListItems(i + 1).ListSubItems(1).Text
                End With
               
                Put #sFileNum, , c_info(i)
           
            Next i
           
        lstAppointments.ListItems.Clear
       
        Close #sFileNum
    End If
[/code]

reading
[code]
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strTemp As i_Calender

sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
sFileNum = FreeFile
   
    ReDim c_info(0)
   
    Open sFilename For Binary Access Read As #1
        Do
           
            If i > 0 Then ReDim Preserve c_info(UBound(c_info) + 1)
           
            Get #sFileNum, , c_info(i)

            If (c_info(i).Patient = vbNullString Or c_info(i).Time = vbNullString) Then
                If UBound(c_info) > 0 Then ReDim Preserve c_info(UBound(c_info) - 1)
            Else
                lstAppointments.ListItems.Add , , c_info(i).Patient
                lstAppointments.ListItems(i + 1).ListSubItems.Add , , c_info(i).Time
                i = i + 1
            End If
           
        Loop Until EOF(sFileNum)
    Close #sFileNum

With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With
[/code]
May 21, 2006, 8:00 PM
rabbit
Because when you remove something, .Count CHANGES.  SHEESH!!
May 22, 2006, 1:55 AM
UserLoser
Why not:

For Whatever = LBound(Array) To UBound(Array)?

There can't really be any errors there
May 22, 2006, 5:19 AM

Search