Keskustelu: Ohjelmointikysymykset: VB6: Valokuvatietokanta (VB)

Option Explicit

Private Type Henkilotietue
    etunimi As String * 15
    sukunimi As String * 25
End Type

Const MyName As String = "Muutos"

Private Sub Command1_Click()
    Dim YhdenTietueenPituus As Long, TietueidenLukumaara As Long, TiedostonPituus As Long
    Dim UusiSukunimi As String, UusiEtunimi As String, abu As String
    Dim Nimet As Henkilotietue
    Dim muutos As Boolean
    Dim i As Integer

    YhdenTietueenPituus = Len(Nimet)
    Open App.Path & "\nimet.rnd" For Random As #1 Len = YhdenTietueenPituus
        TiedostonPituus = LOF(1)
        TietueidenLukumaara = TiedostonPituus / YhdenTietueenPituus

        If TietueidenLukumaara = 0 Then
            MsgBox "Ei vielä nimiä tiedostossa." & vbCrLf & _
              "Lisää ensimmäinen.", vbInformation, MyName
            i = 1
        Else
            Do
                abu = InputBox("Anna indeksi, väliltä 1-" & Str(TietueidenLukumaara), _
                  MyName)
                If abu = "" Then Exit Sub 'Peruttu aliohjelman suoritus
                If IsNumeric(abu) Then 'Jos kyseessä on numero...
                    i = CInt(abu)
                    If i > TietueidenLukumaara Then
                        If MsgBox("Haluatko lisätä uuden nimen?", vbYesNo, MyName) = _
                          vbYes Then
                            i = TietueidenLukumaara + 1
                            Exit Do 'niin päästään pois do-loopista
                        End If
                    Else
                        Exit Do 'niin päästään pois do-loopista
                    End If
                End If
            Loop
        End If

        Get #1, i, Nimet

        Do
            UusiSukunimi = InputBox$("Muuta sukunimeä (Cancel tyhjää tietueen)", _
              MyName, Nimet.sukunimi)
            If Len(UusiSukunimi) > 25 Then
                If MsgBox("Sukunimen pituus voi olla max 25 merkkiä." & vbCrLf & _
                  "Leikataanko ylimääräiset pois?", vbQuestion + vbYesNo, MyName) = vbYes Then _
                  Exit Do
            End If
        Loop Until Len(UusiSukunimi) <= 25
        If UusiSukunimi <> Nimet.sukunimi Then 'Sukunimi muuttunut?
            Nimet.sukunimi = UusiSukunimi
            muutos = True
        End If

        Do
            UusiEtunimi = InputBox$("Muuta etunimeä (Cancel tyhjää tietueen)", _
              MyName, Nimet.etunimi)
            If Len(UusiEtunimi) > 15 Then
                If MsgBox("Etunimen pituus voi olla max 15 merkkiä." & vbCrLf & _
                  "Leikataanko ylimääräiset pois?", vbQuestion + vbYesNo, MyName) = vbYes Then _
                  Exit Do
            End If
        Loop Until Len(UusiEtunimi) <= 15
        If UusiEtunimi <> Nimet.etunimi Then 'Etunimi muuttunut?
            Nimet.etunimi = UusiEtunimi
            muutos = True
        End If

        If muutos Then 'Jos muutoksia, niin sijoitetaan ne tiedostoon
            Put #1, i, Nimet
            MsgBox "Etu- ja/tai sukunimi muuttunut." & vbCrLf & "Päivitetään...", _
              vbInformation, MyName
        Else
            MsgBox "Ei muutoksia", , MyName
        End If

    Close #1

End Sub