Bonjour j'ai cru remarqué que beaucoup de personnes voudraient avoir un code d'activation pour leurs BDD. j'ai ai créer un qui fonctionne mais qui ne sécurise en rien devant quelqu'un qui si connait. Pour les commun des mortels ce code fonctionne a merveille. Simple il permet de donner un semblant de professionnalisme à votre base.
Bien sur si il y a des personnes qui désire rajouter des bouts de code visant une génération du code lui-même est la bienvenue. j'aimerai que vous mettiez un post si vous le faite merci.
Premièrement vous devez créer ou avoir un menu général. Dans celui-ci vous créer vos textbox contenant mot de passe et utilisateur avec les propriété visible a [true]. sur le même formulaire en mode création vous créer un autres textbox clé d'activation et un bouton "activer" avec les propriété visible à "False". Moi j'ai ajouté une étiquette contenant un text en rouge "Période d'évaluation terminé" nommée "PET". Donc lorsque la base n'est plus utilisable après une période déterminé ou un nombre d'utilisation déterminé l'utilisateur doit entrer un clé pré-déterminé sans quoi utilisation impossible.
Vous devez créer une table que j'ai nommé "démo" contenant plusieurs valeurs soit :
1-Compteur "Numérique"
2-Active "oui/non"
3-Premiereinstallation "oui/non"
4-dateinstallation "date/heure"
premier bout de code dans le menu général au Form Load :
Sur Événement click du bouton quitter de votre formulaire :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54 Private Sub Form_Load() Dim base_active As Boolean Dim Compteur As Integer Dim dateinstallation As Date dateinstallation = Nz(DLookup("DateInstallation", "tbl_demo"), 0) Compteur = Nz(DMax("Compteur", "tbl_demo"), 0) base_active = Nz(DLookup("active", "tbl_demo"), "") If base_active = True Then Me.utilisateur.Visible = True Me.motdepasse.Visible = True Me.entrer.Visible = True Me.PET.Visible = False Me.codeactivation.Visible = False Me.quitter.SetFocus Me.activer.Visible = False Me.utilisateur = Null Me.motdepasse = Null Me.utilisateur.SetFocus Exit Sub Else If Compteur > 30 Or date > dateinstallation + 30 Then 'Variable à determiné par vous soit + 30 pour 1 mois !! MsgBox "La période d'évaluation du produit a expiré." & _ vbCrLf & "Pour accèder de nouveau à la base de donnée contacter "Votre nom" à l'adresse ------@----.com !", _ vbExclamation, "Période d'Évaluation Terminée !" Me.quitter.SetFocus 'set le focus sur un bouton afin d'enlever la fonction active des des textbox. Me.Utilisateur.Visible = False Me.motdepasse.Visible = False Me.entrer.Visible = False 'bouton "entrer" normal du form Me.PET.Visible = True Me.codeactivation.Visible = True Me.activer.Visible = True 'bouton activer lorsque période d'évaluation est terminé Me.codeactivation.SetFocus Else Me.utilisateur.Visible = True Me.motdepasse.Visible = True Me.entrer.Visible = True Me.PET.Visible = False Me.codeactivation.Visible = False Me.quitter.SetFocus Me.activer.Visible = False Me.utilisateur = Null Me.motdepasse = Null Me.utilisateur.SetFocus Exit Sub End If End If End Sub
code pour l'événement click du bouton activer (Qui est normalement caché si toujour en version Évaluation :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25 Private Sub quitter_Click() Dim base_active As Boolean Dim MaBD As Database Dim MonAppli As Recordset Dim NumCompteur As Integer base_active = Nz(DLookup("active", "tbl_demo"), "") If base_active = False Then Set MaBD = CurrentDb() NumCompteur = Nz(DMax("Compteur", "tbl_demo"), 0) + 1 Set MonAppli = MaBD.OpenRecordset("tbl_demo") MonAppli.AddNew MonAppli!Compteur = NumCompteur MonAppli.update MonAppli.Close DoCmd.Quit Else DoCmd.Quit End If End Sub
La date d'installation que vous voyer dans ce code est créer au premier démarrage de la base. donc avant de donner votre appli vous devez cocher dans cette table la colonne première installation.Ce qui permettra de copier la date de premier démarrage dans la table.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26 Private Sub activer_Click() Dim tempbackup As Date If Me.codeactivation.Value = "789-456-123" Then 'code unique donc à développer pour en créer un unique pour chaque distribution !! MsgBox "Merci d'avoir acheter votre clé d'activation !", , "Base Activé ! " 'vous devez créer un backup de la date avant de supprimer tous les enregistrement. Pour la rajouter par la suite. tempbackup = Nz(DLookup("dateInstallation", "tbl_demo"), 0) CurrentDb.Execute "DELETE * FROM [tbl_demo];" Dim MaTable As Recordset Set MaTable = CurrentDb.OpenRecordset("tbl_demo") MaTable.AddNew MaTable("active") = True MaTable("DateInstallation") = tempbackup MaTable.update MaTable.Close tempbackup = 0 DoCmd.Close Else MsgBox "Entrez un code Valide SVP", vbCritical, "Mauvais code! " End If End Sub
j'ai créer une fonction auto() dans un module séparer, appeler par une macro autoexec qui contient :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46 '------------------------------------------------------------ ' autoexec '------------------------------------------------------------ Public Function auto() Dim PremiereInstallation As Boolean Dim DateToday As Date Dim dateinstallation As Date dim active as boolean On Error GoTo auto_Err On Error Resume Next dateinstallation = Nz(DLookup("dateinstallation", "tbl_demo"), 0) PremiereInstallation = Nz(DLookup("PremiereInstallation", "tbl_demo"), "") active = nz(dlookup("active","tbl_demo"), "") If PremiereInstallation = True Then DateToday = Format(date, "dd-mmm-yyyy") Dim MaTable As Recordset Set MaTable = CurrentDb.OpenRecordset("tbl_demo") MaTable.Edit MaTable("dateinstallation") = DateToday MaTable("premiereInstallation") = False MaTable.update End If MaTable.Close DoCmd.OpenForm "menugeneral", acNormal if active = false then MsgBox " Merci d'Utiliser la Version d'Évaluation. " & _ vbCrLf & _ vbCrLf & " Vous diposez de 30 jours d'essai suivant la date d'installation soit le " & dateinstallation & " ou un maximum de 30 ouverture de celle-ci ! " & _ vbCrLf & " Il vous est possible toute fois d'entrer une clé d'activation via le menu gestion de la base ! ", vbInformation, "Version d'Évaluation ! " else end if auto_Exit: Exit Function auto_Err: MsgBox Error$ Resume auto_Exit End Function
J'ai créer une fonction afin de renommer tous les entêtes de formulaire qui contient (VERSION DEMO) si la base n'est pas activée.
Si ça vous intéresse dite le moi et je pourrait créez un nouveau post...
Partager