Keskustelu: Ohjelmointikysymykset: Merkin haku tiedostosta (VB6)

function haesana(hakusana as string) as string

dim rivi as string 'rivin sisältö viedään tähän muuttujaan.
dim nonesko as integer 'palauttaa tiedon millä rivillä ollaan.
ff = freefile
Open "tiedosto.txt" For Input As #ff

Do Until EOF(1)
   Line Input #ff, rivi
   monesko = monesko + 1
   pilkottu = split(rivi, " | ") 'pilkotaan teksti

  if pilkottu(2) = hakusana then ' 0 = rivinumero, 1 = päivämäärä, 2 = sana
    haesana = "löytyi riviltä: " & monesko & "."
    close #ff
    exit function
  endif
Loop
Close #ff
haesana = "Ei löytynyt moista. :("
end function

Private Sub cmdwrite_Click()

'Määritellään muuttujat
Dim teksti As String, avattu As String, lukumaara As String
Dim pvm As Date

'Varoitus
On Error GoTo virhe

'Avataan tiedosto lukemista varten
Open "tiedot\arkisto.omg" For Input As #1
Do While Not EOF(1)
    Line Input #1, avattu
    lukumaara = lukumaara + vbNewLine + avattu
Loop

Close #1

'Kysytään käyttäjältä pvm ja kommentti
pvm = InputBox("Syötä koimmentoitava päivämäärä" & vbNewLine & "esim. DD.MM.YYYY")
teksti = InputBox("Syötä kommentti")
MsgBox ("Asetit päivämäärälle " & pvm & " kommentin " & teksti)

'Avataan tiedosto johon tulostetaan tiedostoon annetut tiedot
Open "tiedot\arkisto.omg" For Output As #1
    Print #1, rivinro & " | " & pvm & " | "; teksti & lukumaara


Close #1

rivinro = rivinro + 1

Exit Sub
virhe:
MsgBox ("Ohjelma teki valitettavsti virheen tiedostojen puuttuessa. Mikäli et ole luonut tiedostoa, paina 'Luo tiedosto' - nappulaa ja käynnistä ohjelma uudestaan.")

End Sub

'Lomakkeelle:
'2 tekstiruutu-objektia ja 3 komentopainike-objektia
Private Sub Form_Load()

  'asetetaan komentopainikkeiden tekstit
  Command1.Caption = "Tallenna"
  Command2.Caption = "Avaa"
  Command3.Caption = "Etsi"

End Sub

Private Sub Command1_Click()


  'jos tekstiruutu 'Text1' on tyhjä
  'asetetaan fokus tekstiruudulle 'Text1',
  'annetaan äänimerkki ja poistutaan aliohjelmasta
  If Text1.Text = "" Then
   Text1.SetFocus: Beep: Exit Sub
  End If

  'Tyhjennetään tekstiruutu 'Text2'
  Text2.Text = ""

  Dim data As String, taulukko() As String, _
  apu1() As String, apu2() As String, _
  tapaus As Integer, numero As Integer
  data = "": tapaus = 0: numero = 1

  'virhetilanteessa siirrytään seuraavaan tehtävään...
  On Error Resume Next

  'avataan tekstitiedosto lukutilaan...
  Open App.Path & "\tiedostonimi.ext" For Input As #1
  '(.ext = tarkennin)

  'jos tapahtui virhe...
  If Err > 0 Then
    'tyhjennetään virheolio ja nollataan virhe...
    Err.Clear: On Error GoTo 0

    'estetään komentopainikkeiden
    'Command2 ja Command3 käyttö...
    Command2.Enabled = False
    Command3.Enabled = False
  Else

    'luetaan kerralla koko tiedoston sisältö muuttujaan...
    data = Input$(LOF(1), 1)

    'suljetaan tiedosto
    Close #1

    'erotellaan tiedoston rivit taulukkoon...
    taulukko = Split(Left(data, Len(data) - 1), vbCrLf)

    'erotellaan taulukon alimman indeksin alkion
    'merkkijono aputaulukkoon (tiedoston ensimmäisen rivin osat)...
    apu1 = Split(taulukko(LBound(taulukko)), " | ")

    'erotellaan taulukon ylimmän indeksin alkion
    'merkkijono aputaulukkoon (tiedoston viimeisen rivin osat)...
    apu2 = Split(taulukko(UBound(taulukko)), " | ")

    'mikäli haluat käyttää sellaista tapaa, että...
    Select Case Val(Trim(apu1(LBound(apu1))))

      'viimeksi lisätty tieto on tiedoston viimeinen rivi
      Case Is < Val(Trim(apu2(LBound(apu2))))
      tapaus = 0: numero = Val(Trim(apu2(LBound(apu2)))) + 1

      'viimeksi lisätty tieto on tiedoston ensimmäinen rivi
      Case Is > Val(Trim(apu2(LBound(apu2))))
        tapaus = 1: numero = Val(Trim(apu1(LBound(apu1)))) + 1

      'mikäli tiedostossa on vain yksi rivi
      Case Is = Val(Trim(apu2(LBound(apu2))))

       'viesti-ikkuna ilmestyy näkyviin...
       msg& = MsgBox("Lisätäänkö rivit tiedoston alkuun", _
       vbQuestion + vbYesNo, App.Title)

       Select Case msg&

        'jos vastataan 'Kyllä'
        Case 6
          tapaus = 1: numero = 2

        'jos vastataan 'EI'
        Case 7
          tapaus = 0: numero = 2

      End Select

    End Select

  End If

  'avataan tekstitiedosto "kirjoitustilaan"
  '(itseasiassa luodaan tiedosto jonka sisältö on
  'tyhjä merkkijono ""... jos samassa kansiossa on
  'jo samanniminen tiedosto se tuhotaan ja tilalle
  'luodaan uusi "tyhjä" tiedosto samalla nimellä)
  Open App.Path & "\tiedostonimi.ext" For Output As #1

  'mikäli
  Select Case tapaus

    'jos tapaus on...
    Case 0

      'lisätään merkkijonomuuttujan 'data' tekstisisältöön
      'muuttujan numero' tekstiksi muutetun arvon, merkkijonon
      '" | ", 'päivämäärän, merkkijonon " | " ja tekstiruudun
      'Text1' tekstin yhdistelmästä 'muodostuva merkkijono...
      data = data & CStr(numero) _
      & " | " & Format$(Date, "dd.mm.yyyy") _
      & " | " & Text1.Text

    'jos tapaus on...
    Case 1

     'korvataan merkkijonomuuttujan 'data'
     'tekstisisältö muuttujan 'numero' tekstiksi muutetun
     'arvon, merkkijonon " | ", päivämäärän, merkkijonon
     '" | ", tekstiruudun Text1' tekstin', rivinvaihto-
     'merkkien, sekä muuttujan 'data' tekstisisällön
     'yhdistelmästä muodostuvalla merkkijonolla....
     data = CStr(numero) & " | " & _
     Format$(Date, "dd.mm.yyyy") & " | " & _
     Text1.Text & vbCrLf & data

  End Select

  'kirjoitetaan muuttujan 'data' tekstisisältö
  'tiedostoon ja suljetaan avoin tiedosto...
  Print #1, data: Close #1

  'tyhjennetään tekstiruutu 'Text1'
  Text1.Text = ""

  'jos komentopainikkeen Command2 käyttö
  'on estetty sallitaan painikkeen käyttö...
  Command2.Enabled = True

End Sub

Private Sub Command2_Click()

  'virhetilanteessa siirrytään seuraavaan tehtävään...
  On Error Resume Next

  'avataan tekstitiedosto lukutilaan...
  Open App.Path & "\tiedostonimi.ext" For Input As #1

  'jos tapahtui virhe...
  If Err > 0 Then
    'tyhjennetään virheolio ja nollataan virhe...
    Err.Clear: On Error GoTo 0

    'estetään komentopainikkeiden
    'Command2' ja ’Command3’ käyttö...
    Command2.Enabled = False
    Command3.Enabled = False

    'ilmoitetaan viesti-ikkunassa, että...
    MsgBox "Tiedostoa ei ole", vbExclamation, App.Title

    'ja asetetaan fokus tekstiruudulle 'Text1'
    Text1.SetFocus

  'muutoin...
  Else
    'luetaan koko tiedosto kerralla tekstiruutu
    'Text2' tekstiksi ja suljetaan tiedosto
    Text2.Text = Input$(LOF(1), 1): Close #1
  End If

End Sub

Private Sub Command3_Click()

  If Text1.Text = "" Then
    Text1.SetFocus: Beep: Exit Sub
  End If

  'alustetaan kaksi yhden alkion taulukkomuuttujaa
  Dim data(0) As String, laskuri(0) As Integer

  On Error Resume Next

  Open App.Path & "\tiedostonimi.ext" For Input As #1

  If Err > 0 Then

    Command2.Enabled = False
    Command3.Enabled = False

    MsgBox Error$, vbExclamation, App.Title
    Err.Clear: On Error GoTo 0: Exit Sub
  Else
    Text2.Text = ""
    Do While Not EOF(1)
      Input #1, data(0)

      'tutkitaan InStr-funktion avulla taulukkomuuttujan
      'data ainoaan alkioon (0) luetun tiedoston rivin merkkijono
      If InStr(data(0), Text1.Text) > 0 Then

        'ja jos merkkijonon sisältä löytyy tekstiruudun 'Text1'
        'tekstiä vastaavaa merkkijono kasvatetaan taulukkomuuttujan
        'laskuri' ainoan alkion (0) arvoa yhdellä...
        laskuri(0) = laskuri(0) + 1

        'lisätään tekstiruutu 'Text2' tekstisisältöön merkkijonosta
        '"Rivi ", tekstiksi muunnetun taulukkomuuttujan 'laskuri'
        'alkion arvosta, taulukkomuuttujan data alkion merkkijonosta
        'ja rivinvaihtomerkeistä muodostuva merkkijono...
        Text2.Text = Text2.Text & "Rivi " & CStr(laskuri(0)) _
        & "  data:" & data(0) & vbCrLf

        'ilmoitetaan etsinnän tuloksesta viesti-ikkunassa
        'ja asetetaan vaihtoehdoiksi etsinnän jatkaminen/
        'keskeyttäminen...
        msg& = MsgBox(CStr(laskuri(0)) & ". hakuehtoa vastaava tieto  " _
        & vbCrLf & " löytyi  Jatketaanko etsintää", _
        vbQuestion + vbYesNo, App.Title)

        Select Case msg&
          Case 7
           'Jos valitaan 'Ei' suljetaan tiedosto,
           'pyyhitään taulukot pois muistista
           'ja poistutaan aliohjelmasta...
           Close #1: Erase data, laskuri: Exit Sub
        End Select
      End If
    Loop

    'suljetaan tiedosto ja pyyhitään taulukot pois muistista
    Close #1: Erase data, laskuri
  End If

End Sub