Tutoriel comment créer une fenêtre d'activation pour votre base

**TOMITOMAS** · 17/05/2012, 11h17

c'est également une méthode que j'ai mise en place !!!! =))

sauf que la aussi rien ne m'empeche d'aller fouiller dans les clé de registre et puis de l'ajouter a la main sur un autre PC !!

de toute maniere il y aura toujours une methode de contournement ...

mais moi je me base sur une cle de registre, une cle dans la base (si jamais l'utilisateur n'a pas la possibilite d'ecrire sur le registre), et des variables cryptées que je compare systématiquement ....
je limite la casse, mais il y a encore moyen de le contourner...

**robyseb** · 19/05/2012, 05h50

Sur se point tu dit vrai ... mais il ne faut pas penser que tous le monde est capable de le faire et en général nos appli. ,vont servir à des personnes qui ne connaissent pas l'informatique au point de pouvoir aller jouer comme bon leurs semble dans le registre. Donc il faut savoir s’arrêter.

**AIMSO1991** · 17/01/2015, 15h43

MERCI POUR CE POST ET NOUS SERONT RAVIT DE RECEVOIR D'AUTRES DE TA PART

**jom4site** · 18/02/2015, 03h00

avant tout vous avez plusieurs possibilité. Ce que moi même à codé pour mon application voici:
il faut d'abord créer deux table:
* syst_ser_val 'Table contenant les licences valide 1 an; ans; ...x ans
colonne :

serialkey--->texte(23) (licence du type xxxxx-xxxxx-xxxxx-xxxxx) vous devez manuellement remplir cette table
dureevalidite---> numerique
NbLicenceRestant----->numerique

* serialattribuer
colonne:

serialicence--->texte(23)
nbJourvalidite------->numerique
joursrestants-------->numerique
cleRegRecup------->texte(30) valeur du registre (HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductId)
debutUtiilisation------->date (date de la première utilisation)
datedujour--------->date (on à besoin de stocker cette valeur pour empêcher la modification de la date système pour continuer à utiliser le logiciel.) donc on n'a pas besoin de la fonction now()

Utilisation

1) créer un module dans VBA (Menu insertion--->Module)
2)créer une fonction nommée Verification()
copier/coller ce code

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
'#################################################
'#                                               #
'#          Function Verification()              #
'#                                               #
'#################################################
 
Function Verification()
   Dim rst1 As dao.Recordset
   Dim rst2 As dao.Recordset
   Dim sql, sql1, SER_RECU As String
   Dim yatilunelicence As Integer
   Dim WshShell, Clef_A_Recuperer
   Dim msg, msg1, Style, Title, Help, Ctxt, Response, MyString, jour1, jour2, empecheModifDate
msg = "Souhaitez-vous proceder à l'activation du logiciel?"    ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Définit les boutons.
Title = "CLIQUEZ SUR OUI ! "    ' Définit le titre.
Help = "DEMO.HLP"    ' Définit le fichier d'aide.
Ctxt = 1000    ' Définit le contexte de
                ' la rubrique.
 
'##############################################################
'#                                                            #
'# APPEL D'UNE FONCTION QUI FERA DISPARAITRE LE RUBAN OFFICE  #
'#                                                            #
'##############################################################
 
 
 
       Set WshShell = CreateObject("WScript.Shell")
                        ''' Set signifie "créer une variable d'environnement". Donc Set WshShell signifie
                        ''' créer la variable d'environnement WshShell.
                        ''' CreateObject est une fonction permettant de créer un objet Script, l'objet
                        ''' script étant ici la clef du registre à récupérer.
 
    Clef_A_Recuperer = WshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductId")
                        ''' RegRead est une fonction script permettant de lire l'objet script qui
                        ''' est la clef du registre
                        ''' "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\productId" est
                        ''' l'arborescence ou chemin d'accès à ProductId, ProductId étant la clef du régistre.
 
 
   sql1 = "SELECT * FROM serialattribuer"
   Set rst1 = CurrentDb.OpenRecordset(sql1)
   With rst1
'   rst1.Edit
 yatilunelicence = rst1.RecordCount
 
  With rst2
If yatilunelicence <> 0 Then
                  SER_RECU = rst1("serialicence").Value
                  sql2 = "SELECT * FROM syst_ser_val WHERE serialkey='" & SER_RECU & "'"
                  Set rst2 = CurrentDb.OpenRecordset(sql2)
                                     If (rst2.EOF = False) Then
                                              If rst2("serialkey").Value = rst1("serialicence").Value Then
                                                        If (rst1("cleRegRecup").Value = Clef_A_Recuperer) Then
                                                             rst1.Edit
 
                                                               jour2 = rst1("datedujour").Value
                                                            empecheModifDate = DateDiff("d", jour2, Now)
                                                            If empecheModifDate >= 0 Then
 
                                                                jour1 = rst1("debutUtiilisation").Value
                                                                rst1("datedujour").Value = Date
                                                               rst1("joursrestants").Value = rst1("nbJourvalidite").Value - DateDiff("d", jour1, Now)
                                                                    rst1.Update
                                                              Else
                                                          MsgBox ("VEUILLEZ REGLER VOTRE HORLOGE SYSTEME ET RELANCER LE LOGICIEL")
                                                           Application.Quit
                                         End If
 
 
 
                                  If rst1("joursrestants").Value >= 0 Then
                                           DoCmd.OpenForm "Menu Général", acNormal, , , , acWindowNormal '    'formulaire de demarrage lorque licence trouvé
                                                          Else
                                                               msg1 = "VOTRE LICENCE EST EXPIREE!" _
                                                               & " " & "VEUILLEZ CONTACTER xxxxxxx " _                   'Votre nom
                                                               & " " & "AU  yyyyyyyyyyy  POUR PLUS DE DETAIL")   'Votre téléphonne
 
                                                               Response = MsgBox(msg1, Style, Title, Help, Ctxt)
                                                                If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                                                                     MyString = "Oui"    ' Effectue une action.
                                                                        DoCmd.OpenForm "Activation Licence", acNormal, , , , acWindowNormal '
                                                                             Else    ' L'utilisateur a choisi Non.
                                                                                  MyString = "Non"    ' Effectue une action.
                                                                                       Application.Quit
                                                                             End If
 
 
 
 
                                                                                     End If
 
 
                                                               Else
                                                                                    MsgBox ("DESOLER VOUS AVEZ EFFECTUER UNE COPIE ILLEGALE" _
                                                                                    & " " & "VEUILLEZ CONTACTER xxxxxxx " _                   'Votre nom
                                                                                    & " " & "AU  yyyyyyyyyyy  POUR PLUS DE DETAIL")   'Votre téléphonne
 
 
                                                                                     msg1 = "AVEZ VOUS UNE LICENCE VALIDE?"
                                                                                     Response = MsgBox(msg1, Style, Title, Help, Ctxt)
                                                                                            If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                                                                                                  MyString = "Oui"    ' Effectue une action.
                                                                                        DoCmd.OpenForm "Activation Licence", acNormal, , , , acWindowNormal '
                                                                                            Else    ' L'utilisateur a choisi Non.
                                                                                                  MyString = "Non"    ' Effectue une action.
                                                                                                  Application.Quit
                                                                                            End If
 
 
                                                                    '
 
                                                               End If
 
 
                                                     End If
 
 
                                      End If
Else
 
                                   MsgBox ("VOUS N'AVEZ PAS DE LICENCE D'UTILISATION!")
 
                                   Response = MsgBox(msg, Style, Title, Help, Ctxt)
                                    If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                                        MyString = "Oui"    ' Effectue une action.
                                          DoCmd.OpenForm "Activation Licence", acNormal, , , , acWindowNormal '
                                    Else    ' L'utilisateur a choisi Non.
                                        MyString = "Non"    ' Effectue une action.
                                    Application.Quit
                                    End If
 
 
End If
End With
  rst2.close
End With
 
   rst1.Close
End Function
'#############################################################"
'#
'#
'#
'###############################################################

creer un macro Autoexec puis ratacher la fonction Verification().

Important! Créer un formulaire "Activation Licence" composé de 4 textbox avec comme limite de caractere 5.
(rechercher la fonction LimitKeyPress qui permet de limite le nombre de caractere pouvant etre sasi dans chaque textbox

**BiPas** · 26/05/2017, 14h44

Envoyé par robyseb

Voici la base de test. N'hésitez pas à laisser vos commentaires. Merci !

Merci beaucoup, Robyseb pour cette illustration. Sans cette base demo, pratiquement ce serait tres difficile pour nous qui n'avons pas de bonnes notions dans les codes. Cependant, il reste un petit souci: Si l'utilisateur importe les objet, il pourra modifier les codes et rendre l'application active a son gres. Comment peut empecher formellement que les utilisateurs d'une base de donnees access ne puissent pas importer les objets (Tables, formulaires, modules, ...) a partir d'une autre base de donnees?

encoure une fois merci pour vos reactions constructives.

**Tossben** · 28/05/2019, 09h07

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
[Function validation()
    Dim v As Variant, d As Date, s As String
    'récupère la date d'échéance
    d = CDate(DLookup("donnée", "DataDonnees", "cle='DateEcheance'"))
    If d <= Now Then
        v = InputBox("Entrer le numéro de série", "Date limite d'utilisation atteinte")
        'le numéro de série pourrait être dans une table liée
        s = DLookup("donnée", "DataDonnees", "cle='SerialNumber'")
        If (v = s) And (s <> "") Then
            'ajoute un an à la date d'échéance
            DoCmd.RunSQL "UPDATE DataDonnees SET DataDonnees.donnée = CStr(CDate([DataDonnees]![donnée])+365) WHERE (((DataDonnees.cle)='DateEcheance'));"
            'éventuellement supprime le numéro de série
            DoCmd.RunSQL "UPDATE DataDonnees SET DataDonnees.donnée = '' WHERE (((DataDonnees.cle)='SerialNumber'));"
        Else
            MsgBox ("Numéro de dérie incorrect, veuillez contacter votre responsable informatique")
            DoCmd.Quit acQuitSaveNone
        End If
    End If
End Function

Comment réaliser la table et le formulaire
le code est-ce une macro ou un module oubien dans quel événement le mettre

**Albatros182** · 26/03/2020, 13h10

Bonjour tout le monde,

j'ai un programme excel dans lequel je voudrais insérer une clé d'activation pour éviter au maximum qu'il circule partout.

Je sais que ce n'est pas une garantie absolue, mais au moins cela limite la casse.

J'ai lu toute la conversation, mais je n'ai pas tout compris sur la mise en oeuvre des codes.

Est ce que quelqu'un peu m'aider à le mettre en place dans un classeur excel 2007?

Merci par avance

**VICONS** · 12/07/2020, 23h38

Merci beaucoup pour votre tuto

Tutoriel comment créer une fenêtre d'activation pour votre base

Contribuez

Discussions similaires

Partager

Partager