Gestione registrazioni

Télécharger le projet
Commenter

Description

Gestione registrazioni una tabella per gestire le registrazioni sito,username,password,e-mail

Source / Exemple : 


Option Explicit

Public gstrMess As String
Public gstrTitle As String
Public gintStyle As Integer

Dim mstrSite(1 To 100) As String

Dim mstrName(1 To 100) As String
Dim mstrUtente(1 To 100) As String
Dim mstrPass(1 To 100) As String
Dim mstrEmail(1 To 100) As String

Dim LI As ListItem

Private Sub cmdEdit_Click()
On Error Resume Next
    Dim X, Y As Integer
    
    Y = 0
    For X = 0 To 3
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Nessun elemento selezionato oppure campi vuoti"
        gstrTitle = "Error...Edita "
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If

    Set LI = lvSites.ListItems(lblKey.Caption)
    LI.Text = txtsite(0).Text
    LI.SubItems(1) = txtsite(1).Text
    LI.SubItems(2) = txtsite(2).Text
    LI.SubItems(3) = txtsite(3).Text

    Call proClearFields

End Sub

Private Sub cmdDelete_Click()
On Error Resume Next
    Dim X, Y As Integer

    
    Y = 0
    For X = 0 To 1
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Selezionare un nome nell' elenco."
        gstrTitle = "Error...Rimuovi"
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If
    lvSites.ListItems.Remove (lblKey.Caption)
    
    Call proClearFields
End Sub

Private Sub cmdAdd_Click()
On Error Resume Next
    Dim X, Y As Integer
    
    Y = 0
    For X = 0 To 1
        If txtsite(X).Text = "" Then
            Y = Y + 1
        End If
    Next X
    If Y <> 0 Then
        gstrMess = "Riempire i campi vuoti."
        gstrTitle = "Error...Aggiungi "
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
        Exit Sub
    End If

    Set LI = lvSites.ListItems.Add()
    LI.Text = txtsite(0).Text
    LI.SubItems(1) = txtsite(1).Text
    LI.SubItems(2) = txtsite(2).Text
    LI.SubItems(3) = txtsite(3).Text
    
    Call proClearFields
End Sub

Private Sub cmdDown_Click()
On Error Resume Next
    Dim X As Integer
    Dim strSite(0 To 4) As String
    If lvSites.SelectedItem.Index = lvSites.ListItems.Count Then
        Set lvSites.DropHighlight = lvSites.SelectedItem
    Else
        X = lvSites.SelectedItem.Index
        strSite(0) = lvSites.SelectedItem.Key
        strSite(1) = lvSites.SelectedItem.Text
        strSite(2) = lvSites.SelectedItem.SubItems(1)
        strSite(3) = lvSites.SelectedItem.SubItems(2)
        strSite(4) = lvSites.SelectedItem.SubItems(3)
        lvSites.ListItems.Remove X
        Set LI = lvSites.ListItems.Add(X + 1, strSite(0), strSite(1))
        LI.SubItems(1) = strSite(2)
        LI.SubItems(2) = strSite(3)
        LI.SubItems(3) = strSite(4)
        Set lvSites.SelectedItem = lvSites.ListItems(X + 1)
        Set lvSites.DropHighlight = lvSites.SelectedItem
    End If
End Sub

Private Sub cmdUp_Click()
On Error Resume Next
    Dim X As Integer
    Dim strSite(0 To 4) As String
    If lvSites.SelectedItem.Index = 1 Then
        Set lvSites.DropHighlight = lvSites.SelectedItem
    Else
        X = lvSites.SelectedItem.Index
        strSite(0) = lvSites.SelectedItem.Key
        strSite(1) = lvSites.SelectedItem.Text
        strSite(2) = lvSites.SelectedItem.SubItems(1)
        strSite(3) = lvSites.SelectedItem.SubItems(2)
        strSite(4) = lvSites.SelectedItem.SubItems(3)
        lvSites.ListItems.Remove X
        Set LI = lvSites.ListItems.Add(X - 1, strSite(0), strSite(1))
        LI.SubItems(1) = strSite(2)
        LI.SubItems(2) = strSite(3)
        LI.SubItems(3) = strSite(4)
        Set lvSites.SelectedItem = lvSites.ListItems(X - 1)
        Set lvSites.DropHighlight = lvSites.SelectedItem
    End If
End Sub

Private Sub Command1_Click()
    Call proClearFields
End Sub

Private Sub Form_Load()
    Me.Top = (Screen.Height - Me.Height) / 2
    Me.Left = (Screen.Width - Me.Width) / 2
    
    Call GetSitesList
End Sub

Public Sub GetSitesList()

    Dim X, Y, intFree As Integer
    
   
    
    intFree = FreeFile
    X = 1
    Open App.Path & "\Sites.dat" For Input As #intFree
        Do Until EOF(intFree)
            Input #intFree, mstrName(X), mstrUtente(X), mstrPass(X), mstrEmail(X)
            X = X + 1
        Loop
    Close
    
    lvSites.ListItems.Clear
    For Y = 1 To X - 1
        Set LI = lvSites.ListItems.Add()
        LI.Key = CStr(Y & "A")
        LI.Text = mstrName(Y)
        LI.SubItems(1) = mstrUtente(Y)
        LI.SubItems(2) = mstrPass(Y)
        LI.SubItems(3) = mstrEmail(Y)
    Next Y
    
    Call proClearFields

    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim X, intFree As Integer
    intFree = FreeFile
    
    Open App.Path & "\Sites.dat" For Output As #intFree
    For X = 1 To lvSites.ListItems.Count
        Write #intFree, lvSites.ListItems(X).Text, lvSites.ListItems(X).SubItems(1), lvSites.ListItems(X).SubItems(2), lvSites.ListItems(X).SubItems(3)
    Next X

End Sub

Private Sub lvSites_Click()
    txtsite(0).Text = lvSites.SelectedItem.Text
    txtsite(1).Text = lvSites.SelectedItem.SubItems(1)
    txtsite(2).Text = lvSites.SelectedItem.SubItems(2)
    txtsite(3).Text = lvSites.SelectedItem.SubItems(3)
    lblKey.Caption = lvSites.SelectedItem.Key
End Sub

Public Sub proClearFields()
    Dim Y As Integer
    
    For Y = 0 To 3
        txtsite(Y).Text = ""
    Next Y
    lblKey.Caption = ""
End Sub

Private Sub cmdClose_Click()
     gstrMess = "Gestione registrazioni by Stefano (CH)"
        gstrTitle = "Gestione registrazioni"
        gintStyle = gStyle
        MsgBox gstrMess, gintStyle, gstrTitle
    Unload Me
End Sub

---------------------------------------------------------------
.BAS

Option Explicit

Public gstrMess As String
Public gstrTitle As String
Public gintStyle As Integer
Public Const gStyle = vbOKOnly + vbApplicationModal + vbExclamation + vbDefaultButton1
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.