Numéro de série en fonction du pc

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Tioneb)