Discussion :

[kinguepat]

Bonjour à tous (tes)!!!

J'aimerai limiter les enregistrements dans plusieurs tables d'une base si celle-ci est en version démo et à l'activation de cette base (par une clé ), ne plus limiter les enregistrements dans les tables correspondantes.

J'ai utilisé Dcount pour limiter enregistrements dans une table

Code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If DCount("*", "MaTable") >= 1 Then
Msgbox"blablabla..."
me.undo

Merci d'avance pour vos contributions.

[marot_r]

Et la question est ?

Comment mettre en place une licence ?
Comment tester si il y a une licence ?

Sache que la protection d'une appli Access contre son utilisation non autorisée est quasiment impossible.

L’idée de la licence n'est pas mauvaise mais c'est son contrôle qui pause un problème.
Une fois qu'un client en une il est impossible de l'empecher de l'utiliser ailleurs.

A+

[Invité]

Bonsoir,

Déjà tu peux créer une appli autonome empaquète avec le runtime Access.

Tu peux faire un système de licence que collecte des informations sur la machine qui exécute le programme.

https://www.developpez.net/forums/d1...nce-vba-excel/

Tu peux dans tes formulaires limiter la taille de tes requêtes pendant la période évaluation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 if licenceOk then
SQL="select * from table"
Else
SQL="select top 20 * from table"
End if

[Manequin]

Bonsoir, je te propose d'utiliser Access Runtime. Maintenant pendant le processus de création du setup tu peux paramétrer ta licence comme tu veux.

Cordialement.

[kinguepat]

Bonjour.
Merci pour vos réponses.

@marot_r
la question est de savoir comment mettre en place un module ou fonction qui contrôle, si la base de données est en version Démo, limite les enregistrements dans certaines tables, le cas échéant, ne les limite pas.

le code (donné par l'administrateur de la base) sera renseigné au travers d'un formulaire
code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub btnActiver_Click()
If Me.txtCodeactivation.Value = "lecodeactivation" Then
Msgbox "blablabla..."
ne plus limiter les enregistrements des tables correspondantes
else
Msgbox "blablabla..."
limiter les enregistrements des tables 
end if
end sub

La base est distribuée est version Démo (pour test) et les enregistrements, dans des tables principales, sont limités.

@dysorthographie
j'avais opté de limiter les enregistrements dans les tables principales. je vais vérifier avec le système de licence


@Manequin

Maintenant pendant le processus de création du setup tu peux paramétrer ta licence comme tu veux.

Peut-on, pendant le processus d'empaquetage, paramétrer la licence? si oui! comment?
Je crois que ce processus permet juste de rendre exécutable une base de données.

[marot_r]

Bonjour.

Ceci n'est pas une reponse directe a ta question mais plus une idee peut-etre plus facile a vivre.

Au lieu de tester un numero de licence, pourquoi ne pas distribuer une version nommee : _Demo.

Tu testes le nom et si il fini par _Demo tu limites.

Quand ton client a paye, tu lui envoie une version du meme programme sans le _Demo a la fin du nom.

Ceci ne te protege pas des copies de la version non demo mais t'evite d'avoir a gerer des numeros de licence.

A+

[kinguepat]

Bonne idée mais je me pose la question de savoir que faire des informations du client (celles contenues dans la version Demo) en lui donnant la version complète?

[bertiny]

Bonjour.

mais je me pose la question de savoir que faire des informations du client (celles contenues dans la version Demo) en lui donnant la version complète?

Ta base de données doit être fractionnée en deux.
- Une dorsale (qui contient les tables uniquement et dans lesquelles sont stockées les données du client pendant la période d'évaluation)
- Une frontale (qui contient le reste d'objets de l'application)
En réponse donc de ta préoccupation, il suffit de copier la dorsale de la base démo et de remplacer celle de la nouvelle application par la démo qui contient les données du client.
Au cas contraire tu ne pourras rien faire de bon.

Cordialement

[Invité]

Bonsoir,
Tu ajoute une table licence dans laquelle on trouve le champ licence avec comme valeur initiale 'Demo' un champ n°Disk (N° de série du disque dure ) pour éviter que ton applications puisse être utilisé sur une autre machine et un champ période d'évaluation.

Je t'expliquerai comment faire tous ça quand j'aurai accès ma machine.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 set rs =currentdb.openrecordset("select * from licence")
if rs!licence= "Demo"then
SQL="select top 20  * from table"
Else
SQL="select * from table"
End if

[marot_r]

Bonjour.

Ne pas oublie que si tu te reposes sur une caracteritique de la machine (numero de serie du disque dur, du processeur ou autre).
Si la machine est endommagee et la piece (ou les pieces ou la machine) est remplacee, ta verification pourrait ne plus fonctionner et ton client meme avec une licence valide ne plus pouvoir utiliser ton appli.

A+

[Invité]

Bonsoir marot_r,

Tu as raison mais comme le n° de licence sera obtenu via échange de mail entre le client et son fournisseur rien interdit un geste commercial.

Éventuellement dans le cadre de la maintenance effecteur une récupération de données si le client est en mesure de fournir une sauvegarde.

[marot_r]

Bonjour.

Tu as raison mais comme le n° de licence sera obtenu via échange de mail entre le client et son fournisseur rien interdit un geste commercial.

Je suis d'accord je pointais simplement un desagrement possible.
Le deplaisir du client est aussi a mesurer en fonction de la criticite de l'application.
Si elle gere un reacteur nucleaire ou une liste d'invites au prochain party de Noel, les risques ne sont pas les memes si elle ne fonctionne pas.
Il y a aussi chez quel client elle ne fonctionne pas, certains sont plus expressifs que d'autres et peuvent le faire savoir "at large".

A+

[kinguepat]

Bonjour à vous.

Désolé pour le réponse tardive. Après quelques recherches, j'ai adapté ceci :

---> je limite l'affichage de la requête:

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
 
Dim leSQL As String
Dim leWhere As String 
 
leWhere = "where true "
base_active = Nz(DLookup("Active", "tblDemo"), "")
 
   If base_active = True Then
 
   If (Nz(Me.RechercherClient, "") <> "") And (Me.RechercherClient <> "[Tous]") Then 
      leWhere = leWhere & " and (NomClient like '" & Me.RechercherClient & "')" 
   Else
      Me.RechercherClient = "[Tous]" 
   End If
 
   leSQL = "Select  * From reqListeClient " & leWhere & " order by NomClient Asc;" 'tout afficher
   Else
   leSQL = "Select Top 10 * From reqListeClient " & leWhere & " order by NomClient Asc;" 'limiter l'affichage
   End If
   Me.sFrmListeClient.Form.RecordSource = leSQL

sur l'évènement clic du bouton ajout :

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
Private Sub btnNouveu_Click()
Dim stDocName As String
 
base_active = Nz(DLookup("Active", "tblDemo"), "")
If base_active = True Then
 
DoCmd.Close acForm, Me.Name
stDocName = "F_Clients"
DoCmd.OpenForm stDocName, , , acFormAdd
...
Else
If DCount("*", "T_Clients") >= 10 Then
MsgBox "blablabla"
Exit Sub
End If
End If
 
...
End Sub

@dysorthographie

un champ n°Disk (N° de série du disque dure ) pour éviter que ton applications puisse être utilisé sur une autre machine

suis intéressé, comment intégrer çà dans le code ci-dessous ( @robyseb)

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
Private Sub btnActiver_Click()
Dim tempbackup As Date
 
If Me.txtCodeactivation.Value = "lecodeunique" Then 'code unique donc à développer pour en créer un unique pour chaque distribution !!
 
 
MsgBox "blablabla"
        '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", "tblDemo"), 0)
 
        CurrentDb.Execute "DELETE * FROM [tblDemo];"
Dim MaTable As Recordset
Set MaTable = CurrentDb.OpenRecordset("tblDemo")
            MaTable.AddNew
                    MaTable("Active") = True
                    MaTable("dateinstallation") = tempbackup
            MaTable.Update
MaTable.Close
tempbackup = 0
DoCmd.Close
 
 
Else
MsgBox "blablabla"
End If
End Sub

[kinguepat]

@bertiny
Merci! ma base est fractionnée

[kinguepat]

Bonsoir à tous!

@dysorthographie je suppose que tu n'as pas encore eu accès à ta machine...

Au plaisir de vous lire.

[Invité]

Bonjour,
regardes la la sub test

Code Module2 :

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
Option Compare Database
Public Declare PtrSafe Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Public Const NumProduit = "1DA242EAF2A6EAF11937EE18311CD2FD"
Private Sub test()
Debug.Print ValideLicence
End Sub
Public Function ValideLicence() As Boolean
Dim Rs As Object, Sn As String, Lic As String, NewLicence As String
Dim Md As New MD5
 
 
Set Rs = CurrentDb.OpenRecordset("SELECT * FROM Licence;")
If Rs.EOF Then
    Rs.AddNew
    Rs("N°Produt") = NumProduit
    Rs("N°Serie") = Format(Md.DigestStrToHexStr(GetMyMACAddress & SerialDisck & NumProduit), "@@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
    Rs("DateInit") = Now
    Rs("dateEval") = DateSerial(Year(Rs("DateInit")), Month(Rs("DateInit")), Day(Rs("DateInit")) + 30) & " " & Format(Rs("DateInit"), "hh:mm:ss")
    Rs("N°Licence") = Format(Md.DigestStrToHexStr(Rs("N°Produt") & Rs("N°Serie") & Rs("DateInit") & Rs("dateEval")), " @@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
    Rs("Comment") = "Licence Evaluation"
   Rs.Update
   Rs.Requery
End If
 
 
If Rs("dateEval") < Now And Rs("Comment") = "Licence Evaluation" Then
    Rs.Edit
    Rs("Comment") = "Licence Expiré"
    Rs.Update
    Rs.Requery
End If
If Rs("Comment") = "Licence Expiré" Then
    Sn = Format(Md.DigestStrToHexStr(GetMyMACAddress & SerialDisck & NumProduit), "@@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
    Lic = Format(Md.DigestStrToHexStr(Rs("N°Produt") & Sn & Rs("DateInit") & Rs("dateEval")), "@@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
  Debug.Print Rs("N°Licence"), Lic
 NewLicence = InputBox("Entrez le N° licence")
 If Rs("N°Licence") <> Lic And NewLicence <> Lic Then
    MsgBox "err"
    exit functon
Else
     Rs.Edit
    Rs("Comment") = "Licence Validé"
    Rs.Update
    Rs.Requery
 End If
 If Rs("Comment") = "Licence Validé" Then
     Sn = Format(Md.DigestStrToHexStr(GetMyMACAddress & SerialDisck & NumProduit), "@@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
     Lic = Format(Md.DigestStrToHexStr(Rs("N°Produt") & Sn & Rs("DateInit") & Rs("dateEval")), "@@@@@@@@-@@@@@@@@-@@@@@@@@-@@@@@@@@")
      If Rs("N°Licence") <> Lic Then Exit Function
 End If
 
End If
ValideLicence = True
End Function
 
 
 
 
Function SerialDisck() As String
Dim oFSO, oDrv
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.DriveExists("C") Then
  Set oDrv = oFSO.GetDrive("C")
 SerialDisck = oDrv.SerialNumber
  End If
 
 
End Function
Function GetMyMACAddress() As String
    'Declaring the necessary variables.
    Dim strComputer     As String
    Dim objWMIService   As Object
    Dim colItems        As Object
    Dim objItem         As Object
    Dim myMACAddress    As String
 
    'Set the computer.
    strComputer = "."
 
    'The root\cimv2 namespace is used to access the Win32_NetworkAdapterConfiguration class.
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 
    'A select query is used to get a collection of network adapters that have the property IPEnabled equal to true.
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
 
    'Loop through all the collection of adapters and return the MAC address of the first adapter that has a non-empty IP.
    For Each objItem In colItems
        If Not IsNull(objItem.IPAddress) Then myMACAddress = objItem.MACAddress
        Exit For
    Next
 
    'Return the IP string.
    GetMyMACAddress = myMACAddress
 
 
End Function

Code module de classe MD5 :

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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
Option Explicit
 
 
'/******************************************************************************
' *  Copyright (C) 2000 by Robert Hubley.                                      *
' *  All rights reserved.                                                      *
' *                                                                            *
' *  This software is provided ``AS IS'' and any express or implied            *
' *  warranties, including, but not limited to, the implied warranties of      *
' *  merchantability and fitness for a particular purpose, are disclaimed.     *
' *  In no event shall the authors be liable for any direct, indirect,         *
' *  incidental, special, exemplary, or consequential damages (including, but  *
' *  not limited to, procurement of substitute goods or services; loss of use, *
' *  data, or profits; or business interruption) however caused and on any     *
' *  theory of liability, whether in contract, strict liability, or tort       *
' *  (including negligence or otherwise) arising in any way out of the use of  *
' *  this software, even if advised of the possibility of such damage.         *
' *                                                                            *
' ******************************************************************************
'
'  CLASS: MD5
'
'  DESCRIPTION:
'     This is a class which encapsulates a set of MD5 Message Digest functions.
'     MD5 algorithm produces a 128 bit digital fingerprint (signature) from an
'     dataset of arbitrary length.  For details see RFC 1321 (summarized below).
'     This implementation is derived from the RSA Data Security, Inc. MD5 Message-Digest
'     algorithm reference implementation (originally written in C)
'
'  AUTHOR:
'     Robert M. Hubley 12/1999
'
'
'  NOTES:
'      Network Working Group                                    R. Rivest
'      Request for Comments: 1321     MIT Laboratory for Computer Science
'                                             and RSA Data Security, Inc.
'                                                              April 1992
'
'
'                           The MD5 Message-Digest Algorithm
'
'      Summary
'
'         This document describes the MD5 message-digest algorithm. The
'         algorithm takes as input a message of arbitrary length and produces
'         as output a 128-bit "fingerprint" or "message digest" of the input.
'         It is conjectured that it is computationally infeasible to produce
'         two messages having the same message digest, or to produce any
'         message having a given prespecified target message digest. The MD5
'         algorithm is intended for digital signature applications, where a
'         large file must be "compressed" in a secure manner before being
'         encrypted with a private (secret) key under a public-key cryptosystem
'         such as RSA.
'
'         The MD5 algorithm is designed to be quite fast on 32-bit machines. In
'         addition, the MD5 algorithm does not require any large substitution
'         tables; the algorithm can be coded quite compactly.
'
'         The MD5 algorithm is an extension of the MD4 message-digest algorithm
'         1,2]. MD5 is slightly slower than MD4, but is more "conservative" in
'         design. MD5 was designed because it was felt that MD4 was perhaps
'         being adopted for use more quickly than justified by the existing
'         critical review; because MD4 was designed to be exceptionally fast,
'         it is "at the edge" in terms of risking successful cryptanalytic
'         attack. MD5 backs off a bit, giving up a little in speed for a much
'         greater likelihood of ultimate security. It incorporates some
'         suggestions made by various reviewers, and contains additional
'         optimizations. The MD5 algorithm is being placed in the public domain
'         for review and possible adoption as a standard.
'
'         RFC Author:
'         Ronald L.Rivest
'         Massachusetts Institute of Technology
'         Laboratory for Computer Science
'         NE43 -324545    Technology Square
'         Cambridge, MA  02139-1986
'         Phone: (617) 253-5880
'         EMail:    Rivest@ theory.lcs.mit.edu
'
'
'
'  CHANGE HISTORY:
'
'     0.1.0  RMH    1999/12/29      Original version
'
'
 
 
 
 
'=
'= Class Constants
'=
Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
 
 
Private Const S11 = 7
Private Const S12 = 12
Private Const S13 = 17
Private Const S14 = 22
Private Const S21 = 5
Private Const S22 = 9
Private Const S23 = 14
Private Const S24 = 20
Private Const S31 = 4
Private Const S32 = 11
Private Const S33 = 16
Private Const S34 = 23
Private Const S41 = 6
Private Const S42 = 10
Private Const S43 = 15
Private Const S44 = 21
 
 
 
 
'=
'= Class Variables
'=
Private State(4) As Long
Private ByteCounter As Long
Private ByteBuffer(63) As Byte
 
 
 
 
'=
'= Class Properties
'=
Property Get RegisterA() As String
    RegisterA = State(1)
End Property
 
 
Property Get RegisterB() As String
    RegisterB = State(2)
End Property
 
 
Property Get RegisterC() As String
    RegisterC = State(3)
End Property
 
 
Property Get RegisterD() As String
    RegisterD = State(4)
End Property
 
 
 
 
'=
'= Class Functions
'=
 
 
'
' Function to quickly digest a file into a hex string
'
Public Function DigestFileToHexStr(FileName As String) As String
    Open FileName For Binary Access Read As #1
    MD5Init
    Do While Not EOF(1)
        Get #1, , ByteBuffer
        If Loc(1) < LOF(1) Then
            ByteCounter = ByteCounter + 64
            MD5Transform ByteBuffer
        End If
    Loop
    ByteCounter = ByteCounter + (LOF(1) Mod 64)
    Close #1
    MD5Final
    DigestFileToHexStr = GetValues
End Function
 
 
'
' Function to digest a text string and output the result as a string
' of hexadecimal characters.
'
Public Function DigestStrToHexStr(SourceString As String) As String
    MD5Init
    MD5Update Len(SourceString), StringToArray(SourceString)
    MD5Final
    DigestStrToHexStr = GetValues
End Function
 
 
'
' A utility function which converts a string into an array of
' bytes.
'
Private Function StringToArray(InString As String) As Byte()
    Dim i As Integer
    Dim bytBuffer() As Byte
    ReDim bytBuffer(Len(InString))
    For i = 0 To Len(InString) - 1
        bytBuffer(i) = Asc(Mid(InString, i + 1, 1))
    Next i
    StringToArray = bytBuffer
End Function
 
 
'
' Concatenate the four state vaules into one string
'
Public Function GetValues() As String
    GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function
 
 
'
' Convert a Long to a Hex string
'
Private Function LongToString(Num As Long) As String
        Dim a As Byte
        Dim b As Byte
        Dim c As Byte
        Dim d As Byte
 
        a = Num And &HFF&
        If a < 16 Then
            LongToString = "0" & Hex(a)
        Else
            LongToString = Hex(a)
        End If
 
        b = (Num And &HFF00&) \ 256
        If b < 16 Then
            LongToString = LongToString & "0" & Hex(b)
        Else
            LongToString = LongToString & Hex(b)
        End If
 
        c = (Num And &HFF0000) \ 65536
        If c < 16 Then
            LongToString = LongToString & "0" & Hex(c)
        Else
            LongToString = LongToString & Hex(c)
        End If
 
        If Num < 0 Then
            d = ((Num And &H7F000000) \ 16777216) Or &H80&
        Else
            d = (Num And &HFF000000) \ 16777216
        End If
 
        If d < 16 Then
            LongToString = LongToString & "0" & Hex(d)
        Else
            LongToString = LongToString & Hex(d)
        End If
 
End Function
 
 
'
' Initialize the class
'   This must be called before a digest calculation is started
'
Public Sub MD5Init()
    ByteCounter = 0
    State(1) = UnsignedToLong(1732584193#)
    State(2) = UnsignedToLong(4023233417#)
    State(3) = UnsignedToLong(2562383102#)
    State(4) = UnsignedToLong(271733878#)
End Sub
 
 
'
' MD5 Final
'
Public Sub MD5Final()
    Dim dblBits As Double
 
    Dim padding(72) As Byte
    Dim lngBytesBuffered As Long
 
    padding(0) = &H80
 
    dblBits = ByteCounter * 8
 
    ' Pad out
    lngBytesBuffered = ByteCounter Mod 64
    If lngBytesBuffered <= 56 Then
        MD5Update 56 - lngBytesBuffered, padding
    Else
        MD5Update 120 - ByteCounter, padding
    End If
 
 
    padding(0) = UnsignedToLong(dblBits) And &HFF&
    padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
    padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
    padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
    padding(4) = 0
    padding(5) = 0
    padding(6) = 0
    padding(7) = 0
 
    MD5Update 8, padding
End Sub
 
 
'
' Break up input stream into 64 byte chunks
'
Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
    Dim II As Integer
    Dim i As Integer
    Dim J As Integer
    Dim K As Integer
    Dim lngBufferedBytes As Long
    Dim lngBufferRemaining As Long
    Dim lngRem As Long
 
    lngBufferedBytes = ByteCounter Mod 64
    lngBufferRemaining = 64 - lngBufferedBytes
    ByteCounter = ByteCounter + InputLen
    ' Use up old buffer results first
    If InputLen >= lngBufferRemaining Then
        For II = 0 To lngBufferRemaining - 1
            ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
        Next II
        MD5Transform ByteBuffer
 
        lngRem = (InputLen) Mod 64
        ' The transfer is a multiple of 64 lets do some transformations
        For i = lngBufferRemaining To InputLen - II - lngRem Step 64
            For J = 0 To 63
                ByteBuffer(J) = InputBuffer(i + J)
            Next J
            MD5Transform ByteBuffer
        Next i
        lngBufferedBytes = 0
    Else
      i = 0
    End If
 
    ' Buffer any remaining input
    For K = 0 To InputLen - i - 1
        ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K)
    Next K
 
End Sub
 
 
'
' MD5 Transform
'
Private Sub MD5Transform(Buffer() As Byte)
    Dim x(16) As Long
    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim d As Long
 
    a = State(1)
    b = State(2)
    c = State(3)
    d = State(4)
 
    Decode 64, x, Buffer
 
 
    ' Round 1
    FF a, b, c, d, x(0), S11, -680876936
    FF d, a, b, c, x(1), S12, -389564586
    FF c, d, a, b, x(2), S13, 606105819
    FF b, c, d, a, x(3), S14, -1044525330
    FF a, b, c, d, x(4), S11, -176418897
    FF d, a, b, c, x(5), S12, 1200080426
    FF c, d, a, b, x(6), S13, -1473231341
    FF b, c, d, a, x(7), S14, -45705983
    FF a, b, c, d, x(8), S11, 1770035416
    FF d, a, b, c, x(9), S12, -1958414417
    FF c, d, a, b, x(10), S13, -42063
    FF b, c, d, a, x(11), S14, -1990404162
    FF a, b, c, d, x(12), S11, 1804603682
    FF d, a, b, c, x(13), S12, -40341101
    FF c, d, a, b, x(14), S13, -1502002290
    FF b, c, d, a, x(15), S14, 1236535329
 
    ' Round 2
    GG a, b, c, d, x(1), S21, -165796510
    GG d, a, b, c, x(6), S22, -1069501632
    GG c, d, a, b, x(11), S23, 643717713
    GG b, c, d, a, x(0), S24, -373897302
    GG a, b, c, d, x(5), S21, -701558691
    GG d, a, b, c, x(10), S22, 38016083
    GG c, d, a, b, x(15), S23, -660478335
    GG b, c, d, a, x(4), S24, -405537848
    GG a, b, c, d, x(9), S21, 568446438
    GG d, a, b, c, x(14), S22, -1019803690
    GG c, d, a, b, x(3), S23, -187363961
    GG b, c, d, a, x(8), S24, 1163531501
    GG a, b, c, d, x(13), S21, -1444681467
    GG d, a, b, c, x(2), S22, -51403784
    GG c, d, a, b, x(7), S23, 1735328473
    GG b, c, d, a, x(12), S24, -1926607734
 
    ' Round 3
    HH a, b, c, d, x(5), S31, -378558
    HH d, a, b, c, x(8), S32, -2022574463
    HH c, d, a, b, x(11), S33, 1839030562
    HH b, c, d, a, x(14), S34, -35309556
    HH a, b, c, d, x(1), S31, -1530992060
    HH d, a, b, c, x(4), S32, 1272893353
    HH c, d, a, b, x(7), S33, -155497632
    HH b, c, d, a, x(10), S34, -1094730640
    HH a, b, c, d, x(13), S31, 681279174
    HH d, a, b, c, x(0), S32, -358537222
    HH c, d, a, b, x(3), S33, -722521979
    HH b, c, d, a, x(6), S34, 76029189
    HH a, b, c, d, x(9), S31, -640364487
    HH d, a, b, c, x(12), S32, -421815835
    HH c, d, a, b, x(15), S33, 530742520
    HH b, c, d, a, x(2), S34, -995338651
 
    ' Round 4
    II a, b, c, d, x(0), S41, -198630844
    II d, a, b, c, x(7), S42, 1126891415
    II c, d, a, b, x(14), S43, -1416354905
    II b, c, d, a, x(5), S44, -57434055
    II a, b, c, d, x(12), S41, 1700485571
    II d, a, b, c, x(3), S42, -1894986606
    II c, d, a, b, x(10), S43, -1051523
    II b, c, d, a, x(1), S44, -2054922799
    II a, b, c, d, x(8), S41, 1873313359
    II d, a, b, c, x(15), S42, -30611744
    II c, d, a, b, x(6), S43, -1560198380
    II b, c, d, a, x(13), S44, 1309151649
    II a, b, c, d, x(4), S41, -145523070
    II d, a, b, c, x(11), S42, -1120210379
    II c, d, a, b, x(2), S43, 718787259
    II b, c, d, a, x(9), S44, -343485551
 
 
    State(1) = LongOverflowAdd(State(1), a)
    State(2) = LongOverflowAdd(State(2), b)
    State(3) = LongOverflowAdd(State(3), c)
    State(4) = LongOverflowAdd(State(4), d)
 
 
'  /* Zeroize sensitive information.
'*/
'  MD5_memset ((POINTER)x, 0, sizeof (x));
 
End Sub
 
 
Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte)
    Dim intDblIndex As Integer
    Dim intByteIndex As Integer
    Dim dblSum As Double
 
    intDblIndex = 0
    For intByteIndex = 0 To Length - 1 Step 4
        dblSum = InputBuffer(intByteIndex) + _
                                    InputBuffer(intByteIndex + 1) * 256# + _
                                    InputBuffer(intByteIndex + 2) * 65536# + _
                                    InputBuffer(intByteIndex + 3) * 16777216#
        OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
        intDblIndex = intDblIndex + 1
    Next intByteIndex
End Sub
 
 
'
' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
' Rotation is separate from addition to prevent recomputation.
'
Private Function FF(a As Long, _
                    b As Long, _
                    c As Long, _
                    d As Long, _
                    x As Long, _
                    s As Long, _
                    ac As Long) As Long
    a = LongOverflowAdd4(a, (b And c) Or (Not (b) And d), x, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
End Function
 
 
Private Function GG(a As Long, _
                    b As Long, _
                    c As Long, _
                    d As Long, _
                    x As Long, _
                    s As Long, _
                    ac As Long) As Long
    a = LongOverflowAdd4(a, (b And d) Or (c And Not (d)), x, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
End Function
 
 
Private Function HH(a As Long, _
                    b As Long, _
                    c As Long, _
                    d As Long, _
                    x As Long, _
                    s As Long, _
                    ac As Long) As Long
    a = LongOverflowAdd4(a, b Xor c Xor d, x, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
End Function
 
 
Private Function II(a As Long, _
                    b As Long, _
                    c As Long, _
                    d As Long, _
                    x As Long, _
                    s As Long, _
                    ac As Long) As Long
    a = LongOverflowAdd4(a, c Xor (b Or Not (d)), x, ac)
    a = LongLeftRotate(a, s)
    a = LongOverflowAdd(a, b)
End Function
 
 
'
' Rotate a long to the right
'
Function LongLeftRotate(value As Long, bits As Long) As Long
    Dim lngSign As Long
    Dim lngI As Long
    bits = bits Mod 32
    If bits = 0 Then LongLeftRotate = value: Exit Function
    For lngI = 1 To bits
        lngSign = value And &HC0000000
        value = (value And &H3FFFFFFF) * 2
        value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And _
                &H40000000) And &H80000000)
    Next
    LongLeftRotate = value
End Function
 
 
'
' Function to add two unsigned numbers together as in C.
' Overflows are ignored!
'
Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
    Dim lngHighWord As Long
    Dim lngLowWord As Long
    Dim lngOverflow As Long
 
 
    lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
    LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function
 
 
'
' Function to add two unsigned numbers together as in C.
' Overflows are ignored!
'
Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
    Dim lngHighWord As Long
    Dim lngLowWord As Long
    Dim lngOverflow As Long
 
 
    lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + _
                   ((Val2 And &HFFFF0000) \ 65536) + _
                   ((val3 And &HFFFF0000) \ 65536) + _
                   ((val4 And &HFFFF0000) \ 65536) + _
                   lngOverflow) And &HFFFF&
    LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function
 
 
'
' Convert an unsigned double into a long
'
Private Function UnsignedToLong(value As Double) As Long
        If value < 0 Or value >= OFFSET_4 Then Error 6 ' Overflow
        If value <= MAXINT_4 Then
          UnsignedToLong = value
        Else
          UnsignedToLong = value - OFFSET_4
        End If
      End Function
 
 
'
' Convert a long to an unsigned Double
'
Private Function LongToUnsigned(value As Long) As Double
        If value < 0 Then
          LongToUnsigned = value + OFFSET_4
        Else
          LongToUnsigned = value
        End If
End Function

[kinguepat]

Bonjour
Merci!
Je regarde et reviens vers vous.

[Invité]

maintenant en pur VBA c'est facilement craquable , mais si tu convertis ta base de données en exécutable je ne sais pas!

j'espère que d'autre adepte du forum pourrons y apporter une réponse.

[Pierre Fauconnier]

Salut.

Tout cela n'a guère de sens si tu ne crées pas un accde pour ton appli (la "frontale"), et encore. Mais cela requiert que ton appli soit en béton car dans un accde, tu as intérêt à tout prévoir...

Mais si tu laisses ton code dans un accdb, c'est craqué assez rapidement.

Cela dit, si tu bases ta licence sur le mac du disque dur ou autres joyeusetés et que tes clients changent de disque dur, ils vont la trouver mauvaise de devoir repayer une licence ou d'attendre que tu veuilles bien leur rendre un numéro valide pour leur nouvelle machine (si tant est que tu existes toujours sur le marché). Soit ton application en vaut vraiment la peine (j'en doute, car tu ne l'aurais pas écrite en Access, alors), soit ça ne vaut pas la peine de la protéger autant.

[Invité]

Et bien il feront comme pour Windows ils iront sur torrent411.

Et si j'oublis mon portable dans le métro
Et si................................