1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources Sécurité
  5. Numéro de série en fonction du pc

Numéro de série en fonction du pc

Soyez le premier à donner votre avis sur cette source.

Vue 29 299 fois - Téléchargée 1 671 fois

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

Ajouter un commentaire Commentaires
PatrickYohann
Messages postés
10
Date d'inscription
mardi 1 décembre 2009
Statut
Membre
Dernière intervention
7 juin 2010
7 déc. 2009 à 13:52
Merci à JACK qui a donné la réponse dans son premier message. Pardonnez mes questions, je ne suis pas particulièrement doué en vba, et ça, je l'avais déjà signifié à l'auteur de ce code.
Pour RENFIELD: Non, le numéro de la partition sur chaque machine ne sera pas identique. Sur la machine qui est destinée à recevoir l'application, on s'arrange pour afficher dans des textboxs le SerialHDD et le nom d'utilisateur. Le client recueille ces informations et me les communique car il n'a pas le bout de code qui permet de générer un Serial (C'est fait exprès!). Il n'a que le code qui permet de vérifier le Serial que moi je vais lui fournir sur la base des renseignements qu'il m'a communiqués par phone ou mail.
cs_Jack
Messages postés
14007
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
 78
7 déc. 2009 à 09:31
"DoCmd" + "champ SerialGénéré" : Ne serais-tu pas dans une DB ?
Si tu as des soucis de compréhension du langage, il vaudrait mieux poser une question claire et détaillée sur le forum en précisant bien dans quel environnement tu te trouves
Les commentaires de sources ne sont pas fait pour débuguer les adaptations du code présenté.
cs_Jack
Messages postés
14007
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
 78
7 déc. 2009 à 09:28
?
Bah
maTextBox.Text = GenererSerial3(Param1, Param2, Param3)
(je ne vois pas trop d'où vient ce DoCmd ... Tu programmes dans quoi ? VBA, VB6 ?)
Si l'erreur persiste, il faut lancer le programme avec F8 pour exécuter pas à pas le programme et voir en détail quelle instruction provoque cette erreur + vérifier le contenu de chaque variable impliquée.
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
 71
7 déc. 2009 à 09:27
numéro de série de l apartition? ça ne va pas, donc, si on ghost la chose : le numéro sur chaque machine sera identique.
PatrickYohann
Messages postés
10
Date d'inscription
mardi 1 décembre 2009
Statut
Membre
Dernière intervention
7 juin 2010
7 déc. 2009 à 08:23
C'est exactement ce que j'ai fait. La preuve c'est que sur le premier lien que j'ai donné, le serial généré s'affiche bien.
Comment donc l'afficher dans le champ "SerialGénéré" par clic sur un bouton de commande? Telle demeure ma préoccupation.
Afficher les 34 commentaires
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)