Logiciel de gestion de licence

Bonjour tout le monde,

Petit nouveau sur cette plateforme.

Je vous sollicite car j'ai un problème.

J'ai obtenu sur internet un programme excel de gestion de licence.

Introduit dans un classeur excel, il permet de générer un numéro de licence qui ne sera reconnu uniquement sur le pc sur lequel il aura été généré.

Il fonctionne très bien sur win xp. Mais lorsque je l'utilise sur win 7 ou win 10, il ne fonctionne plus. Il ne reconnait pas le numéro de licence généré.

Dans le fichier "GetWinVer_bas.bas", je vois que le programme ne prend en charge que les versions jusqu'a win xp.

Peut-être que le problème viens de là.

Je transmets une procédure d'utilisation ainsi que les fichiers utilisés.

Si quelqu’un peut m'aider, cela serait super.

131licencexlsbdr.zip (181.37 Ko)
95licence-test.zip (55.82 Ko)

Bonjour,

essayez à tous hasard de remplacer :

#If Win64 Then

par

#If VBA7 Or Win64 Then

partout où c'est écrit, dans les modules et/ou modules de classe, afin de "supporter" des version récente de VBA sur des machines en Win32...

Sans aucunes certitudes

@ bientôt

LouReeD

Je te remercie de ta réponse rapide.

J'essaye et je te tiens au courant.

au passage, comment tu fais pour insérer des petites fenêtres de code ?

Les balises d'édition du message juste au dessus de la fenêtre d'édition.

Pour le code VBA ce sont les "</>"

En passant la souris dessus il y a des infos bulles, mais ça c'est bientôt de l'histoire ancienne si je puis dire !

@ bientôt

LouReeD

Rebonjour LouReed,

Je te remercie pour ta solution, mais cela n'a rien changé au premier abord.

Je pense qu'une des pistes envisageable est dans le module GetWinVer_bas.

Après avoir lu attentivement ce code, je me suis rendu compte qu'il ne prenait en charge les système d'exploitation seulement jusqu’à win xp.

Je penses qu'il faudrait ajouter win7 et win10 pour qu'ils soient pris en charges. Le code prévoit normalement de gérer les systèmes 64 bits par des PtrSafe (il me semble)

Après plusieurs essais, je suis obligé de reconnaître que cela dépasse mes compétences (d'où ma venue sur ce forum).

Aurais-tu la clémence de jeter un coup d'oeuil pour voir si cela te semble une piste intéressante et surtout comment paramétrer win7 et win10 dessus?

Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2
'windows-defined type OSVERSIONINFO
Public Type OSVERSIONINFO
OSVSize As Long 'size, in bytes, of this data structure
dwVerMajor As Long 'ie NT 3.51, dwVerMajor = 3; NT 4.0, dwVerMajor = 4.
dwVerMinor As Long 'ie NT 3.51, dwVerMinor = 51; NT 4.0, dwVerMinor= 0.
dwBuildNumber As Long 'NT: build number of the OS
'Win9x: build number of the OS in low-order word.
' High-order word contains major & minor ver nos.
PlatformID As Long 'Identifies the operating system platform.
szCSDVersion As String * 128 'NT: string, such as "Service Pack 3"
'Win9x: 'arbitrary additional information'
End Type
'my type for holding the retrieved info
Public Type RGB_WINVER
PlatformID As Long
VersionName As String
VersionNo As String
ServicePack As String
BuildNo As String
End Type
#If Win32 Then
    Public Declare Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
#Else
   Public Declare PtrSafe Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
#End If
Public Function GetWinVersion(WIN As RGB_WINVER) As String
'returns a structure (RGB_WINVER)
'filled with OS information
#If Win32 Then
Dim OSV As OSVERSIONINFO
Dim pos As Integer
Dim sVer As String
Dim sBuild As String
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
'PlatformId contains a value representing the OS
WIN.PlatformID = OSV.PlatformID
Select Case OSV.PlatformID
Case VER_PLATFORM_WIN32s: WIN.VersionName = "Win32s"
Case VER_PLATFORM_WIN32_NT: WIN.VersionName = "Windows NT"
Select Case OSV.dwVerMajor
Case 4: WIN.VersionName = "Windows NT"
Case 5:
Select Case OSV.dwVerMinor
Case 0: WIN.VersionName = "Windows 2000"
Case 1: WIN.VersionName = "Windows XP"
End Select
End Select
Case VER_PLATFORM_WIN32_WINDOWS:
'The dwVerMinor bit tells if its 95 or 98.
Select Case OSV.dwVerMinor
Case 0: WIN.VersionName = "Windows 95"
Case 90: WIN.VersionName = "Windows ME"
Case Else: WIN.VersionName = "Windows 98"
End Select
End Select
'Get the version number
WIN.VersionNo = OSV.dwVerMajor & "." & OSV.dwVerMinor
'Get the build
WIN.BuildNo = (OSV.dwBuildNumber And &HFFFF&)
'Any additional info. In Win9x, this can be
'"any arbitrary string" provided by the
'manufacturer. In NT, this is the service pack.
pos = InStr(OSV.szCSDVersion, Chr$(0))
If pos Then
WIN.ServicePack = Left$(OSV.szCSDVersion, pos - 1)
End If
End If
#Else
'can only return that this does not
'support the 32 bit call, so must be Win3x
WIN.VersionName = "Windows 3.x"
#End If
End Function
Public Function IsWin95() As Boolean
'returns True if running Win95
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
IsWin95 = (OSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS) And _
(OSV.dwVerMajor = 4 And OSV.dwVerMinor = 0)
End If
#End If
End Function
Public Function IsWin98() As Boolean
'returns True if running Win98
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
IsWin98 = (OSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS) And _
(OSV.dwVerMajor > 4) Or _
(OSV.dwVerMajor = 4 And OSV.dwVerMinor > 0)
End If
#End If
End Function
Public Function IsWinME() As Boolean
'returns True if running Windows ME
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
IsWinME = (OSV.PlatformID = VER_PLATFORM_WIN32_WINDOWS) And _
(OSV.dwVerMajor = 4 And OSV.dwVerMinor = 90)
End If
#End If
End Function
Public Function IsWinNT4() As Boolean
'returns True if running WinNT4
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
'PlatformId contains a value representing the OS.
'If VER_PLATFORM_WIN32_NT and dwVerMajor is 4, return true
IsWinNT4 = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
(OSV.dwVerMajor = 4)
End If
#End If
End Function
Public Function IsWin2000() As Boolean
'returns True if running Windows 2000 (NT5)
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
IsWin2000 = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
(OSV.dwVerMajor = 5 And OSV.dwVerMinor = 0)
End If
#End If
End Function
Public Function IsWinXP() As Boolean
'returns True if running WinXP (NT5.1)
#If Win32 Then
Dim OSV As OSVERSIONINFO
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
IsWinXP = (OSV.PlatformID = VER_PLATFORM_WIN32_NT) And _
(OSV.dwVerMajor = 5 And OSV.dwVerMinor = 1)
End If
#End If
End Function
Public Function GetWinVer() As String
'returns a string representing the version,
'ie "95", "98", "NT4", "WinXP"
#If Win32 Then
Dim OSV As OSVERSIONINFO
Dim R As Long
Dim pos As Integer
Dim sVer As String
Dim sBuild As String
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
'PlatformId contains a value representing the OS
Select Case OSV.PlatformID
Case VER_PLATFORM_WIN32s: GetWinVer = "32s"
Case VER_PLATFORM_WIN32_NT:
'dwVerMajor = NT version.
'dwVerMinor = minor version
Select Case OSV.dwVerMajor
Case 3:
Select Case OSV.dwVerMinor
Case 0: GetWinVer = "NT3"
Case 1: GetWinVer = "NT3.1"
Case 5: GetWinVer = "NT3.5"
Case 51: GetWinVer = "NT3.51"
End Select
Case 4: GetWinVer = "NT 4"
Case 5:
Select Case OSV.dwVerMinor
Case 0: GetWinVer = "Win2000"
Case 1: GetWinVer = "WinXP"
End Select
End Select
Case VER_PLATFORM_WIN32_WINDOWS:
'dwVerMinor bit tells if its 95 or 98.
Select Case OSV.dwVerMinor
Case 0: GetWinVer = "95"
Case 90: GetWinVer = "ME"
Case Else: GetWinVer = "98"
End Select
End Select
End If
#Else
'can only return that this does not
'support the 32 bit call, so must be Win3x
GetWinVer = "3x"
#End If
End Function

Première modification :

Public Function GetWinVer() As String
'returns a string representing the version,
'ie "95", "98", "NT4", "WinXP"
#If Win32 Then
Dim OSV As OSVERSIONINFO
Dim R As Long
Dim pos As Integer
Dim sVer As String
Dim sBuild As String
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
    'PlatformId contains a value representing the OS
    Select Case OSV.PlatformID
        Case VER_PLATFORM_WIN32s: GetWinVer = "32s"
        Case VER_PLATFORM_WIN32_NT:
        'dwVerMajor = NT version.
        'dwVerMinor = minor version
        Select Case OSV.dwVerMajor
            Case 3:
            Select Case OSV.dwVerMinor
                Case 0: GetWinVer = "NT3"
                Case 1: GetWinVer = "NT3.1"
                Case 5: GetWinVer = "NT3.5"
                Case 51: GetWinVer = "NT3.51"
            End Select
            Case 4: GetWinVer = "NT 4"
            Case 5:
            Select Case OSV.dwVerMinor
                Case 0: GetWinVer = "Win2000"
                Case 1: GetWinVer = "WinXP"
            End Select
            Case 6: GetWinVer = "Win7"
            Case 10: GetWinVer = "Win10"
        End Select
        Case VER_PLATFORM_WIN32_WINDOWS:
        'dwVerMinor bit tells if its 95 or 98.
        Select Case OSV.dwVerMinor
            Case 0: GetWinVer = "95"
            Case 90: GetWinVer = "ME"
            Case Else: GetWinVer = "98"
        End Select
    End Select
End If
#Else
'can only return that this does not
'support the 32 bit call, so must be Win3x
GetWinVer = "3x"
#End If
End Function

A tester avec prudence !

@ bientôt

LouReeD

je regarde demain et je te redit

Merci beaucoup pour le temps que tu m'accorde.

Bonjour LouReeD,

Je me suis installé sur mon pc ce matin pour travailler sur ce que tu m'as envoyé hier.

Une chose bizarre se produit alors que je n'ai encore rien modifié.

Sur mes pc win xp et win vista, le fichier s’exécute normalement. Sur mes pc Win 10, le fichier s'ouvre mais lorsque je clique sur la macro "VerifLicence ()" ça mouline puis ça se ferme tout seul.

Ensuite soit ça se rouvre tout seul soit quand je rouvre le fichier il me propose dans une colonne à gauche la version de sauvegarde.

J'ai essayé avec le classeur "licence test" que je t'ai envoyé et qui fonctionnait bien hier, et il y a le même phénomène.

Je ne comprends pas ce qui se passe.............................

Bonjour,

Comme annoncé dans le mail : "à utiliser avec prudence !"

J'ai testé ma modification et cela m'a retourné un message demandant une clé de licence, et n'en ayant pas, un message me disant "petit malin" c'est affiché.

Au vu de quoi je me suis dit : "Ca marche !"

Mais à vrai dire sans trop savoir pourquoi du comment...

Ensuite, si lors de vos premiers tests cela avait l'air de fonctionner et que maintenant "en vrai" ça ne marche pas, alors là, je ne peux vous être utile car moi-même je n'ai pas "tout compris" au code, si ce n'est que la Case sélect est fait en fonction du numéro de version de Windows, j'ai mis le 6 pour Win Vista et le 10 pour Win 10, alors faut-il ajouter le 7 pour Win 7, et le 8 pour Win 8...

Je vous laisse faire les tests ?

@ bientôt

LouReeD

En fait le problème n'a rien à voir avec le code que vous m'avez envoyé, je n'ai rien changé.

Le fichier de base que je vous ai transmis l'autre jour ne fonctionne plus sous mes pc win 10 alors qu'il fonctionnait hier....................................... Je ne comprends pas se qu'il se passe.

Sans indiscrétion, vous avez quel windows ?

Est si vous avez win 10 est ce qu'il s'ouvre chez vous?

Houla ! Windows 10, le Windows à problème ?! Non, non, j'ai le 8, et un ordi de 2013 !

Et Excel 2016, car 2019 il lui faut Windows 10 minimum !

La première fois que j'ai lancé le code il a tourné dans le vide, obliger d'ouvrir le gestionnaire...

Après l'ajout des deux Case supplémentaire, il m'a bien "trouver" la version de Windows et la suite je l'ai raconté sur le message précédent.

Après je n'avais pas fait attention que le code allait dans le registre....

C'est de ma faute je n'ai pas regardé ! C'est pourquoi après je vous aie dis "avec prudence !"

@ bientôt

LouReeD

Bonjour LouReed,

Je me suis remis sur ma macro Veriflicence () qui ferme excel sur Win10 lorsqu'elle s'exécute.

Lorsque je fait un deboutage avec exécution jusqu'au curseur, excel se ferme au niveau de la ligne :

CodeProduit = BaseRegistre.Lit_Val("SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", "Produit")

Je te remet le code complet au cas où.

Private Sub VerifLicence()
Dim BaseRegistre As New Regs
Dim md5Test As New MD5
Dim CodeProduit As String
Dim Licence As String
CodeProduit = BaseRegistre.Lit_Val("SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", "Produit")
If CodeProduit = "" Then
    CodeProduit = md5Test.DigestStrToHexStr(GetMACAddress & GetWinVer & Now & Environ("Username") & Environ("Userprofile"))
    'BaseRegistre.CreateNewKey "SOFTWARE\KEY_LOCAL_MICROSOT"
    BaseRegistre.CreateNewKey "SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD"
    BaseRegistre.Enreg_Val "SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", CodeProduit, ""
    BaseRegistre.Enreg_Val "SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", "Produit", CodeProduit
End If
Debug.Print CodeProduit
Licence = BaseRegistre.Lit_Val("SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", CodeProduit)
If Licence = "" Then
     BaseRegistre.Enreg_Val "SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", CodeProduit, InputBox("Code Produit : " & CodeProduit & vbCrLf & "Entrez le N? de licence :" & vbCrLf & "Ou contactez votre agence commerciale.", "Gestionnaire de licence :")
End If
Licence = BaseRegistre.Lit_Val("SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", CodeProduit)
If md5Test.DigestStrToHexStr("1DA242EAF2A6EAF11937EE18311CD2FD" & CodeProduit) <> Licence Then
    BaseRegistre.Enreg_Val "SOFTWARE\KEY_LOCAL_MICROSOT\1DA242EAF2A6EAF11937EE18311CD2FD", CodeProduit, ""
    MsgBox "Petit malin !"
    Application.DisplayAlerts = False
Else
    MsgBox "Produit : " & CodeProduit & vbCrLf & "Licence : " & Licence
End If
End Sub

Est ce que tu y vois plus clair que moi ?

Sachant que le programme est le même depuis le debut et qu'avant je n'avais pas ce problème.

Les mystères de win10...…….

Alors là, je ne vais pas vous être utile...

Dès qu'on touche à la base de registre, j'ai peur !

Désolé, si un autre intervenant veut prendre le relais, mais le plus "simple" serait d'ouvrir un nouveau sujet...

@ bientôt

LouReeD

Si tu as quelqu'un a me recommander................. je veux bien, sinon je vais relancer un sujet.

En tout cas je te remercie s'incèrement, tu as été le seul à me répondre.

Tu as été rapide et efficace................ prends soin de toi et à bientôt

Rechercher des sujets similaires à "logiciel gestion licence"