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
160
161
162
163
164
165
166
167
| Option Explicit
Dim objNetwork, objDrive, intDrive, intNetLetter
Dim FSO, objFolder, objTextFile
Dim WshNetwork, SrtNewText, strText, path, objShell
Dim HostName, username, domainname
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
Set objShell = CreateObject("WScript.Shell")
HostName = WshNetwork.computername
username = WshNetwork.username
domainname = WshNetwork.UserDomain
'==========================================================================
'mettez ici l'emplacement du dossier dans lequel sera enregistrer le rapport
'si ce dossier n'existe pas, il sera crée
path = "C:\Infos\"
If Not FSO.FolderExists(path) Then Set objFolder = FSO.CreateFolder(path)
Set objTextFile = FSO.CreateTextFile(path & HostName & " - " & username & ".txt", True)
objTextFile.WriteLine vbCrLf & "=========================================================================="
objTextFile.WriteLine "== script pour identification matériel =="
objTextFile.WriteLine "== script pour identification matériel =="
objTextFile.WriteLine "==========================================================================" & vbCrLf
'==========================================================================
'INFOS GENERALES (Nom du poste, nom de l'utilisateur actuel)
'==========================================================================
objTextFile.WriteLine "== GENERAL ==========================================================" & vbCrLf
objTextFile.WriteLine "Nom du poste : " & HostName
Dim objWMISvc, colItems, objItem, strComputerDomain
Set objWMISvc = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMISvc.ExecQuery("Select * from Win32_ComputerSystem", , 48)
For Each objItem In colItems
strComputerDomain = objItem.Domain
If objItem.PartOfDomain Then
objTextFile.WriteLine "Domaine : " & strComputerDomain
Else
objTextFile.WriteLine "Workgroup : " & strComputerDomain
End If
objTextFile.WriteLine "Marque : " & objItem.Manufacturer
objTextFile.WriteLine "Modele : " & objItem.Model
Next
Set colItems = Nothing
Set objWMISvc = Nothing
Dim SNSet, SN
Set SNSet = GetObject("winmgmts:").InstancesOf("Win32_BIOS")
For Each SN In SNSet
objTextFile.WriteLine "Serial : " & SN.SerialNumber
Next
objTextFile.WriteLine
'==========================================================================
'INFOS SYSTEME
'==========================================================================
objTextFile.WriteLine "== SYSTEME EXPLOITATION =============================================" & vbCrLf
Set dtmConvertedDate = CreateObject("WbemScripting.SWbemDateTime")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystems
objTextFile.WriteLine "OS : " & objOperatingSystem.Caption
objTextFile.WriteLine "Version: " & objOperatingSystem.Version
objTextFile.WriteLine "Service Pack : " & objOperatingSystem.ServicePackMajorVersion
objTextFile.WriteLine "Numero Serie : " & objOperatingSystem.SerialNumber
objTextFile.WriteLine "Type Version : " & objOperatingSystem.BuildType
dtmConvertedDate.Value = objOperatingSystem.InstallDate
dtmInstallDate = dtmConvertedDate.GetVarDate
objTextFile.WriteLine "Date d'Installation : " & dtmInstallDate
objTextFile.WriteLine
Next
'==========================================================================
'RESEAU
'==========================================================================
objTextFile.WriteLine vbCrLf & "== RESEAU ===========================================================" & vbCrLf
Set colNicConfigs = objWMIService.ExecQuery("Select * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
n = 1
objTextFile.WriteLine
For Each objAdapter In colAdapters
objTextFile.WriteLine "Carte Reseau - " & objAdapter.Description
objTextFile.WriteLine " Adresse MAC : " & vbTab & objAdapter.MACAddress
If Not IsNull(objAdapter.IPAddress) Then
If objAdapter.DHCPEnabled = True Then
objTextFile.WriteLine " DHCP : " & vbTab & vbTab & "DHCP activé"
Else
objTextFile.WriteLine " DHCP : " & vbTab & vbTab & "DHCP désactivé"
objTextFile.WriteLine " L'adresse IP suivante est indicative, merci d'indiquer une adresse IP disponible differente de l'adresse affichee "
If Not IsNull(objAdapter.IPAddress) Then
For i = 0 To UBound(objAdapter.IPAddress)
objTextFile.WriteLine " Adresse IP : " & vbTab & vbTab & objAdapter.IPAddress(i)
Next
End If
If Not IsNull(objAdapter.IPSubnet) Then
For i = 0 To UBound(objAdapter.IPSubnet)
objTextFile.WriteLine " Sous Reseau: " & vbTab & vbTab & objAdapter.IPSubnet(i)
Next
End If
If Not IsNull(objAdapter.DefaultIPGateway) Then
For i = 0 To UBound(objAdapter.DefaultIPGateway)
objTextFile.WriteLine " Passerelle : " & vbTab & vbTab & objAdapter.DefaultIPGateway(i)
Next
End If
If IsNull(objAdapter.DefaultIPGateway) Then
objTextFile.WriteLine
objTextFile.WriteLine " Pas de DNS Specifie"
Else
If Not IsNull(objAdapter.DNSServerSearchOrder) Then
For i = 0 To UBound(objAdapter.DNSServerSearchOrder)
objTextFile.WriteLine " DNS : " & vbTab & vbTab & objAdapter.DNSServerSearchOrder(i)
Next
End If
objTextFile.WriteLine " Domaine DNS : " & objAdapter.DNSDomain
If Not IsNull(objAdapter.DNSDomainSuffixSearchOrder) Then
For i = 0 To UBound(objAdapter.DNSDomainSuffixSearchOrder)
objTextFile.WriteLine " Liste de recherche suffixe DNS : " & objAdapter.DNSDomainSuffixSearchOrder(i)
Next
End If
End If
' Configuration WINS
If IsNull(objAdapter.WINSPrimaryServer) And IsNull(objAdapter.WINSSecondaryServer) Then
objTextFile.WriteLine
objTextFile.WriteLine "Pas de WINS specifié"
objTextFile.WriteLine
Else
objTextFile.WriteLine " WINS"
objTextFile.WriteLine " ----"
objTextFile.WriteLine " Serveur WINS Primaire : " & objAdapter.WINSPrimaryServer
objTextFile.WriteLine " Serveur WINS Secondaire : " & objAdapter.WINSSecondaryServer
End If
End If
End If
n = n + 1
Next
'
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"
strValueName = "ProxyServer"
strproxyactif = "ProxyEnable"
oReg.GetDWORDValue HKEY_CURRENT_USER, strKeyPath, strproxyactif, dwValue_test
If dwValue_test = 1 Then
objTextFile.WriteLine " Serveur Proxy actif. " & vbTab & "SERVEUR PROXY Activé"
oReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue
objTextFile.WriteLine " Adresse du Serveur proxy : " & vbTab & dwValue
Else
objTextFile.WriteLine " Proxy inactif : " & vbTab & "PAS DE SERVEUR PROXY"
End If
objTextFile.WriteLine vbCrLf & "=========================================================================="
objTextFile.WriteLine "== File saved @ " & Now & " =="
objTextFile.WriteLine "=========================================================================="
objTextFile.Close
Set FSO = Nothing
Set WshNetwork = Nothing
Set objShell = Nothing
WScript.Quit (1)
'Function WMIDateStringToDate(utcDate)
' WMIDateStringToDate = CDate(Mid(utcDate, 5, 2) & "/" & Mid(utcDate, 7, 2) & "/" & Left(utcDate, 4) & " " & Mid (utcDate, 9, 2) & ":" & Mid(utcDate, 11, 2) & ":" & Mid(utcDate, 13, 2))
'End Function |
VBS pour identification poste
Répondre avec citation
Ne pas oublier le tag 
si satisfait.
Voter pour toute réponse satisfaisante avec 
pour encourager les intervenants.
Envoyé par l_autodidacte
et s'il n'y avait que les premières lignes qui posent problèmes .......
Partager