Salut tout le monde,
Je poste une nouvelle source en rapport avec les numéros de série pour vos applications. J'ai déjà déposé une source sur ce thème mais elle était très simple et le numéro de série était "neutre"; c'est à dire qu'il pouvait convenir à n'importe qui. Si c'est pas clair ce que je dis, lis la suite.
Donc cette nouvelle version permet de générer des numéros de série et de les vérifier. Tout ceci en fonction d'un nom d'utilisateur, du numéro de série du disque dur (en fait c'est plus le numéro de série de la partition, qui change à chaque formatage), et d'une chaine de caractère "secrète". On peut l'appeler l'identifiant du programme.
Le seul problème serait que comme j'utilise un modulo de 100 (après 100 c'est 0, 1, 2, 3, etc) la sécurité du serial est plus faible. Mais bon, c'est pas fais pour protéger le programme de lancement de missile atomique!!!! ;-D Et puis de toutes façon, les pirates arrivent à casser des codes plus dur alors....
Mais pour nous, simple développeur sans prétention, c'est suffisant.
Ma source utilise des fonctions récupérées sur ce site, je leur dis merci au passage.
Laissez des commentaires constructifs SVP
PS: Dans ma source je parle de CRC, vous l'aurez compris c'est pas du vrai CRC, mais ça fait bien!
Source / Exemple :
'*****************************************************
' Générateur et vérificateur de serial
' par Tioneb
'
' Certaines fonctions ont été récupérées sur vbfrance
'*****************************************************
Declare 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
'Fin des Déclarations
Public Function SerialHDD(SHDDLequel As String) As String
Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$
'Disque à checker
PathName$ = "c:\"
PathName$ = SHDDLequel
rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
'Afficher le résultat dans des msgbox
'MsgBox (" Lecteur " & ": " & UCase$(PathName$))
'MsgBox (" Le Label du disk " & ": " & DrvVolumeName$)
'MsgBox (" Le Numéro de série du disque " & ": " & DrvSerialNo$)
SerialHDD = DrvSerialNo$
End Function
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long
DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)
r& = GetVolumeInformation(PathName$, _
DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, _
UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))
If r& = 0 Then Exit Sub
'determine le label
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(pas de label)"
'determine l'id du disque
HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub
Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else: GetHiWord% = dw& \ 65535
End If
End Function
Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else: GetLoWord% = dw& And &HFFFF&
End If
End Function
Public Function Aleatoire(AMini As Long, AMaxi As Long) As Long
'fonction pour générer un numéro aléatoire compris entre les 2 bornes
Randomize
Aleatoire = Int((AMaxi - AMini + 1) * Rnd + AMini)
End Function
Public Function Crypter(ByRef str As String) As String
'permet de crypter mais aussi de décrypter avec la même fonction
'inconvéniant: n'a pas de clé de cryptage!!!
'c'est pas du cryptage, c'est une fonction xor
Dim Cr As String
Dim Ci As Integer
Dim carac As String
Cr = ""
For Ci = 1 To Len(str)
carac = Chr(Asc(Mid(str, Ci, 1)) Xor (Len(str) - Ci))
Cr = Cr + carac
Next Ci
Crypter = Cr
End Function
Public Function GenererSerial3(GS3Nom As String, GS3IDProg As String) As String
Dim LgNom As Integer, i As Integer, CRCNom As Long, CRCHDD As Long, XORGS3Nom As String
Dim CRC As Long, CRCIDProg As Long
'on converti le nom en majuscules
GS3Nom = UCase(GS3Nom)
CRCHDD = 0
'on fait un pseudo CRC sur le numéro de série de la partition
For i = 1 To Len(SerialHDD("C:\"))
CRCHDD = CRCHDD + Asc(Mid(SerialHDD("C:\"), i, 1))
Next i
'on xor tout ça
XORGS3Nom = Crypter(GS3Nom)
LgNom = Len(GS3Nom)
CRCNom = 0
'on CRC le nom "XORé"!
For i = 1 To LgNom
CRCNom = CRCNom + Asc(Mid(XORGS3Nom, i, 1))
Next i
CRCIDProg = 0
'pareil avec l'ID du prog
For i = 1 To Len(GS3IDProg)
CRCIDProg = CRCIDProg + Asc(Mid(GS3IDProg, i, 1))
Next i
'on mélange bien....
CRC = (CRCHDD + CRCNom + CRCIDProg) Mod 100
'******************************************************
Dim Caractere As String, Resultat As String, Iteration As Long
Iteration = 0
Caractere = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim a1 As Long, b1 As Long, c1 As Long, d1 As Long, e1 As Long
Dim a2 As Long, b2 As Long, c2 As Long, d2 As Long, e2 As Long
Dim a3 As Long, b3 As Long, c3 As Long, d3 As Long, e3 As Long
Dim a4 As Long, b4 As Long, c4 As Long, d4 As Long, e4 As Long
Dim a5 As Long, b5 As Long, c5 As Long, d5 As Long, e5 As Long
'et zioup, on chercher un serial compatible
BoucleGS3:
Iteration = Iteration + 1
a1 = Aleatoire(1, 36)
b1 = Aleatoire(1, 36)
c1 = Aleatoire(1, 36)
d1 = Aleatoire(1, 36)
e1 = Aleatoire(1, 36)
a2 = Aleatoire(1, 36)
b2 = Aleatoire(1, 36)
c2 = Aleatoire(1, 36)
d2 = Aleatoire(1, 36)
e2 = Aleatoire(1, 36)
a3 = Aleatoire(1, 36)
b3 = Aleatoire(1, 36)
c3 = Aleatoire(1, 36)
d3 = Aleatoire(1, 36)
e3 = Aleatoire(1, 36)
a4 = Aleatoire(1, 36)
b4 = Aleatoire(1, 36)
c4 = Aleatoire(1, 36)
d4 = Aleatoire(1, 36)
e4 = Aleatoire(1, 36)
a5 = Aleatoire(1, 36)
b5 = Aleatoire(1, 36)
c5 = Aleatoire(1, 36)
d5 = Aleatoire(1, 36)
e5 = Aleatoire(1, 36)
Resultat = ""
If ((a1 + e5) + (d2 - b1) * 2 - (2 * e4 + (d3 - c1))) + ((a4 + e1) * 2 + (d1 - b2) - (2 * e2 + (d4 - c2))) - ((a2 + e3) + (d5 - b4) - (2 * b3 + (d2 - c1))) Mod 100 = CRC Then
's'il est bon, on converti tout ça pour le renvoyer avec des lettres et des chiffres
Resultat = Mid(Caractere, a1, 1) & Mid(Caractere, a2, 1) & Mid(Caractere, a3, 1) & Mid(Caractere, a4, 1) & Mid(Caractere, a5, 1) & "-"
Resultat = Resultat & Mid(Caractere, b1, 1) & Mid(Caractere, b2, 1) & Mid(Caractere, b3, 1) & Mid(Caractere, b4, 1) & Mid(Caractere, b5, 1) & "-"
Resultat = Resultat & Mid(Caractere, c1, 1) & Mid(Caractere, c2, 1) & Mid(Caractere, c3, 1) & Mid(Caractere, c4, 1) & Mid(Caractere, c5, 1) & "-"
Resultat = Resultat & Mid(Caractere, d1, 1) & Mid(Caractere, d2, 1) & Mid(Caractere, d3, 1) & Mid(Caractere, d4, 1) & Mid(Caractere, d5, 1) & "-"
Resultat = Resultat & Mid(Caractere, e1, 1) & Mid(Caractere, e2, 1) & Mid(Caractere, e3, 1) & Mid(Caractere, e4, 1) & Mid(Caractere, e5, 1)
Else
's'il est bidon, on recommence
DoEvents
GoTo BoucleGS3
End If
GenererSerial3 = Resultat
End Function
Public Function VerifierSerial3(VS3Serial As String, VS3Nom As String, VS3IDProg As String) As Boolean
Dim LgNom As Integer, i As Integer, CRCNom As Long, CRCHDD As Long, XORVS3Nom As String
Dim CRC As Long, CRCIDProg As Long
If Len(VS3Serial) <> 29 Then
VerifierSerial3 = False
Exit Function
End If
VS3Nom = UCase(VS3Nom)
CRCHDD = 0
For i = 1 To Len(SerialHDD("C:\"))
CRCHDD = CRCHDD + Asc(Mid(SerialHDD("C:\"), i, 1))
Next i
XORVS3Nom = Crypter(VS3Nom)
LgNom = Len(VS3Nom)
CRCNom = 0
For i = 1 To LgNom
CRCNom = CRCNom + Asc(Mid(XORVS3Nom, i, 1))
Next i
CRCIDProg = 0
For i = 1 To Len(VS3IDProg)
CRCIDProg = CRCIDProg + Asc(Mid(VS3IDProg, i, 1))
Next i
CRC = (CRCHDD + CRCNom + CRCIDProg) Mod 100
'GenererSerial3 = CRC
'******************************************************
Dim Caractere As String, Resultat As String, Iteration As Long
Iteration = 0
Caractere = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim a1 As Long, b1 As Long, c1 As Long, d1 As Long, e1 As Long
Dim a2 As Long, b2 As Long, c2 As Long, d2 As Long, e2 As Long
Dim a3 As Long, b3 As Long, c3 As Long, d3 As Long, e3 As Long
Dim a4 As Long, b4 As Long, c4 As Long, d4 As Long, e4 As Long
Dim a5 As Long, b5 As Long, c5 As Long, d5 As Long, e5 As Long
Iteration = Iteration + 1
a1 = InStr(Caractere, Mid(VS3Serial, 1, 1))
a2 = InStr(Caractere, Mid(VS3Serial, 2, 1))
a3 = InStr(Caractere, Mid(VS3Serial, 3, 1))
a4 = InStr(Caractere, Mid(VS3Serial, 4, 1))
a5 = InStr(Caractere, Mid(VS3Serial, 5, 1))
b1 = InStr(Caractere, Mid(VS3Serial, 7, 1))
b2 = InStr(Caractere, Mid(VS3Serial, 8, 1))
b3 = InStr(Caractere, Mid(VS3Serial, 9, 1))
b4 = InStr(Caractere, Mid(VS3Serial, 10, 1))
b5 = InStr(Caractere, Mid(VS3Serial, 11, 1))
c1 = InStr(Caractere, Mid(VS3Serial, 13, 1))
c2 = InStr(Caractere, Mid(VS3Serial, 14, 1))
c3 = InStr(Caractere, Mid(VS3Serial, 15, 1))
c4 = InStr(Caractere, Mid(VS3Serial, 16, 1))
c5 = InStr(Caractere, Mid(VS3Serial, 17, 1))
d1 = InStr(Caractere, Mid(VS3Serial, 19, 1))
d2 = InStr(Caractere, Mid(VS3Serial, 20, 1))
d3 = InStr(Caractere, Mid(VS3Serial, 21, 1))
d4 = InStr(Caractere, Mid(VS3Serial, 22, 1))
d5 = InStr(Caractere, Mid(VS3Serial, 23, 1))
e1 = InStr(Caractere, Mid(VS3Serial, 25, 1))
e2 = InStr(Caractere, Mid(VS3Serial, 26, 1))
e3 = InStr(Caractere, Mid(VS3Serial, 27, 1))
e4 = InStr(Caractere, Mid(VS3Serial, 28, 1))
e5 = InStr(Caractere, Mid(VS3Serial, 29, 1))
Resultat = ""
If ((a1 + e5) + (d2 - b1) * 2 - (2 * e4 + (d3 - c1))) + ((a4 + e1) * 2 + (d1 - b2) - (2 * e2 + (d4 - c2))) - ((a2 + e3) + (d5 - b4) - (2 * b3 + (d2 - c1))) Mod 100 = CRC Then
VerifierSerial3 = True
Else
VerifierSerial3 = False
End If
End Function
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.