Keskustelu: Ohjelmointikysymykset: [VB6] Typen tallennuttaminen ja lataaminen

Syntty [05.03.2009 07:47:12]

Eli, minulla on nyt Type joka tarvisi ensin saada tallennettua ja sitten haettua listboxiin. Tässä on nykyinen ei toimiva koodini:

'Tehdään wrestler type
Type wrestler1
    id As Integer
    lname As String
    sname As String
End Type

'Asetetaan arvot, että olisi jotain sisältöä tallentamiseen.
Dim wres As wrestler1
wres.id = numwrestlers + 1
wres.lname = "Pekka"
wres.sname = "Pekkala"

Eli, nyt nämä tiedot tarvisi saada tallennettua tekstitiedostoon ja myöhemmin ladata ne niin, että painijan nimi näkyisi listboxissa ja nimeä painamalla tiedot näkyisivät käyttäjälle.

Merri [05.03.2009 13:14:20]

Asettamalla merkkijonoille pituuden tyyliä As String * 50 saat tehtyä UDT:stä tasapituisen, joka mahdollistaa sen tallentamisen ja lataamisen helpolla tavalla. Mikäli haluat ehdottomasti että merkkijonot ovat minkä tahansa pituisia, niin sitten joudut kirjoittamaan oman lataus- ja kirjoitusrutiinin. Yksinkertaisimmillaan tallentaisit ensin Integerin, sitten kaksi Longia jotka kertoisivat molempien merkkijonojen pituudet ja sitten kirjoittaisit merkkijonot peräkkäin. Ladattaessa sitten lukisit Integer-arvosi ja tallentaisit sen UDT:hen, sitten loisit merkkijonotbufferit kahden Long-arvon perusteella ja lukisit merkkijonot.

Juhko [05.03.2009 13:17:48]

Kannattaisi laittaa painijat taulukoihin, eli esimerkiksi:

Dim wres(9) As wrestler1 'kymmenen painijaa

Tämä on aika huono tapa tallennukseen/lataukseen, mutta silti käyttökelpoinen:

Dim i As Integer

Open "tiedosto.txt" For Output As #1
For i = 0 To 9
    Print #1, LTrim$(RTrim$(Str$(wres(i).id)))
    Print #1, wres(i).lname
    Print #1, wres(i).sname
Next i
Close #1

ListBox-koodia en rupea nyt vääntämään, mutta lataus:

Dim i As Integer
Dim tmpStr As String 'väliaikainen string

Open "tiedosto.txt" For Input As #1
For i = 0 To 9
    Line Input #1, tmpStr
    wres(i).id = Val(tmpStr)
    Line Input #1, wres(i).lname
    Line Input #1, wres(i).sname
    'tähän ListBoxin käsittelykoodi
Next i
Close #1

Syntty [05.03.2009 15:12:38]

Hmm... Mietein juuri, että olisiko tämä tapa käyttökelpoinen?

   'tallennus
Open App.Path + "\DATA\wrestlers.DAT" For Binary As #1
Put #1, wres.id, wres
List1.AddItem (wres.lname)
Close #1

'lataus
Open App.Path + "\DATA\wrestlers.DAT" For Binary As #1
For id = 1 To numwrestlers
Get #1, id, wres
List1.AddItem (wres.lname)
Next id
Close #1

Juhko [05.03.2009 20:01:14]

Ei olisi. Record numberit menee sekaisin. Paitsi jos nimen pituus on rajoitettu, ja id:t menevät esim. 1, 50, 101, 151 jne.

Merri [06.03.2009 12:42:51]

Option Explicit

Private Type WrestlerInfo
    ID As Integer
    fName As String     ' etunimi (first name)
    lName As String     ' sukunimi (last name)
    rName As String     ' paininimi (ring name)
End Type

Dim Wrestler() As WrestlerInfo

Public Function OpenWrestlers(Filename As String) As Boolean
    Dim intFF As Integer, lngA As Long, lngCount As Long
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Read As #intFF
    ' luetaan lukumäärä
    Get #intFF, , lngCount
    ' tarkista lukumäärä
    If lngCount > 0 Then
        ' varaa muisti
        ReDim Wrestler(lngCount - 1)
        ' lue painijat
        For lngA = 0 To UBound(Wrestler)
            Get #intFF, , Wrestler(lngA).ID
            ' merkkijonojen pituudet, varaa bufferi
            Get #intFF, , lngCount
            Wrestler(lngA).fName = Space$(lngCount)
            Get #intFF, , lngCount
            Wrestler(lngA).lName = Space$(lngCount)
            Get #intFF, , lngCount
            Wrestler(lngA).rName = Space$(lngCount)
            ' lue merkkijonot
            Get #intFF, , Wrestler(lngA).fName
            Get #intFF, , Wrestler(lngA).lName
            Get #intFF, , Wrestler(lngA).rName
        Next lngA
        OpenWrestlers = True
    End If
ErrorHandler:
    Close #intFF
End Function

Public Function SaveWrestlers(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
    ' tallenna lukumäärä
    Put #intFF, , UBound(Wrestler) + 1
    ' tallenna kaikki painijat
    For lngA = 0 To UBound(Wrestler)
        ' tallenna ID
        Put #intFF, , Wrestler(lngA).ID
        ' tallenna merkkijonojen pituudet
        Put #intFF, , Len(Wrestler(lngA).fName)
        Put #intFF, , Len(Wrestler(lngA).lName)
        Put #intFF, , Len(Wrestler(lngA).rName)
        ' tallenna merkkijonot
        Put #intFF, , Wrestler(lngA).fName
        Put #intFF, , Wrestler(lngA).lName
        Put #intFF, , Wrestler(lngA).rName
    Next lngA
    SaveWrestlers = True
ErrorHandler:
    Close #intFF
End Function

Private Sub Form_Load()
    If OpenWrestlers("c:\test.wre") Then MsgBox "Luettiin " & (UBound(Wrestler) + 1) & " painijan tiedot!": Exit Sub
    ReDim Wrestler(2)
    With Wrestler(0)
        .ID = 1
        .fName = "Shawn"
        .lName = "Michaels"
        .rName = "HBK"
    End With
    With Wrestler(1)
        .ID = 2
        .fName = "John"
        .lName = "Layfield"
        .rName = "JBL"
    End With
    With Wrestler(2)
        .ID = 3
        .fName = "Kofi"
        .lName = "Kingston"
        .rName = "Kofi"
    End With
    If SaveWrestlers("c:\test.wre") Then
        MsgBox "Tallennus onnistui!"
    Else
        MsgBox "Tallennus epäonnistui :/"
    End If
End Sub

Syntty [06.03.2009 14:10:49]

Kiitos. Kokeilen tuota myöhemmin!

Syntty [08.03.2009 22:19:22]

Juu, eli sain tämän viimeinkin toimimaan :) Kiitos Merrille tuosta koodista!

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu