This script will extract all drivers from a computer and copy them to a folder structure organized by type. It is language dependent and currently works for Danish and English Operating System language.
Option Explicit
Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec("Dism.exe /online /get-drivers")
WScript.Echo "Started, Get drivers"
Dim iCounter
iCounter = 0
Do While oExec.Status = 0 And iCounter < 600
WScript.Sleep 100
iCounter = iCounter + 1
Loop
WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode
Dim sText, sDriverList
Dim aDriverList()
Dim iDriversCount
iDriversCount = 0
Do While Not oExec.StdOut.AtEndOfStream
sText = oExec.StdOut.ReadLine()
If Left(sText,17) = "Published Name : " Or Left(sText,17) = "Udgivelsesnavn : " Then
ReDim Preserve aDriverList(iDriversCount)
aDriverList(iDriversCount) = Trim(Right(sText,Len(sText)-17))
iDriversCount = iDriversCount + 1
End If
Loop
Dim sElement
Dim aOEMDriverPaths(), aOEMDriverClasses(), aOEMDriverVersion()
WScript.Echo "Number of OEM Drivers: " & iDriversCount
iDriversCount = 0
For Each sElement In aDriverList
Set oExec = WshShell.Exec("Dism.exe /online /get-driverInfo:" & sElement)
WScript.Echo "Started, get info for driver: " & sElement
iCounter = 0
Do While oExec.Status = 0 And iCounter < 100
WScript.Sleep 100
iCounter = iCounter + 1
Loop
WScript.Echo "Execute time: " & iCounter / 10 & " Sec."
WScript.Echo "Exit Code: " & oExec.ExitCode
Do While Not oExec.StdOut.AtEndOfStream
sText = oExec.StdOut.ReadLine()
If Left(sText,20) = "Driver Store Path : " Then
ReDim Preserve aOEMDriverPaths(iDriversCount)
aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-20))
End If
If Left(sText,22) = "Sti til driverlager : " Then
ReDim Preserve aOEMDriverPaths(iDriversCount)
aOEMDriverPaths(iDriversCount) = Trim(Right(sText,Len(sText)-22))
End If
If Left(sText,13) = "Class Name : " Or Left(sText,13) = "Klassenavn : "Then
ReDim Preserve aOEMDriverClasses(iDriversCount)
aOEMDriverClasses(iDriversCount) = Trim(Right(sText,Len(sText)-13))
End If
If Left(sText,10) = "Version : " Then
ReDim Preserve aOEMDriverVersion(iDriversCount)
aOEMDriverVersion(iDriversCount) = Trim(Right(sText,Len(sText)-10))
iDriversCount = iDriversCount + 1
End If
Loop
Next
Dim sScriptPath, sDriversDestinationPath
sScriptPath = Left(wscript.scriptfullname, Len(wscript.scriptfullname) - Len(wscript.scriptname))
Wscript.echo sScriptPath
Dim sComputer, oWMIService, cItems, oItem, sManufacturer, sModel
sComputer = "."
Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48)
For Each oItem in cItems
sManufacturer = oItem.Manufacturer
sModel = oItem.Model
Next
WScript.Echo "Number of OEM Drivers: " & iDriversCount
Dim sInfFileName, sDriverVersion, sDriverCopySource, sDriverCopyDistination, iWaitCounter
For iCounter = 0 To iDriversCount-1
sInfFileName = Right(aOEMDriverPaths(iCounter),Len(aOEMDriverPaths(iCounter))-InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
sInfFileName = Left(sInfFileName,Len(sInfFileName)-4)
sDriverVersion = aOEMDriverVersion(iCounter)
sDriversDestinationPath = sScriptPath & "Drivers\" & sManufacturer & "\" & sModel & "\"
sDriverCopySource = Left(aOEMDriverPaths(iCounter),InstrRev(aOEMDriverPaths(iCounter),"\",-1,vbTextCompare))
sDriverCopyDistination = sDriversDestinationPath & aOEMDriverClasses(iCounter) & "\" & sInfFileName & "_" & sDriverVersion
WScript.echo "Copy Driver: " & aOEMDriverClasses(iCounter) & " " & sInfFileName & " " & sDriverVersion
CopyFolder sDriverCopySource, sDriverCopyDistination, "Precompiled Setup Information"
Next
Function CopyFolder(sSourceFolder, sDestinationFolder, sExcludeType)
SearchSubFolders sSourceFolder, sDestinationFolder, sExcludeType
End Function
Sub SearchSubFolders(sSourceFoldersPath, sDestFoldersPath, sExcludeType)
Dim oFileSystem, oFolder, oFile, aExcludeType, bExclude, sElement
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
aExcludeType = Split(sExcludeType,",",-1,vbTextCompare)
'** Søg i under mapper ************************************************************
Set oFolder = oFileSystem.getFolder(sSourceFoldersPath)
For Each ofile in oFolder.SubFolders
SearchSubFolders sSourceFoldersPath & "\" & oFile.name, sDestFoldersPath & "\" & oFile.name, sExcludeType
Next
'** Kopier filer i mappe **********************************************************
For Each oFile in oFolder.Files
bExclude = False
For Each sElement In aExcludeType
If UCase(oFile.Type) = UCase(sElement) Then
bExclude = True
End If
Next
If Not bExclude Then
CopyFile sSourceFoldersPath, sDestFoldersPath, oFile.name
End If
Next
Set oFolder = Nothing
Set oFileSystem = nothing
End Sub
Function CopyFile(sSourceFilePath, sDestFilePath, sFile)
Dim oFileSystem, oCopyFile, oCopyFileDest, iSecondsDateDiff
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
'** Kontroller om destinations filen findes ****************************************
If oFileSystem.FileExists(sDestFilePath & "\" & sFile) Then
'** Destinations fil eksisterer, kontroller om kilde fil er nyere **********
Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
Set oCopyFileDest = oFileSystem.GetFile(sDestFilePath & "\" & sFile)
iSecondsDateDiff = DateDiff("s", oCopyFile.DateLastModified, oCopyFileDest.DateLastModified)
If iSecondsDateDiff < 0 Then
'** Kilde Fil er nyere, kopier fil *********************************
On Error resume Next
oCopyFile.Copy (sDestFilePath & "\" & sFile)
If Err.Number = 0 Then
'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile
Else
'** Fejl i kopiering, log fejl *****************************
wscript.echo "ERROR " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
End If
On Error Goto 0
End If
Set oCopyFile = nothing
Set oCopyFileDest = nothing
Else
'** Destination findes ikke, kopier fil ************************************
Set oCopyFile = oFileSystem.GetFile(sSourceFilePath & "\" & sFile)
CreateFolderTree(sDestFilePath)
On Error resume Next
oCopyFile.Copy (sDestFilePath & "\" & sFile)
'** Slet kilde fil, hvis kopiering gik godt ********************************
If Err.Number = 0 Then
'wscript.echo "File copied: " & sSourceFilePath & "\" & sFile
Else
'** Fejl i kopiering, log fejl *************************************
wscript.echo "Error " & Err.Number & " copy file: " & sSourceFilePath & "\" & sFile
End If
On Error Goto 0
Set oCopyFile = nothing
End If
Set oFileSystem = nothing
End Function
'******************************************************************************
Function CreateFolderTree(strInput)
Dim objFileSystemObject
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
If Not objFileSystemObject.FolderExists(strInput) Then
Dim arrFolderPath,intFolder,strFolderTree
arrFolderPath = Split(strInput,"\")
For intFolder = 0 To UBound(arrFolderPath)
strFolderTree = strFolderTree & arrFolderPath(intFolder) & "\"
If intFolder > 1 Then
If Not objFileSystemObject.FolderExists(strFolderTree) Then
objFileSystemObject.CreateFolder(strFolderTree)
End If
End If
Next
CreateFolderTree = True
Else
CreateFolderTree = False
End If
Set objFileSystemObject = nothing
End Function
Recent Comments