Keskustelu: Ohjelmointikysymykset: VB6: Tiedostosta haku

Olisi seuraavanlainen kysymys.

Olen tehnyt normaalin tallennuksen, jossa tallennetaan useammasta textboxista tietoja tekstitiedostoon.

Tiedostoon tulee rivejä tyyliin:

#Ekatieto
textbox1
textbox2
textbox3

#Tokatieto
Textbox1
textbox2
textbox3

ja jatkuu niin monella, kun on tallennettu.

kuinka saisin haettua tietoja tuosta siten, että listboxiin saisin luettelona kaikki # merkin jälkeiset sanat:
Listboxissa:
Ekatieto
Tokatieto
jne, jne

ja kun jotain noista klikkaa, saan sen tiedot haettua textboxeihin.

Tähän toivoisin hyvin yksinkertaista toimivaa esimerkkiä.
Itse tallennus on jo tehty, siis haku puuttuu.

Tällainen koodi tuli pikaisesti väännettyä. Form_Load:ssa luetaan rivit ListBoxiin ja List1_Click:ssä taas luetaan tiedot TextBoxeihin. HUOM! Koodia ei ole testattu käytännössä joten siinä voi olla vikaakin.

ListBox on koodissa nimellä List1 ja tiedosto josta luetaan on nimellä tekstitiedosto.

Private Sub Form_Load()

    Dim ff As Integer
    Dim rr As String
    ff = FreeFile

    Open tekstitiedosto For Input As #ff
        Do Until EOF(ff)
            Line Input #ff, rr: rr = Trim(rr)

            ' Jos luetun rivin 1. merkki on #, niin lisätään
            ' se List:iin
            If Mid$(rr, 1, 1) = "#" Then List1.AddItem Mid$(rr, 2, Len(rr) - 2)
        Loop
    Close #ff

End Sub

Private Sub List1_Click()

    Dim ff As Integer
    Dim rr As String
    Dim i As Integer
    Dim i2 As Integer
    Dim tiedot() As String

    ff = FreeFile
    i = 0
    i2 = 0

    Open tekstitiedosto For Input As #ff
        Do Until EOF(ff)
            Line Input #ff, rr: rr = Trim(rr)

            If Mid$(rr, 1, 1) = "#" Then

                ' Jos luettu rivi sisältää sekä # merkin, että
                ' List:stä klikatun rivin tekstin...
                If Mid$(rr, 2, Len(rr) - 2) = List1.List(List1.ListIndex) Then

                    Line Input #ff, rr: rr = Trim(rr)

                    Do Until Mid$(rr, 1, 1) <> "#" Or EOF(ff)
                        '... lisätään tiedot taulukkoon kunnes
                        ' tulee toinen # alkava rivi vastaan tai EOF

                        ' Seuraavan rivin voisi korvata paremmalla
                        ' tavalla, mutta se olisi lisännyt
                        ' koodin pituutta
                        ReDim Preserve tiedot(i)

                        tiedot(i) = rr
                        i = i + 1
                        Line Input #ff, rr: rr = Trim(rr)

                    Loop

                End If

            End If
        Loop
    Close #ff

    ' Lisätään tiedot TextBoxeihin
    Text1.Text = tiedot(0)
    Text2.Text = tiedot(1)
    Text3.Text = tiedot(2)
    ' ...
    ' jne. jne.

End Sub

Näyttäisi pikaisella katselmuksella olevan sellainen, jota juuri hain.... Vielä pitää testata käytännössä.

Kiitokset nopeasta vastauksesta.
Tuon tekstitiedoston joutui laittamaan lainausmerkkeihin, jotta se toimi.
Juu. sain tuon nyt muuten toimimaan, mutta se antaa tuossa lopussa virheilmoituksen.
Listboxiin toimii muuten oikein, mutta esim #eka tulostuu ek (ilman a kirjainta, kuten #toka jää myös viimeinen kirjain pois.
Klikatessa tulee virhe 9:
Subscript out of range
Näyttäisi olevan debugissa kohdassa tiedot(1), tiedot(2) ja tiedot(3) kohdissa.
MSDN:stä löytyi tuohon tietoa, mutta meni yli hilseen.
Vinkkejä?

lainaus:

Tuon tekstitiedoston joutui laittamaan lainausmerkkeihin, jotta se toimi.

Oletko tehnyt tallennuksen Write:lla (Write #tiednum, tekstiä) Print:n sijasta, vai teetkö tallennuksen jotenkin muulla tavalla?

lainaus:

mutta esim #eka tulostuu ek (ilman a kirjainta, kuten #toka jää myös viimeinen kirjain pois.

Tuon olisit varmaankin keksinyt itsekin miten korjata, mutta muuta Form_Load tapahtumasta löytyvä rivi

List1.AddItem Mid$(rr, 2, Len(rr) - 2)

muotoon

List1.AddItem Mid$(rr, 2, Len(rr) - 1)

lainaus:

Klikatessa tulee virhe 9:
Subscript out of range
Näyttäisi olevan debugissa kohdassa tiedot(1), tiedot(2) ja tiedot(3) kohdissa.

Minkä rivin se VB valaisee (yleensä keltaisella pohjalla) kun painat Debug-painiketta koodista kun tuo virhe tulee?

Tiedostoon kirjoittamisen olen tehnyt Printillä. Tosin tuota sorsaa varten tein testitiedoston notepadillä kirjoittamalla.

Tuon List toiminnon sainkin korjattua tutkimalla sitä hieman tarkemmin. (kokeilemalla)ja korjaus juuri niinkuin kerroit.

Tuo klikkaus on edelleen ongelma ja kaatuessaan keltaiseksi menee rivi:
Text1.Text = tiedot(0)

ja kun vien hiiren tuon tiedot(0) päälle, tulee teksti:
"text1.text=tiedot(0)=<subscript out of range>"

Eli kohdassa ' Lisätään tiedot TextBoxeihin

lainaus:

Tuo klikkaus on edelleen ongelma ja kaatuessaan keltaiseksi menee rivi:
Text1.Text = tiedot(0)

Taitaa olla nyt niin, että List1_Click tapahtuman sisin Do...Loop silmukka ei ajeta missään vaiheessa jolloin taulukkoakaan ei alusteta. Eli muuta rivi

If Mid$(rr, 2, Len(rr) - 2) = List1.List(List1.ListIndex) Then

'tähän muotoon

If Mid$(rr, 2, Len(rr) - 1) = List1.List(List1.ListIndex) Then

Tuossa siis tehtiin samanlainen korjaus kuin List1.AddItem -kohdallekin.

TÄmän tietenkin olen jo aikaisemmin koittanut eikä sekään ratkaissut tuota ongelmaa.

Koko tän päivän olen tuota nyt miettinyt, tutkinut, koittanut erivaihtoehtoja, mutta ei ole vielä auennut minulle missä se vika voisi olla. Loopit kyllä näyttäisi toimivan loppuun saakka. Tieto vaan ei mene taulukkoon tai sitten se on siellä jossain kumman muodossa.

PS. miten noita värikoodauksia saa tehtyä näihin viesteihin?

Ajoin vielä tuon koodin Debugin step introlla läpi ja huomasin, että tuo keskimmäinen looppi jäi suorittamatta, eli juuri taulukkoon tietojen hakemisen.
Eli tämä:

Do Until Mid$(rr, 1, 1) <> "#" Or EOF(ff)
                        '... lisätään tiedot taulukkoon kunnes
                        ' tulee toinen # alkava rivi vastaan tai EOF

                        ' Seuraavan rivin voisi korvata paremmalla
                        ' tavalla, mutta se olisi lisännyt
                        ' koodin pituutta
                        ReDim Preserve tiedot(i)

                        tiedot(i) = rr
                        i = i + 1
                        Line Input #ff, rr: rr = Trim(rr)

                    Loop

Joten taitaa tuossa aikaisemmassa IF lauseessa olla nyt joku buglos, koska se ei sitä suorita.

If Mid$(rr, 2, Len(rr) - 1) = List1.List(List1.ListIndex) Then

Vinkkejä?

No niin, testasin alla olevan koodin omalla koneellani ja nyt se toimii oikein. Siinä keskimmäisessä loopissa <> ehto piti tietenkin olla = (yhtäkuin) ehto. Lisäksi pari riviä tuli tuon loopin lisäksi heti sen alapuolelle.

Toimiva koodi kokonaisuudessaan:

Private Sub Form_Load()

    tekstitiedosto = App.Path & "\testi.txt"

    Dim ff As Integer
    Dim rr As String
    ff = FreeFile

    Open tekstitiedosto For Input As #ff
        Do Until EOF(ff)
            Line Input #ff, rr: rr = Trim(rr)

            ' Jos luetun rivin 1. merkki on #, niin lisätään
            ' se List:iin
            If Mid$(rr, 1, 1) = "#" Then List1.AddItem Mid$(rr, 2, Len(rr) - 1)
        Loop
    Close #ff

End Sub

Private Sub List1_Click()

    Dim ff As Integer
    Dim rr As String
    Dim i As Integer
    Dim tiedot() As String

    ff = FreeFile
    i = 0

    Open tekstitiedosto For Input As #ff
        Do Until EOF(ff)
            Line Input #ff, rr: rr = Trim(rr)

            If Mid$(rr, 1, 1) = "#" Then

                ' Jos luettu rivi sisältää sekä # merkin, että
                ' List:stä klikatun rivin tekstin...
                If Mid$(rr, 2, Len(rr) - 1) = List1.List(List1.ListIndex) Then

                    Line Input #ff, rr: rr = Trim(rr)

                    Do Until Mid$(rr, 1, 1) = "#" Or EOF(ff)
                        '... lisätään tiedot taulukkoon kunnes
                        ' tulee toinen # alkava rivi vastaan tai EOF

                        ' Seuraavan rivin voisi korvata paremmalla
                        ' tavalla, mutta se olisi lisännyt
                        ' koodin pituutta
                        ReDim Preserve tiedot(i)

                        tiedot(i) = rr
                        i = i + 1
                        Line Input #ff, rr: rr = Trim(rr)

                    Loop

                    ReDim Preserve tiedot(i)
                    tiedot(i) = rr

                End If

            End If
        Loop
    Close #ff

    ' Lisätään tiedot TextBoxeihin
    Text1.Text = tiedot(0)
    Text2.Text = tiedot(1)
    Text3.Text = tiedot(2)
    ' ...
    ' jne. jne.

End Sub

lainaus:

PS. miten noita värikoodauksia saa tehtyä näihin viesteihin?

Taisitkin jo keksiä miten niitä saa tehtyä?

No voi kiusus että taas oli pienestä kiinni.
Rupee jo tuntumaan, että mitä vaikeampi ongelma, niin sitä pienemmästä se on kiinni :)

Tuo värikoodaus löytyi, kun löysin ensin tän foorumin faqin.
En aluksi löytänyt sellaista millään, mutta vanhoja viestejä selatessa löytyi linkki sellaiseen.

Mutta eiköhän tämän taas tästä.

Seuraavaksi varmaan ryhdyn kehittelemään samalla systeemillä tuohon tiedon poistamista, joten varmaan kysymyksiä siitäkin tulee, jollei se itseltäni onnistu.
Eli pitää muutta toi list_click ensinnäkin tuplaklikkaukseksi, jotta voi suorittaa valinnan ja toisella painikkeella tehdä poiston.

Eli valitsen eka listboxista ja se poistaa sen tiedot.

Mutta nyt taas jatkamaan. eiköhän se tästä.

Foorumin FAQ löytyy ihan tuolta sivun yläreunasta mustalla tekstillä ja harmaalla pohjalla ;) (palkki jossa lukee "Etusivu : Oppaat : Koodivinkit ...). No hyvä että kuitenkin löytyi.

En tiedä sojottaako silmäni johonkin ihan kummaan suuntaan, mutta tuolta mainitsemastasi Faqista en sitä tietoa löytänyt. En vaikka kävin nyt uudestaan katsomassa.

Mutta eipä sillä minulle enään ole väliä, kun sen tiedon muualta sivustolta löysin ja nyt sitä osaan käyttääkin :)

Ai juu, ne löytyy tietenkin keskustelualueen ohje-sivulta. Linkki sivulle löytyy Keskustelu alueen etusivulta Ohjeet-linkin takaa.