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