IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

Script Lecture Registre


Sujet :

VBScript

  1. #1
    Membre averti
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    Janvier 2014
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Lot et Garonne (Aquitaine)

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Janvier 2014
    Messages : 15
    Par défaut Script Lecture Registre
    Bonour,

    Je voudrais créer un script qui me permet de vérifier la version d'un logiciel dans le registre, et qui vérifie si un logiciel est installé ou pas

    Merci par avance.

    Cordialement

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 420
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 420
    Par défaut
    J'essaye de faire une vérification depuis le registre, le souci c'est qu'il verifie pas et qui valide tout
    En réponse à ton post Essaie ce :
    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
    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
    Option Explicit
     
    	Const  ForWriting = 2
    	Const HKEY_CLASSES_ROOT  = &H80000000
    	Const HKEY_CURRENT_USER  = &H80000001
    	Const HKEY_LOCAL_MACHINE = &H80000002
    	Const HKEY_USERS         = &H80000003
    	Const REG_SZ        = 1
    	Const REG_EXPAND_SZ = 2
    	Const REG_BINARY    = 3
    	Const REG_DWORD     = 4
    	Const REG_MULTI_SZ  = 7
    	Dim RC , sPath, sNames, iTypes, sValue, objRegistry
    	Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true) ',TriStateTrue)
    	sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    	ROOT = HKEY_LOCAL_MACHINE
    	Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
    	RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
    	If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
    	  For j = LBound(sKeyNames) To UBound(sKeyNames)
    		RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
    		If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
    		    If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
    		    For i = LBound(iTypes) To UBound(iTypes)
    			   If iTypes(i) = REG_SZ Then
    				RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
    				If (LCase(sNames(i)) = "displayname" And sValue <> "")  Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then 
    				    msg = msg & sNames(i) & " = " & sValue
                                        Fich.Write msg & vbNewLine 
    				End If
    			    End If
    			    msg = ""
    		    Next ' pour i
    			'MsgBox msg
    		Else
    		'	Msgbox "L'erreur suivante est survenue : " & Err.Description
    		End If
    	  Next ' pour J
    	  Fich.Close
    	End If
    ' =================
      Function VerifTypes(ROOT, strPath, Types)
        ' Cette fonction vérifie si la clé (strPath) contient des valeurs 
    	' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
    	' pour ne pas retourner celles qui n'en contiennent pas.
        Dim Ret, strNames, Verif, ind
    	Verif = False
    	Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
    	If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
    	    For ind = LBound(strNames) To UBound(strNames)
    	       If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
    		    Verif = True
    		    Exit For
    		ELse 
                        Verif = False
                    End If			  
    	    Next
    	End If  
    	    VerifTypes = Verif
      End Function
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Membre averti
    Homme Profil pro
    Administrateur systèmes et réseaux
    Inscrit en
    Janvier 2014
    Messages
    15
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Lot et Garonne (Aquitaine)

    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Janvier 2014
    Messages : 15
    Par défaut
    Citation Envoyé par l_autodidacte Voir le message
    En réponse à ton post Essaie ce :
    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
    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
    Option Explicit
     
    	Const  ForWriting = 2
    	Const HKEY_CLASSES_ROOT  = &H80000000
    	Const HKEY_CURRENT_USER  = &H80000001
    	Const HKEY_LOCAL_MACHINE = &H80000002
    	Const HKEY_USERS         = &H80000003
    	Const REG_SZ        = 1
    	Const REG_EXPAND_SZ = 2
    	Const REG_BINARY    = 3
    	Const REG_DWORD     = 4
    	Const REG_MULTI_SZ  = 7
    	Dim RC , sPath, sNames, iTypes, sValue, objRegistry
    	Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true) ',TriStateTrue)
    	sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    	ROOT = HKEY_LOCAL_MACHINE
    	Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
    	RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
    	If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
    	  For j = LBound(sKeyNames) To UBound(sKeyNames)
    		RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
    		If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
    		    If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
    		    For i = LBound(iTypes) To UBound(iTypes)
    			   If iTypes(i) = REG_SZ Then
    				RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
    				If (LCase(sNames(i)) = "displayname" And sValue <> "")  Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then 
    				    msg = msg & sNames(i) & " = " & sValue
                                        Fich.Write msg & vbNewLine 
    				End If
    			    End If
    			    msg = ""
    		    Next ' pour i
    			'MsgBox msg
    		Else
    		'	Msgbox "L'erreur suivante est survenue : " & Err.Description
    		End If
    	  Next ' pour J
    	  Fich.Close
    	End If
    ' =================
      Function VerifTypes(ROOT, strPath, Types)
        ' Cette fonction vérifie si la clé (strPath) contient des valeurs 
    	' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
    	' pour ne pas retourner celles qui n'en contiennent pas.
        Dim Ret, strNames, Verif, ind
    	Verif = False
    	Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
    	If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
    	    For ind = LBound(strNames) To UBound(strNames)
    	       If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
    		    Verif = True
    		    Exit For
    		ELse 
                        Verif = False
                    End If			  
    	    Next
    	End If  
    	    VerifTypes = Verif
      End Function
    Désolé de répondre si tardivement, mais ces derniers temps je n'ai pas trop eu le temps.

    Je suis un bleu en script, mise à part le msgbox je ne sais rien faire d'autre, je me fixe donc ce challenge pour apprendre et je vous avoue que la j n'y comprend trop rien, comment puis-je l'adapter votre script pour un logiciel par exemple Adobe Reader ?

    Merci par avance.

  4. #4
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 420
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 69
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 420
    Par défaut
    Pour ne retourner que ce qui se rapporte à Adobe :
    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
    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
     Option Explicit
            ' Version 2
    	Const  ForWriting = 2
    	Const HKEY_CLASSES_ROOT  = &H80000000
    	Const HKEY_CURRENT_USER  = &H80000001
    	Const HKEY_LOCAL_MACHINE = &H80000002
    	Const HKEY_USERS         = &H80000003
    	Const REG_SZ        = 1
    	Const REG_EXPAND_SZ = 2
    	Const REG_BINARY    = 3
    	Const REG_DWORD     = 4
    	Const REG_MULTI_SZ  = 7
    	Dim RC , sPath, sNames, iTypes, sValue, objRegistry
    	Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true) 
    	sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    	ROOT = HKEY_LOCAL_MACHINE
    	Dim OK
    	OK = False
    	Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
    	RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
    	If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
    	  For j = LBound(sKeyNames) To UBound(sKeyNames)
    		RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
    		If InStr(1, LCase(sKeyNames(j)), "adobe") > 0 Then ' C'est là que se joue la sélection de l'application à vérifier
    		        ' ce qui permet de voir le nom et la version sous la clé correspondante
    		   If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
    			 If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes)  Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
    			 For i = LBound(iTypes) To UBound(iTypes)
    				If iTypes(i) = REG_SZ Then
    						RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
    						If (LCase(sNames(i)) = "displayname" And sValue <> "")  Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then 
    							msg = vbTab & msg & sNames(i) & " = " & sValue '& " ; "
    							Fich.Write msg & vbNewLine 
    						End If
    				End If
    				msg = ""
    			 Next ' pour i
    		   Else
    		     ' Msgbox "L'erreur suivante est survenue : " & Err.Description
    		   End If
    		End If
    	  Next ' pour J
    	  Fich.Close
    	End If
    ' =================
      Function VerifTypes(ROOT, strPath, Types)
        ' Cette fonction vérifie si la clé (strPath) contient des valeurs 
    	' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
    	' pour ne pas retourner celles qui n'en contiennent pas.
        Dim Ret, strNames, Verif, ind
    	Verif = False
    	Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
    	If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
    	    For ind = LBound(strNames) To UBound(strNames)
    	       If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
    		      Verif = True
    			  Exit For
    		   ELse 
                  Verif = False
               End If			  
    		Next
    	End If  
    	    VerifTypes = Verif
      End Function
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  5. #5
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut

    En ajoutant une fonction d'extraction de la version du soft Adobe Reader par une expression régulière au script précédemment posté par l_autodidacte
    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
    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
    Option Explicit
    Const  ForWriting = 2
    Const HKEY_CLASSES_ROOT  = &H80000000
    Const HKEY_CURRENT_USER  = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS         = &H80000003
    Const REG_SZ        = 1
    Const REG_EXPAND_SZ = 2
    Const REG_BINARY    = 3
    Const REG_DWORD     = 4
    Const REG_MULTI_SZ  = 7
    Dim RC , sPath, sNames, iTypes, sValue, objRegistry
    Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true)
    Dim shell : Set shell = CreateObject("WScript.Shell")    
    sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    ROOT = HKEY_LOCAL_MACHINE
    Dim OK
    OK = False
    Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
    RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
    If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
        For j = LBound(sKeyNames) To UBound(sKeyNames)
            RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
            If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
                If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) And OK Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
                For i = LBound(iTypes) To UBound(iTypes)
                    If iTypes(i) = REG_SZ Then
                        RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
                        If (LCase(sNames(i)) = "displayname" And sValue <> "")  Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then 
                            If InStr(1,LCase(sValue),"adobe reader") > 0 Then
                                msg = msg & sNames(i) & " = " & sValue
                                OK = True
                                MsgBox sValue & VbcrLf & "La version du soft Adobe Reader est : "& ExtractVersion(sValue),64,"Version du Soft Adobe Reader"
                                Fich.Write msg & vbNewLine & "La version du soft Adobe Reader est : "& ExtractVersion(sValue)
                            End If    
                        End If
                        OK = False
                    End If
                    msg = ""
                Next ' pour i
    'MsgBox msg
            Else
                Msgbox "L'erreur suivante est survenue : " & Err.Description
            End If
        Next ' pour J
        Fich.Close
    End If
    Shell.run "version.txt"
    ' =================
    Function VerifTypes(ROOT, strPath, Types)
    ' Cette fonction vérifie si la clé (strPath) contient des valeurs 
    ' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
    ' pour ne pas retourner celles qui n'en contiennent pas.
        Dim Ret, strNames, Verif, ind
        Verif = False
        Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
        If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
            For ind = LBound(strNames) To UBound(strNames)
                If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
                    Verif = True
                    Exit For
                ELse 
                    Verif = False
                    End If              
                Next
            End If  
            VerifTypes = Verif
    End Function
     
    Function ExtractVersion(Data) 
        Dim objRegex,Match,Matches
        Set objRegex = new RegExp
        objRegex.Pattern = ".\d.\d.\d"
        objRegex.Global = True
        objRegex.IgnoreCase = True
        Set Matches = objRegex.Execute(Data)
            For Each Match in Matches
                ExtractVersion = Match.Value
            Next
    End Function

  6. #6
    Expert confirmé
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 844
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 844
    Par défaut comparaison de la version en ligne avec la version installée sur le PC du soft Acrobat Reader

    Voici le script plus complet avec une comparaison de la version en ligne avec la version installée sur le PC du soft Acrobat Reader
    Donc à tester
    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
    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
    Option Explicit
    Const  ForWriting = 2
    Const HKEY_CLASSES_ROOT  = &H80000000
    Const HKEY_CURRENT_USER  = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS         = &H80000003
    Const REG_SZ        = 1
    Const REG_EXPAND_SZ = 2
    Const REG_BINARY    = 3
    Const REG_DWORD     = 4
    Const REG_MULTI_SZ  = 7
    Dim RC , sPath, sNames, iTypes, sValue, objRegistry
    Dim ROOT, i, j , msg, sKey, RC1, sKeyNames, fso, Fich
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fich = fso.OpenTextFile("Version.txt", ForWriting, true)
    Dim shell : Set shell = CreateObject("WScript.Shell")    
    sPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    ROOT = HKEY_LOCAL_MACHINE
    Dim OK
    OK = False
    Set objRegistry = GetObject("WinMgmts:root\default:StdRegProv")
    RC1 = objRegistry.EnumKey(ROOT, sPath, sKeyNames)
    If (RC1 = 0) And (Err.Number = 0) And Not IsEmpty(sKeyNames) Then
        For j = LBound(sKeyNames) To UBound(sKeyNames)
            RC = objRegistry.EnumValues(ROOT, sPath & sKeyNames(j), sNames, iTypes)
            If (RC = 0) And (Err.Number = 0) And IsArray(sNames) Then
                If VerifTypes(ROOT, sPath & sKeyNames(j), iTypes) And OK Then Fich.WriteLine vbNewLine & sKeyNames(j) & " : "
                For i = LBound(iTypes) To UBound(iTypes)
                    If iTypes(i) = REG_SZ Then
                        RC = objRegistry.GetStringValue(ROOT , sPath & sKeyNames(J), sNames(i), sValue)
                        If (LCase(sNames(i)) = "displayname" And sValue <> "")  Or (LCase(sNames(i)) = "displayversion" And sValue <> "") Then 
                            If InStr(1,LCase(sValue),"adobe reader") > 0 Then
                                msg = msg & sNames(i) & " = " & sValue
                                OK = True
                                MsgBox sValue & VbcrLf & "La version installée du soft Adobe Reader est : "& ExtractVersion(sValue),64,"La Version installée du Soft Adobe Reader"
                                Dim MyVer,NetVersion,URL,ws
                                MyVer = ExtractVersion(sValue)
                                URL = "http://get.adobe.com/fr/reader/"
                                NetVersion = GetAdobeMajorVersion(URL)
                                If CompareVersions(MyVer,NetVersion) = -1 Then
                                    MsgBox "La dernière version d'acrobat reader est : " & NetVersion & VbCrlf &_
                                    "Il y a une mise à jour en ligne !",48,"Il y a une mise à jour en ligne ! "
                                    set ws = CreateObject("WScript.Shell")
                                    ws.run URL
                                Else
                                    MsgBox "Acrobat Reader est à jour !",64,"Acrobat Reader est à jour !"
                                end if
                                Fich.Write msg & vbNewLine & "La version installée du soft Adobe Reader est : "& ExtractVersion(sValue) & vbNewLine
                            End If    
                        End If
                        OK = False
                    End If
                    msg = ""
                Next ' pour i
    'MsgBox msg
            Else
                Msgbox "L'erreur suivante est survenue : " & Err.Description
            End If
        Next ' pour J
        Fich.Close
    End If
    Shell.run "version.txt"
    '******************************************************************************************************************
    Function Lsh(ByVal N, ByVal Bits)
        Lsh = N * (2 ^ Bits)
    End Function
    '***************************************************************************************
    Function VerifTypes(ROOT, strPath, Types)
    ' Cette fonction vérifie si la clé (strPath) contient des valeurs 
    ' "DisplayVersion" ou "DisplayName" et qui ne sont pas être vides
    ' pour ne pas retourner celles qui n'en contiennent pas.
        Dim Ret, strNames, Verif, ind
        Verif = False
        Ret = objRegistry.EnumValues(ROOT, strPath,strNames, Types)
        If (Ret = 0) And (Err.Number = 0) And IsArray(strNames) Then
            For ind = LBound(strNames) To UBound(strNames)
                If LCase(strNames(ind)) = "displayname" Or LCase(strNames(ind)) = "displayversion" Then
                    Verif = True
                    Exit For
                ELse 
                    Verif = False
                    End If
                Next
            End If  
            VerifTypes = Verif
    End Function
    '***************************************************************************************
    Function ExtractVersion(Data) 
            Dim objRegex,Match,Matches
            Set objRegex = new RegExp
            objRegex.Pattern = ".\d.\d.\d.?"
            objRegex.Global = False
            objRegex.IgnoreCase = True
            Set Matches = objRegex.Execute(Data)
            For Each Match in Matches
                ExtractVersion = Match.Value
            Next
    End Function
    '***************************************************************************************
    Function GetVersionStringAsArray(ByVal Version)
            Dim VersionAll, VersionParts, N
            VersionAll = Array(0, 0, 0, 0)
            VersionParts = Split(Version, ".")
            For N = 0 To UBound(VersionParts)
                VersionAll(N) = CLng(VersionParts(N))
            Next
            Dim Hi, Lo
            Hi = Lsh(VersionAll(0), 16) + VersionAll(1)
            Lo = Lsh(VersionAll(2), 16) + VersionAll(3)
     
            GetVersionStringAsArray = Array(Hi, Lo)
    End Function
    '***************************************************************************************
    ' Compares two versions "a.b.c.d". If Version1 < Version2,
    ' returns -1. If Version1 = Version2, returns 0.
    ' If Version1 > Version2, returns 1.
    Function CompareVersions(ByVal Version1, ByVal Version2)
            Dim Ver1, Ver2, Result
            Ver1 = GetVersionStringAsArray(Version1)
            Ver2 = GetVersionStringAsArray(Version2)
            If Ver1(0) < Ver2(0) Then
                Result = -1
            ElseIf Ver1(0) = Ver2(0) Then
                If Ver1(1) < Ver2(1) Then
                    Result = -1
                ElseIf Ver1(1) = Ver2(1) Then
                    Result = 0
                Else
                    Result = 1
                End If
            Else
                Result = 1
            End If
            CompareVersions = Result
    End Function
    '***************************************************************************************
    Function GetAdobeMajorVersion(URL)
            Dim Titre,ie,objFSO,Data,OutPut,objRegex,Match,Matches
            Titre = "La dernière version de Adobe Reader"
            Set ie = CreateObject("InternetExplorer.Application")
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            ie.Navigate(URL)
            ie.Visible=False
            DO WHILE ie.busy
                Wscript.Sleep 100
            Loop
            Data = ie.document.documentElement.innertext
            Set objRegex = new RegExp
            objRegex.Pattern = ".\d.\d.\d."
            objRegex.Global = False
            objRegex.IgnoreCase = True
            Set Matches = objRegex.Execute(Data)
            For Each Match in Matches
                GetAdobeMajorVersion = Match.Value
            Next
            ie.Quit
            Set ie = Nothing
    End Function
    '***************************************************************************************

Discussions similaires

  1. Script lecture carte identité
    Par legrandse dans le forum Général JavaScript
    Réponses: 12
    Dernier message: 07/12/2010, 17h19
  2. [MP3] Script lecture ID3 ?
    Par ecocentric dans le forum Multimédia
    Réponses: 3
    Dernier message: 17/05/2007, 03h32
  3. Lecture Registre Distant avec login et mot de passe
    Par foimpou dans le forum Langage
    Réponses: 1
    Dernier message: 16/04/2007, 11h56
  4. Lecture registre en restreint XP
    Par eag35 dans le forum MFC
    Réponses: 2
    Dernier message: 08/09/2006, 14h25
  5. Problème de lecture registre avec RegEnumKeyEx
    Par mdriesbach dans le forum VB 6 et antérieur
    Réponses: 4
    Dernier message: 28/10/2005, 11h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo