Gestione registrazioni

Soyez le premier à donner votre avis sur cette source.

Vue 4 251 fois - Téléchargée 428 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
mercredi 1 novembre 2006
Statut
Membre
Dernière intervention
15 novembre 2006

Grazie delle traduzioni BruNews

Sechaud grazie

ci sono ancora problemi da risolvere con i bottoni per spostare i elementi su e giu
Messages postés
288
Date d'inscription
jeudi 28 octobre 2004
Statut
Membre
Dernière intervention
3 janvier 2017

Très bonne idée ce programme.Je le trouve utile.
Deux petites remarques:
1°_Si on sort par CmdClose on ne sauve pas, contrairement à la croix.
Il suffit de recopier la partie qui le fait, dans CmdClose

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
End Sub
2°_Si on met le lblKey à Visible, on constate que le dernier ajoût ne s'affiche pas dans lblKey.On ne le voit qu'après rechargement du programme.
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
17
Belle brunews la traduction... ;)

Prendi cento euro con traduzione ?
++
Messages postés
21042
Date d'inscription
jeudi 23 janvier 2003
Statut
Modérateur
Dernière intervention
21 août 2019
20
DESCRIPTION:
Gestione registrazioni una tabella per gestire le registrazioni sito,username,password,e-mail
Tableau pour gérer les enregistrements de site,username,password,e-mail
---------------
gstrMess = "Nessun elemento selezionato oppure campi vuoti"
gstrMess = "Aucun élément sélectionné ou champs vides"
...
gstrMess = "Selezionare un nome nell' elenco."
gstrTitle = "Error...Rimuovi"
gstrMess = "Sélectionner un nom dans la liste."
gstrTitle = "Erreurr...Enlève"
...
gstrMess = "Riempire i campi vuoti."
gstrTitle = "Error...Aggiungi "
gstrMess = "Remplir les champs vides."
gstrTitle = "Erreur...Ajoute "
-------
Boutons:
svuota : vider
rimuovi : enlever
salva e esci : sauve et quitte
edita : edite
aggiungi : ajoute

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.