Script Lecture Registre

Version imprimable

29/01/2014, 22h50
fouji

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

Citation:

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:

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

Citation:

Envoyé par l_autodidacte

En réponse à ton post Essaie ce :

Code:

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.

Pour ne retourner que ce qui se rapporte à Adobe :

Code:

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

:salut:
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:

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

comparaison de la version en ligne avec la version installée sur le PC du soft Acrobat Reader

:salut:
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 :king:
Donc à tester ;)

Code:

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
'***************************************************************************************