Blomqvist

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