Keskustelu: Ohjelmointikysymykset: [VB6] Tiedostosta lataaminen Listboxiin

Public Type ModelInfo
    ID As Integer
    name As String
End Type

Option Explicit
Public GunModel() As ModelInfo
''''''''
Lataus


Public Function OpenModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long, lngCount As Long, a As Integer
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Read As #intFF
    Get #intFF, , lngCount
    If lngCount > 0 Then
        ReDim GunModel(lngCount - 1)
        For lngA = 0 To UBound(GunModel)
            Get #intFF, , GunModel(lngA).ID
            Get #intFF, , lngCount
            GunModel(lngA).name = Space$(lngCount)
            Get #intFF, , GunModel(lngA).name
        Next lngA
        OpenModels = True
    End If
ErrorHandler:
    Close #intFF
End Function

Private Sub Form_Load()

    MalliLista.Clear
    OpenModels ("D:\DATA\GunModels.DAT")
    For a = 0 To UBound(GunModel)
        Editor_Models.MalliLista.AddItem (GunModel(a).name)
    Next a
End Sub

''''''''''''
Tallennus


Public Function SaveModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long
    ' tuhoa tiedosto jos jo olemassa
    If Len(Dir$(Filename)) Then Kill Filename
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Write As #intFF
    Put #intFF, , UBound(GunModel) + 1
    For lngA = 0 To UBound(GunModel)
        Put #intFF, , GunModel(lngA).ID
        Put #intFF, , Len(GunModel(lngA).name)
        Put #intFF, , GunModel(lngA).name
    Next lngA
    SaveModels = True
ErrorHandler:
    Close #intFF
End FunctionPublic Function SaveModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long
    If Len(Dir$(Filename)) Then Kill Filename
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Write As #intFF
    Put #intFF, , UBound(GunModel) + 1
    For lngA = 0 To UBound(GunModel)
        Put #intFF, , GunModel(lngA).ID
        Put #intFF, , Len(GunModel(lngA).name)
        Put #intFF, , GunModel(lngA).name
    Next lngA
    SaveModels = True
ErrorHandler:
    Close #intFF
End Function

Public Sub Save_Click()
    dim a as integer
    a = UBound(GunModel) + 1
    ReDim GunModel(a)
    GunModel(a).ID = a
    GunModel(a).name = ModelName.Text
    If SaveModels("D:\DATA\GunModels.DAT") Then

        MsgBox "Tallennettu!"
    Else
        MsgBox "Virhe perkele!"
    End If
End Sub

' List1 on ListBox, joka sisältää nimet
' Text1 on TextBox, johon kirjoitetaan uusi nimi
' Command1 on CommandButton, joka lisää nimen listalle

Const tiedosto = "c:\omat\data.txt"

Sub Lataus()
    If Dir(tiedosto) = "" Then Exit Sub
    List1.Clear
    Open tiedosto For Input As #1
    Dim nimi As String
    Do Until EOF(1)
        Line Input #1, nimi
        List1.AddItem nimi
    Loop
    Close #1
End Sub

Sub Tallennus()
    Open tiedosto For Output As #1
    Dim i As Integer
    For i = 0 To List1.ListCount - 1
        Print #1, List1.List(i)
    Next
    Close #1
End Sub

Private Sub Command1_Click()
    List1.AddItem Text1.Text
End Sub

Private Sub Form_Load()
    Lataus
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Tallennus
End Sub