LISTATO 1 Il listato della soluzione dell'esercizio proposto nella scorsa lezione


Private Type DatiURL

  Indirizzo As String * 100

  Descrizione As String * 100

  Cancellato As Boolean

End Type



Dim Posizione As Long

Dim LunghezzaRecord As Long



Private Sub Form_Load()

  Dim Dato As DatiURL

  LunghezzaRecord = Len(Dato)

  Open "archivio.dat" For Random As #1 Len = LunghezzaRecord

  Posizione = 1

  LeggiRecord

End Sub



Function LeggiRecord() As Boolean

   Dim Dato As DatiURL

   Get #1, Posizione, Dato

   If Not Dato.Cancellato Then

     txtURL.Text = Dato.Indirizzo

     txtDescrizione.Text = Dato.Descrizione

   End If

   LeggiRecord = Not Dato.Cancellato

End Function



Sub ScriviRecord(Cancella As Boolean)

   Dim Dato As DatiURL

   Dato.Indirizzo = txtURL.Text

   Dato.Descrizione = txtDescrizione.Text

   Dato.Cancellato = Cancella

   Put #1, Posizione, Dato

End Sub



Function ContaRecord() As Long

  ContaRecord = (LOF(1) / LunghezzaRecord)

End Function



Private Sub Ripristina()

  Dim i As Long

  Dim NumElementi As Long

  Dim Dato As DatiURL

  NumElementi = ContaRecord()

  For i = 1 To NumElementi

    Get #1, i, Dato

    Dato.Cancellato = False

    Put #1, i, Dato

  Next i

End Sub



Private Sub CompattaFile()

  Dim Dato As DatiURL

  Dim Lunghezza As Long

  Dim NumElementi As Long

  Dim i As Long

  NumElementi = ContaRecord()



  Open "temp.dat" For Random As #2 Len = LunghezzaRecord

  For i = 1 To NumElementi

    Get #1, i, Dato

    If Not Dato.Cancellato Then

      Put #2, , Dato

    End If

  Next i

  Close #1, #2

  Kill "archivio.dat"

  Name "temp.dat" As "archivio.dat"

  Open "archivio.dat" For Random As #1 Len = LunghezzaRecord

End Sub



Private Sub btnNuovo_Click()

   txtURL.Text = ""

   txtDescrizione.Text = ""

   Posizione = 1 + ContaRecord()

   ScriviRecord False

End Sub



Private Sub BtnSalva_Click()

  ScriviRecord False

End Sub



Private Sub btnPrecedente_Click()

  Dim Termina As Boolean

  Do

    If Posizione > 1 Then

      Posizione = Posizione - 1

      Termina = LeggiRecord()

    Else

      Termina = True

    End If

  Loop Until Termina

End Sub



Private Sub btnSuccessivo_Click()

  Dim Termina As Boolean

  Do

    If Posizione < ContaRecord() Then

      Posizione = Posizione + 1

      Termina = LeggiRecord()

    Else

      Termina = True

    End If

  Loop Until Termina

End Sub



Private Sub btnCancella_Click()

  ScriviRecord True

End Sub



Private Sub btnRipristina_Click()

  Ripristina

End Sub



Private Sub btnCompatta_Click()

  CompattaFile

End Sub



Private Sub Form_Unload(Cancel As Integer)

  Close #1

End Sub