'========================================================================== 

' VBScript Source File -- Created with SAPIEN Technologies PrimalSCRIPT(TM) 

' 

' NAME: hardwareinventur.vbs 

' 

' AUTHOR:  Janke,  

' DATE  : 17.06.2002 

' 

' COMMENT: Erstellt ein Harwareverzeichnis für die gesamte Domäne 

' 

' (Nicht von dieseyer@gmx.de geprüft; v3.9.) 

'========================================================================== 

 

'**[ DECLARATIONS ]************ 

CONST ForReading = 1 

CONST ForWriting = 2 

CONST DEV_ID     = 0 

CONST FSYS       = 1 

CONST DSIZE      = 2 

CONST FSPACE     = 3 

CONST USPACE     = 4 

 

 

Dim fso, f, fsox, fx, objXL, wmiPath 

Dim computerIndex, wscr, adsi, intbutton, strStart 

Dim inputFile, outputFile, objKill, strAction, strComplete 

Dim strPC, intRow, strFilter, RowNum, strCompName 

Dim strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE 

Dim strRAM, strVir, strPage, strOS, strSP, strProdID, strStatic 

Dim strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed 

 

set adsi     = CreateObject("ADSystemInfo") 

set wscr     = CreateObject("WScript.Network") 

Set WshShell = WScript.CreateObject("WScript.Shell") 

strDomain    = WshShell.ExpandEnvironmentStrings("%USERDOMAIN%") 

 

outputFile = "C:\PC_Inv_NA.txt" 

TITLE      = WScript.ScriptName 

 

Call KillFile() 

 

set fso  = CreateObject("Scripting.FileSystemObject") 

' set fsox = CreateObject("Scripting.FileSystemObject") 

' set fx   = fsox.OpenTextFile(outputFile, ForWriting, True) 

set fx   = fso.OpenTextFile(outputFile, ForWriting, True) 

computerIndex = 1 

 

'****************** 

 

'**[ FUNCTIONS ]*************** 

 

Function Ask(strAction) 

     intButton = MsgBox(strAction, vbQuestion + vbYesNo, TITLE) 

     Ask = intButton = vbNo 

End Function 

 

'**[ MAIN SCRIPT ]************* 

 

If Ask("Soll Inventur gestartet werden?") Then 

     Wscript.Quit 

Else 

     strStart = "Programmstart: " & Date & " at " & time 

End If 

 

Call BuildXLS() 

Call Connect() 

Call Footer() 

objXL.ActiveWorkbook.SaveAs "c:\sms.xls" 

MsgBox "Programm beendet!", vbInformation + vbOKOnly, TITLE 

 

 

'****************** 

 

 

 

 

Sub Connect() 

  set ObjDomain = GetObject("WinNT://" + strDomain) 

  ObjDomain.Filter = Array("Computer")  

   

  For each ObjComp in ObjDomain  

         strPC = ObjComp.name 

 

               Call Error() 

               On Error Resume Next 

               strCompName = UCase(strPC) 

               set BIOSSet   = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select SerialNumber from Win32_BIOS") 

               for each BIOS in BIOSSet 

               strSN = BIOS.SerialNumber 

               Next 

               set MemorySet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select TotalPhysicalMemory, TotalVirtualMemory, TotalPageFileSpace from Win32_LogicalMemoryConfiguration") 

               for each Memory in MemorySet 

               strRAM = FormatNumber(Memory.TotalPhysicalMemory/1024,1) & " Mbytes" 

               strVir = FormatNumber(Memory.TotalVirtualMemory/1024,1) & " Mbytes" 

               strPage = FormatNumber(Memory.TotalPageFileSpace/1024,1) & " Mbytes" 

               Next 

               set OSSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Caption, CSDVersion, SerialNumber from Win32_OperatingSystem") 

               for each OS in OSSet 

               strOS = OS.Caption 

               strSP = OS.CSDVersion 

               strProdID = OS.SerialNumber 

               Next 

               set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select ServiceName, IPAddress, IPSubnet, DefaultIPGateway, MACAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE") 

 

               Count = 0 

               for each IPConfig in IPConfigSet 

                   Count = Count + 1 

               Next 

               ReDim sName(Count - 1) 

               ReDim sIP(Count - 1) 

               ReDim sMask(Count - 1) 

               ReDim sGate(Count - 1) 

               ReDim sMAC(Count - 1) 

               Count = 0 

 

               for each IPConfig in IPConfigSet 

               sName(Count) = IPConfig.ServiceName(0) 

               strNIC = sName(Count) 

               sIP(Count) = IPConfig.IPAddress(0) 

                   strIP = sIP(Count) 

                   sMask(Count) = IPConfig.IPSubnet(0) 

                   strMask = sMask(Count) 

                   sGate(Count) = IPConfig.DefaultIPGateway(0) 

                   strGate = sGate(Count) 

                   sMAC(Count) = IPConfig.MACAddress(0) 

                   strMAC = sMAC(Count) 

               Count = Count + 1 

               Next 

               set ProSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Name, MaxClockSpeed from Win32_Processor") 

               for each Pro in ProSet 

               strProc = Pro.Name 

               strSpeed = Pro.MaxClockSpeed 

               Next 

 

Call Disk_C() 

Call Disk_D() 

Call Disk_E() 

 

  Next ' --- Computer Object 

 

End Sub 

 

 

 

 

Sub BuildXLS() 

 

         intRow = 1 

         Set objXL = Wscript.CreateObject("Excel.Application") 

         objXL.Visible = True 

         objXL.WorkBooks.Add 

 

     

         objXL.Rows(1).RowHeight = 40 

 

      

         objXL.Columns(1).ColumnWidth = 14 

         objXL.Columns(2).ColumnWidth = 15 

         objXL.Columns(3).ColumnWidth = 7 

         objXL.Columns(4).ColumnWidth = 7 

         objXL.Columns(5).ColumnWidth = 11 

         objXL.Columns(6).ColumnWidth = 11 

         objXL.Columns(7).ColumnWidth = 11 

         objXL.Columns(8).ColumnWidth = 12 

         objXL.Columns(9).ColumnWidth = 12 

         objXL.Columns(10).ColumnWidth = 12 

         objXL.Columns(11).ColumnWidth = 32 

         objXL.Columns(12).ColumnWidth = 13 

         objXL.Columns(13).ColumnWidth = 24 

         objXL.Columns(14).ColumnWidth = 10 

         objXL.Columns(15).ColumnWidth = 12 

         objXL.Columns(16).ColumnWidth = 12 

         objXL.Columns(17).ColumnWidth = 12 

         objXL.Columns(18).ColumnWidth = 17 

         objXL.Columns(19).ColumnWidth = 24 

         objXL.Columns(20).ColumnWidth = 7 

 

         '*** Set Cell Format for Column Titles *** 

         objXL.Range("A1:T1").Select 

         objXL.Selection.Font.Bold = True 

         objXL.Selection.Interior.ColorIndex = 9 

         objXL.Selection.Interior.Pattern = 1      'xlSolid 

         objXL.Selection.Font.ColorIndex = 2 

         objXL.Selection.WrapText = True 

         objXL.Columns("A:T").Select 

         objXL.Selection.HorizontalAlignment = 3     'xlCenter 

 

     

         Call AddLineToXLS("Computer Name","Serial Number","Device ID","File System","Disk Size","Free Space","Used Space","Physical Memory","Virtual Memory","Page File","Operating System","Service Pack","Product ID","Network Card","IP Address","Subnet Mask","Default Gateway","MAC Address","Processor","Speed") 

 

End Sub 

 

 

 

Sub AddLineToXLS(strCompName, strSN, strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE, strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed) 

 

     objXL.Cells(intRow, 1).Value = strCompName 

     objXL.Cells(intRow, 2).Value = strSN 

     objXL.Cells(intRow, 3).Value = strDEV_ID 

     objXL.Cells(intRow, 4).Value = strFSYS 

     objXL.Cells(intRow, 5).Value = strDSIZE 

     objXL.Cells(intRow, 6).Value = strFSPACE 

     objXL.Cells(intRow, 7).Value = strUSPACE 

     objXL.Cells(intRow, 8).Value = strRAM 

     objXL.Cells(intRow, 9).Value = strVir 

     objXL.Cells(intRow, 10).Value = strPage 

     objXL.Cells(intRow, 11).Value = strOS 

     objXL.Cells(intRow, 12).Value = strSP 

     objXL.Cells(intRow, 13).Value = strProdID 

     objXL.Cells(intRow, 14).Value = strNIC 

     objXL.Cells(intRow, 15).Value = strIP 

     objXL.Cells(intRow, 16).Value = strMask 

     objXL.Cells(intRow, 17).Value = strGate 

     objXL.Cells(intRow, 18).Value = strMAC 

     objXL.Cells(intRow, 19).Value = strProc 

     objXL.Cells(intRow, 20).Value = strSpeed 

     intRow = intRow + 1 

     objXL.Cells(1, 1).Select 

End Sub 

 

 

Sub AddLineToDisk(strDEV_ID, strFSYS, strDSIZE, strFSPACE, strUSPACE) 

 

     objXL.Cells(intRow, 3).Value = strDEV_ID 

     objXL.Cells(intRow, 4).Value = strFSYS 

     objXL.Cells(intRow, 5).Value = strDSIZE 

     objXL.Cells(intRow, 6).Value = strFSPACE 

     objXL.Cells(intRow, 7).Value = strUSPACE 

     intRow = intRow + 1 

     objXL.Cells(1, 1).Select 

End Sub 

 

 

 

Sub Disk_C() 

     set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'C:' and DriveType = '3'") 

 

     ReDim strDisk(RowNum,4) 

     for each Disk in DiskSet 

      strDisk(RowNum,DEV_ID)= Disk.DeviceID 

          strDisk(RowNum,FSYS)= Disk.FileSystem 

          strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes" 

          strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes" 

          strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes" 

 

          Call AddLineToXLS(strCompName, strSN, strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE), strRAM, strVir, strPage, strOS, strSP, strProdID, strNIC, strIP, strMask, strGate, strMAC, strProc, strSpeed) 

     Next 

End Sub 

 

 

 

Sub Disk_D() 

     set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'D:' and DriveType = '3'") 

     On Error Resume Next 

     ReDim strDisk(RowNum,4) 

     for each Disk in DiskSet 

      strDisk(RowNum,DEV_ID)= Disk.DeviceID 

          strDisk(RowNum,FSYS)= Disk.FileSystem 

          strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes" 

          strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes" 

          strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes" 

          If IsNull(strDisk(RowNum,FSYS)) Then 

               Exit Sub 

          End If 

      

          Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE)) 

     Next 

End Sub 

 

Sub Disk_E() 

     set DiskSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select DeviceID, FileSystem, Size, FreeSpace from Win32_LogicalDisk where DeviceID = 'E:' and DriveType = '3'") 

     On Error Resume Next 

     ReDim strDisk(RowNum,4) 

     for each Disk in DiskSet 

      strDisk(RowNum,DEV_ID)= Disk.DeviceID 

          strDisk(RowNum,FSYS)= Disk.FileSystem 

          strDisk(RowNum,DSIZE)= FormatNumber(Disk.Size/2^30,1) & " Gbytes" 

          strDisk(RowNum,FSPACE)= FormatNumber(Disk.FreeSpace/2^30,1) & " Gbytes" 

          strDisk(RowNum,USPACE)= FormatNumber((Disk.Size-Disk.FreeSpace)/2^30,1) & " Gbytes" 

          If IsNull(strDisk(RowNum,FSYS)) Then 

               Exit Sub 

          End If 

          Call AddLineToDisk(strDisk(RowNum,DEV_ID), strDisk(RowNum,FSYS), strDisk(RowNum,DSIZE), strDisk(RowNum,FSPACE), strDisk(RowNum,USPACE)) 

     Next 

End Sub 

 

 

 

 

Sub KillFile() 

 

          Set objKill = CreateObject("Scripting.FileSystemObject") 

          If (objKill.FileExists("c:\sms.xls")) Then 

               objKill.DeleteFile("c:\sms.xls") 

          End If 

          If (objKill.FileExists("c:\PC_Inv_NA.txt")) Then 

               objKill.DeleteFile("c:\PC_Inv_NA.txt") 

          End If 

          Set objKill = Nothing 

End Sub 

 

 

 

Sub Footer() 

 

strFooter1           = "Janke, DTC" 

strFooter2           = "Script für PC Hardware Inventory" 

strComplete          = "Progammende : " & Date & " um " & time 

 

intRow = intRow + 5 

 

'** Set Cell Format for Row 

              objXL.Cells(intRow, 1).Select 

              objXL.Selection.Font.ColorIndex = 1 

              objXL.Selection.Font.Size = 8 

              objXL.Selection.Font.Bold = False 

              objXL.Selection.HorizontalAlignment = 2     'xlLeft 

              objXL.Cells(intRow, 1).Value = strFooter1 

 

          intRow = intRow + 1 

 

'** Set Cell Format for Row 

              objXL.Cells(intRow, 1).Select 

              objXL.Selection.Font.ColorIndex = 1 

              objXL.Selection.Font.Size = 8 

              objXL.Selection.Font.Bold = False 

              objXL.Selection.HorizontalAlignment = 2     'xlLeft 

              objXL.Cells(intRow, 1).Value = strFooter2 

 

          intRow = intRow + 1 

 

'** Set Cell Format for Row 

              objXL.Cells(intRow, 1).Select 

              objXL.Selection.Font.ColorIndex = 1 

              objXL.Selection.Font.Size = 8 

              objXL.Selection.Font.Bold = False 

              objXL.Selection.HorizontalAlignment = 2     'xlLeft 

              objXL.Cells(intRow, 1).Value = strStart 

 

          intRow = intRow + 1 

 

'** Set Cell Format for Row 

              objXL.Cells(intRow, 1).Select 

              objXL.Selection.Font.ColorIndex = 1 

              objXL.Selection.Font.Size = 8 

              objXL.Selection.Font.Bold = False 

              objXL.Selection.HorizontalAlignment = 2     'xlLeft 

              objXL.Cells(intRow, 1).Value = strComplete 

 

          intRow = intRow + 1 

 

End Sub 

 

 

 

Sub Error() 

 

          On Error Resume Next 

          set CompSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strPC & "/root/cimv2").ExecQuery("select Name from Win32_ComputerSystem") 

          If Err Then 

               fx.WriteLine(strPC) 

          End If 

          computerIndex = computerIndex + 1 

End Sub