Suite au topic "
http://www.vbfrance.com/infomsg_CREATION-TABLE-MATIERES_888257.aspx#3 de mastere30, du 14/02/2007",
qui utilise des .bat pour inventorier certains fichiers sur plusieurs servers distants, et au vu de la durée
d'exécution de ces batchs, je me suis essayé à créer un script vbs paramétrable utilisant wbem et wmi.
Source / Exemple :
'
' Inventaire de fichiers sur disks locaux
' Résultat de cet inventaire dans un fichier .xls
'
' Ce script vbs peut être lancé en local ou sur un server distant
'
'
On Error Resume Next
Const WbemAuthenticationLevelPktPrivacy = 6
Set objNetwork = CreateObject("Wscript.Network")
strLocalComputer = objNetwork.ComputerName
strCredentials = InputBox _
("Please enter the user name, a blank space, and then the password:", _
"Enter User Credentials",objNetwork.UserName )
If strCredentials = "" Then
Wscript.Quit
End If
arrCredentials = Split(strCredentials," ")
strUser = arrCredentials(0)
strPassword = arrCredentials(1)
strNamespace = "root\cimv2"
strComputer = InputBox _
("Please enter the name of the computer you want to connect to:", _
"Enter Computer Name", objNetwork.ComputerName)
If strComputer = "" Then
Wscript.Quit
End If
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer _
(strComputer, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy
Const ForWriting = 2
Const HARD_DISK = 3 ' 3 = Local Disk, 4 = Network Drive
Dim colDisks, colFiles, ObjTextStream, objDico
Dim objTabExt, objDisk, objFile
Dim StartScript, i, OldList, FichierExcelServer
StartScript=Now
FichierExcelServer = GetPath() & "inventaire_server_" & strComputer & ".xls"
'Extension des fichiers à récupérer
objTabExt = Array("xls","xlt","doc","dot","pdf","pps","ppt","htm","txt")
Set objDico = CreateObject("Scripting.Dictionary")
objDico.CompareMode = VBBinaryCompare
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
For i=LBound(objTabExt) To UBound(objTabExt)
Set colFiles = objWMIService.ExecQuery _
("Select * from CIM_DataFile where Drive = '" &_
objDisk.Name & "' And Extension = '" & objTabExt(i) &"'")
For Each objFile in colFiles
If objDico.Exists(objDisk.Name & "§" & objTabExt(i)) Then
OldList = objDico.Item(objDisk.Name & "§" & objTabExt(i))
objDico.Item(objDisk.Name & "§" & objTabExt(i)) = OldList & "," &_
objFile.Name & "|" & clair(objFile.LastModified)
Else
objDico.Add objDisk.Name & "§" & objTabExt(i), objFile.Name &_
"|" & clair(objFile.LastModified)
End If
Next
Next
Next
'Destruction des objets
Set colFiles = Nothing
Set colDisks = Nothing
Set objNetWork = Nothing
Set objWMIService = Nothing
Set objWbemLocator = Nothing
'WScript.Echo "fin read disks" &vbCrLf& Now &vbCrLf& StartScript &vbCrLf& _
' DateDiff("n", StartTime,Now) & " minutes"
'Creation fichier xls par server
Dim cles, elements, j
cles = objDico.Keys
elements = objDico.Items
Dim objExcel, ligne, NL, col
Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = False 'oui=True non=False
objExcel.DisplayAlerts = False
objExcel.Workbooks.Add
i = ""
For i = 0 To objDico.Count-1
'Ajout d'une feuille
objExcel.ActiveWorkbook.Sheets.Add
'Renomme la feuille
objExcel.Sheets(1).Name = "disk=" &_
Replace(Replace(Replace(cles(i), "§", " ext="),":",""),"\","")
'en-tête de ligne
objExcel.Cells(1, 1).Value = "Nom"
objExcel.Cells(1, 2).Value = "Date de Modification"
NL = 2
'ecriture ligne
ligne = Split(elements(i),",")
For j = 0 To UBound(ligne)
If InStr( ligne(j), "|") Then
col = Split(ligne(j),"|")
objExcel.Cells(NL, 1).Value = CStr(col(0))
objExcel.Cells(NL, 2).Value = CStr(col(1))
NL = NL + 1
End If
Next
objExcel.Columns("A:B").Select
objExcel.Selection.Columns.AutoFit
ObjExcel.Range("A1").Select
Next
'Mise en forme des colonnes
objExcel.Columns("A:B").Select
objExcel.Selection.Columns.AutoFit
ObjExcel.Range("A1").Select
ObjExcel.ActiveWorkbook.SaveAs FichierExcelServer 'sauvegarde le classeur
ObjExcel.DisplayAlerts = True 'remet l'alerte oui=True non=False
objExcel.Application.Visible=True 'remet la visibilité
objExcel.ActiveWorkbook.Close 'Fermeture d'Excel
ObjExcel.Quit
'Destruction des objets
Set objExcel = Nothing
Set objDico = Nothing
WScript.Echo "fin du script" &vbCrLf& Now &vbCrLf& StartScript &vbCrLf& _
"Durée: " & DateDiff("n", StartScript,Now) & " minutes"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Mise au format jj/mm/aaaa h:m de la date
Function clair(temps)
Dim debut, an, mois, jour, h, m
debut = left(temps,8)
an = left(debut,4)
mois = mid(debut,5,2)
jour = right(debut,2)
h = Mid(temps, 9,2)
m = Mid(temps, 11,2)
clair = CStr(jour) & "/" & CStr(mois) & "/" & CStr(an) & " " & h & ":" & m
End Function
'Récupère le répertoire courant
Function GetPath()
Dim path
'WScript.ScriptfullName ramène par exemple C:\MesAppli\LeScript.vbs
path = WScript.ScriptFullName
'On ne garde que ce qui est à gauche du dernier slash (compris), soit C:\MesAppli\
GetPath = Left(path, InStrRev(path, "\"))
End Function
Conclusion :
Ce script nécessite de connaitre les hostname, loggin et password du server.
Je rajouterai comment automatiser l'exécution sur plusieurs servers, mais avec
perte de confidentialité du loggin/password, en remplacant les 2 inputbox par un fichier .txt
J'ai mis un peu plus de commentaires qu'à l'accoutumée !
Il n'y a rien de bien compliqué et les objets/variables sont assez explicites.
N'hésitez à me signaler les éventuelles incompréhensions.
jean-marc