'v2.6***************************************************
' File:   inventar.VBS
' Autor:  dieseyer@gmx.de 
'         dieseyer.de 
'
' Es wird ein Unterverzeichnis erstellt (#PC_name) und
' die gesammelten Info's in #PC-Name.txt gespeichert:
'   Netz     : IP-Config und Netzwerkkartentreiber
'   Laufwerke: gesamte und freie Kapazität
'   Angemeldeter Nutzer und wo angemeldet
'   CPU-Type und -MHz; Hauptspeicher; Board-Chipsatz
'   Installierte Drucker(-treiber)
' 
' inventar.VBS ruft (www.sysid.subnet.dk/download.htm) 
' SYSID.EXE auf und speichert die Info's in
' #PCName-SysID.txt.
'
' Bei Win9x-PC's wird die #PC-Name-SW.txt mit der Liste
' installierten Programmen gefüllt.
'*******************************************************

Option Explicit

Dim CPULOG, CPURAM, OpSys, Text1, Text2, Text3, TextX, i, fso, fi1, fi2, fileout, objAdr
Dim WshEnvX, WshSysEnv, key1, PCText, lines, KeyX, Ziel, ZielPfad, ObjRemote, ScrPfad, DriveList
Dim WshShell, WSHNet, objReg, RootKey, XRootKey, NetPRN, name, oVal, XoVal, RegKey, ReadKey, oArgs
Dim ShellLink, FileIn, InventarLog 

Set WSHShell  = WScript.CreateObject("WScript.Shell")
Set WSHEnvX   = WSHShell.Environment("Process")
Set WshSysEnv = WshShell.Environment("SYSTEM")
set oArgs     = Wscript.Arguments

Set FSO       = CreateObject("Scripting.FileSystemObject")
Set DriveList = FSO.Drives

    TextX = 0
On Error Resume Next
  Set WSHNet    = WScript.CreateObject("WScript.Network")
  Set NetPRN    = WSHNet.EnumPrinterConnections
'    TextX = Err.Description
    TextX = Err.Number
On Error GoTo 0
    If not TextX = 0 then  MsgBox "Auf die Netzwerkumgebung kann nicht zugegriffen werden!" & vbCRLF & vbCRLF & "(Vermutlich nicht angemeldet.)", , WScript.ScriptName
    If not TextX = 0 then  WScript.Quit

  For i = 0 to oArgs.Count - 1                            ' hole alle Argumente
    ZielPfad = Left( oArgs.item(i),1 ) 
    Exit For                                              ' ein Argument reicht
  Next

' ermittelt nur Zielpfad
' -------------------------------------
  ZielLWTest     ' ermittelt nur ZielLaufwerksBuchstabe & -pfad

' ScrPfad       = fso.GetFolder(".")                                   ' akt. Verzeichnis ermitteln
ScrPfad       = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\") -1)

CPURAM        = ScrPfad & "\SYSID.EXE log"
CPURAM        = ScrPfad & "\SYSID.EXE"
CPULOG        = "Sysid.log"

if not fso.FileExists(CPURAM) Then MsgBox CPURAM & "   konnte nicht gefunden werden!", , WScript.ScriptName
if not fso.FileExists(CPURAM) Then WScript.Quit

' -------------------------------------------
' mit (eigenen) PC-Name Verzeichnis erstellen
' -------------------------------------------
if not ZielPfad = "" Then InventarLog = ZielPfad & "\inventar.log"
if     ZielPfad = "" Then InventarLog = "inventar.log"

if not ZielPfad = "" Then ZielPfad = ZielPfad & "\#" & UCase(wshnet.ComputerName)
if     ZielPfad = "" Then ZielPfad = ScrPfad  & "\#" & UCase(wshnet.ComputerName)

If Not fso.FolderExists(ZielPfad) Then fso.CreateFolder ZielPfad

Ziel     = ZielPfad & "\#" & UCase(wshnet.ComputerName) & ".txt"

' ######   Folgezeile freigeben
'  if fso.FileExists(Ziel) Then WScript.Quit

' -------------------------------------------
' Netz-Konfiguration ermitteln
' -------------------------------------------
if WshEnvX("OS") = "Windows_NT" then
    Set FileOut = fso.OpenTextFile(Ziel, 8, true)                    ' Datei zum Erweitern öffnen (notfals anlegen)
    fileOut.WriteLine ("### Anfang - Netzwerkumgebung")   
    Set FileOut = Nothing                                            ' Datei schließen
    WshShell.run  (WshSysEnv("COMSPEC") & " /c ipconfig /all >> """ & Ziel & """"),0 ,true
    Set FileOut = fso.OpenTextFile(Ziel, 8, true)                    ' Datei zum Erweitern öffnen (notfals anlegen)
    fileOut.WriteLine ("### Ende   - Netzwerkumgebung")   
    Set FileOut = Nothing                                            ' Datei schließen
else
    WshShell.run "winipcfg /all /batch " & Ziel ,0,true
end if

  Set FileOut = fso.OpenTextFile(Ziel, 8, true)                      ' Datei zum Erweitern öffnen (notfals anlegen)
  fileOut.WriteLine (" ")   
' -------------------------------------------
' 2x SUB - Routinen aufrufen
' -------------------------------------------
  LwListe
  PCEigenschaften

  fileOut.WriteLine (now)   
  Set FileOut = Nothing                                              ' Datei schließen

Text3 = Ziel

' -------------------------------------------
' bei Win9x/ME PC's: SoftWareListe
' -------------------------------------------
' ######   Folgezeile freigeben
if not WshEnvX("OS") = "Windows_NT" then Win8xSWListe

Set FileOut = fso.OpenTextFile(InventarLog, 8, true)                 ' Datei zum Erweitern öffnen (notfals anlegen)
  fileOut.WriteLine (now() & " - inventar.VBS beendet" & vbCRLF & Text3 & vbCRLF )   
Set FileOut = Nothing                                                ' Datei schließen

wshshell.Popup Text3, 15, "  inventar.VBS - Ende   (" & wshnet.ComputerName & ")", vbExclamation

WScript.Quit

Sub LwListe
' -------------------------------------------
' Liste der Laufwerke
' -------------------------------------------
fileOut.WriteLine ("### Anfang - Liste der Laufwerke")   
   Text2 = CInt(0)
   For Each i in DriveList 
      if 0  = i.DriveType Then  Text1  = "   ???     " & vbTab & i.DriveLetter & ":  " 
      if 1  = i.DriveType Then  Text1  = "   FD-Lw."   & vbTab & i.DriveLetter & ":  " 
      if 2  = i.DriveType Then  Text1  = "   Festpl."  & vbTab & i.DriveLetter & ":  " 
      if 3  = i.DriveType Then  Text1  = "   Netz-Lw." & vbTab & i.DriveLetter & ":  " 
      if 4  = i.DriveType Then  Text1  = "   CD-ROM"   & vbTab & i.DriveLetter & ":  " 
      if 5  = i.DriveType Then  Text1  = "   RAM-Lw."  & vbTab & i.DriveLetter & ":  " 
      If i.IsReady Then
          Text1 =               Text1 & FormatNumber(i.FreeSpace/1024/1024, 0) & "MB   von   " 
          Text1 =               Text1 & FormatNumber(i.TotalSize/1024/1024, 0) & "MB   frei"
      End If    
      fileOut.WriteLine (Text1)
      Text2 = Text2 & Text1 & vbCRLF
   Next
fileOut.WriteLine ("### Ende   - Liste der Laufwerke" & vbCRLF)   

End Sub ' LwListe


Sub PCEigenschaften
' -------------------------------------------
' PC - Eigenschaften
' -------------------------------------------
  fileOut.WriteLine (vbCrLf & "### Anfang - PC-Eigenschaften")   

  TextX = "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\VxD\VNETSUP\Workgroup"
  Text1 = ""

  On Error Resume Next
    Text1 = WSHShell.RegRead(TextX)
  If Text1 = "" Then
    fileOut.WriteLine ("   Angemeldet an Domäne " & vbTab & WshNetworK.UserDomain )
  Else
    fileOut.WriteLine ("   Angemeldet an Arbeitsgruppe " & vbTab & Text1)
  End If
    fileOut.WriteLine ("   Computername          : " & wshnet.ComputerName )
  fileOut.WriteLine "   Angemeldet ist  " & wshnet.UserName & "  an  "& wshnet.UserDomain & vbCRLF

' -------------------------------------------
' CPU-Type & Frequenz ermitteln
' -------------------------------------------
' ######   Folgezeile freigeben
  if fso.FileExists(CPULOG) Then fso.DeleteFile(CPULOG), True     ' Datei löschen fals vorhanden

TextX = ZielPfad & "\sysid.lnk"
Set ShellLink                  = WshShell.CreateShortcut(TextX)
    ShellLink.TargetPath       = CPURAM 
    ShellLink.WorkingDirectory = ZielPfad 
    ShellLink.Save
    if not fso.FileExists(TextX) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, "  Nach 3sek bin ich weg!", vbExclamation
    wshShell.Run (TextX & " log"),0 ,true
    if fso.FileExists(TextX) Then fso.DeleteFile(TextX), True        ' .lnk löschen fals vorhanden

  CPULOG = ZielPfad & "\" & CPULOG
  TextX  = ZielPfad & "\#" & UCase(wshnet.ComputerName) & "-SysID.txt"
    
  ' Sleep gibt's erst ab WSH2; deshalp x Sekunden PopUp, wenn Datei noch nicht vorhanden
  if not fso.FileExists(CPULOG) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 5, "  Nach 5sek bin ich weg!", vbExclamation
  FSO.CopyFile CPULOG, TextX

  Set FileIn = fso.OpenTextFile(CPULOG, 1, true)                     ' Datei zum Lesen öffnen 
    Do While Not (FileIn.atEndOfStream)
      TextX = FileIn.Readline 
'     If InStrRev(TextX, "cessor    ") > 1 Then  MsgBox CPULOG & vbCRLF & TextX,,"INVENTAR.VBS"
      If InStrRev(TextX, "cessor    ") > 1 Then fileOut.WriteLine("   " & TextX) 
      If InStrRev(TextX, "pu Clo")     > 1 Then fileOut.WriteLine("   " & TextX) 
      If InStrRev(TextX, "hipset")     > 1 Then fileOut.WriteLine("   " & TextX) 
      If InStrRev(TextX, "ysical mem") > 1 Then fileOut.WriteLine("   " & TextX) 
    Loop
  Set FileIn  = Nothing                                              ' Datei schließen

' -------------------------------------------
' installierte Hardware
' -------------------------------------------
  ' WinNT  VGA 0000
  KeyX    = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0000\DriverDesc"	
    On Error Resume Next
          Text2 = ""
          Text2 = WSHShell.RegRead(KeyX)
    On Error GoTo 0
    if not Text2 = "" then   fileOut.WriteLine ("   Grafikkarte           : " & Text2)       ' gelesenen Key in Datei schreiben

  ' WinNT  VGA 0001
  KeyX    = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0001\DriverDesc"	
    On Error Resume Next
          Text2 = ""
          Text2 = WSHShell.RegRead(KeyX)
    On Error GoTo 0
    if not Text2 = "" then   fileOut.WriteLine ("   Grafikkarte           : " & Text2)       ' gelesenen Key in Datei schreiben

  ' WinNT  VGA 0002
  KeyX    = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\0002\DriverDesc"	
    On Error Resume Next
          Text2 = ""
          Text2 = WSHShell.RegRead(KeyX)
    On Error GoTo 0
    if not Text2 = "" then   fileOut.WriteLine ("   Grafikkarte           : " & Text2)       ' gelesenen Key in Datei schreiben

  ' Win98SE  VGA
  KeyX    = "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Class\Display\0000\DriverDesc"
    On Error Resume Next
          Text2 = ""
          Text2 = WSHShell.RegRead(KeyX)
    On Error GoTo 0
    if not Text2 = "" then   fileOut.WriteLine ("   Grafikkarte           : " & Text2)       ' gelesenen Key in Datei schreiben

  fileOut.WriteLine ("   ")
  Set NetPRN    = WSHNet.EnumPrinterConnections
  For i = 0 To NetPRN.Count-1 Step 2
    TextX = "   Dr." & (i+2)/2 & vbTab & NetPRN(i) & vbTab & NetPRN(i+1)
    fileOut.WriteLine(TextX)
  Next

  fileOut.WriteLine ("### Ende   - PC-Eigenschaften" & vbCRLF)   

  if fso.FileExists(CPULOG) Then fso.DeleteFile(CPULOG), True        ' Datei löschen fals vorhanden

End Sub ' PCEigenschaften


Sub Win8xSWListe
' -------------------------------------
' Win9x/ME PC's: SoftWareListe
' -------------------------------------
  If (fso.FileExists("REGOBJ.DLL")) Then                              ' Regobj.dll registrieren
    TextX = "REGSVR32.EXE  " & "REGOBJ.DLL" & " /S"                   ' wird u.a. für den Remote-Zugriff benötigt
    WshShell.Run (TextX),,TRUE
    Set ObjReg    = WScript.CreateObject("RegObj.Registry")
   ' MsgBox TextX & vbTab & " wurde ausgeführt!"
  Else
    MsgBox TextX & vbTab & " konnte nicht aufgerufen werden!"
    WScript.Quit
  End If

  PCText = wshnet.ComputerName

  Ziel   = ZielPfad & "\#" & PCText & "-SW.txt" 
  Text3 = Text3 & vbTab & Ziel 
    Set FileOut   = fso.OpenTextFile(Ziel, 2, true)                   ' Datei zum Schreiben öffnen (notfals anlegen)

' -------------------------------------
' Betriebssystem ermitteln
' -------------------------------------
   ' WinNT
   KeyX  = "\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion"
   ' Win9x
   KeyX  = "\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion"

   Text1 = ""
   Text2 = ""
   On Error Resume Next
      Set RootKey = objReg.RegKeyFromString(keyX)
      For Each oVal In RootKey.Values  ' Auflistung Werte
         if oVal.Name = "Version"        then Text1 = oVal.Value 
         if oVal.Name = "VersionNumber"  then Text2 = oVal.Value 
         ' MsgBox oVal.Name & vbCRLF & oVal.Value
      Next
   On Error GoTo 0
   Set  RootKey = nothing
     if Text2 = "4.10.2222" Then Text2 = "SE"
   fileOut.WriteLine ("   " & Text1 & " " & Text2 & vbCRLF)

' -------------------------------------
' installierte Programme
' -------------------------------------
' Genauer: Die Programme, für die eine UNINSTALL-Routine installiert ist
     Text1 = ""
     Text2 = ""
   fileOut.WriteLine ("### Anfang - Liste der installierten Porogramme" )
     KeyX  = "\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
   Set RootKey = objReg.RegKeyFromString(keyX)
     For Each oVal In RootKey.SubKeys ' Auflistung Schlüssel
       Set XRootKey = objReg.RegKeyFromString(KeyX & oVal.Name & "\")
       For Each XoVal In XRootKey.Values  ' Auflistung Werte
         if XoVal.Name = "DisplayName" then fileOut.WriteLine ("   " & XoVal.Value )
'        if XoVal.Name = "DisplayName" then MsgBox XoVal.Value
       Next
     Next
   fileOut.WriteLine ("### Ende   - Liste der installierten Porogramme" & vbCRLF)   
     Set  RootKey = nothing
     Set XRootKey = nothing

    TextX = "REGSVR32.EXE  " & "REGOBJ.DLL" & " /U /S"                ' Regobj.dll-Registrierung aufheben
    Set ObjRemote = nothing
    WshShell.Run (TextX),,TRUE

    Set FileOut   = nothing

End Sub ' Win8xSWListe


' -------------------------------------
Sub ZielLWTest     ' ermittelt Zielpfad
' -------------------------------------
' Lw.Type bestimmen
' -------------------------------------
  TextX = fso.GetDrive(fso.GetDriveName(WScript.ScriptFullName)).DriveType
    ' i.DriveType = 1 = "Disk-Lw." 
    ' i.DriveType = 2 = "Festpl." 
    ' i.DriveType = 3 = "Netz-Lw." 
    ' i.DriveType = 4 = "CD-Lw.  " 

  If ZielPfad = "" then  
    ZielPfad = fso.GetDrive(fso.GetDriveName(WScript.ScriptFullName)).DriveLetter

' ist akt. Ziel-Lw. CD-Lw.?
' -------------------------------------
' ######   Folgezeile nicht freigeben
'   If TextX = 2 OR TextX = 3 Then ' !!!   ZUM TESTEN   !!!
' ######   Folgezeile freigeben
    If TextX = 1 OR TextX = 4 Then 
      ZielPfad =            "Das Skript wurde von CD gestartet." & vbCRLF & vbCRLF 
      ZielPfad = ZielPfad & "Auf welches Laufwerk sollen die gesammelten Informationen gespeichert werden?" & vbCRLF & vbCRLF 
      ZielPfad = ZielPfad & "(Bei Diskette den Schreibschutz entfernen!)" 
      ZielPfad = InputBox (ZielPfad, WScript.ScriptName, "A:")

      If ZielPfad = "" then  MsgBox " . . . denn eben nicht!", , WScript.ScriptName
      If ZielPfad = "" then  WScript.Quit
    End If
  Else 
    ZielPfad = fso.GetDrive(fso.GetDriveName( Zielpfad & ":")).DriveLetter
  End If

  TextX = fso.GetDrive(fso.GetDriveName( ZielPfad & ":" )).DriveType 

' ist akt. Ziel-Lw. immer noch CD-Lw.?
' -------------------------------------
  If 4 = TextX Then 
    TextX =         "Ein CD-Laufwerk kann nicht zum Speichern verwendet werden." & vbCRLF & vbCRLF 
    TextX = TextX & "Skript wird abgebrochen!"
    MsgBox TextX, 16, WScript.ScriptName
    WScript.Quit
  End If

  ZielPfad = fso.GetDrive(fso.GetDriveName( ZielPfad & ":" )).DriveLetter & ":"
' (ZielPfad=) Ziel-Lw. steht fest
' -------------------------------------

' ZielPfad auf Ziel-Lw. & \#INVENTAR setzen
' -------------------------------------
  ZielPfad = ZielPfad & "\#Inventar"

' ######   Folgezeile freigeben
' wenn Skript "nicht von Diskette" und "nicht von CD" gestartet wurde:
'  If not TextX = 1 AND not TextX = 4 Then Exit Sub 

' Test-Verz. im ZielPfad anlegen
' -------------------------------------
On Error Resume Next
'  If TextX = 1 OR TextX = 4 Then 
    If not fso.FolderExists( ZielPfad ) Then fso.CreateFolder ZielPfad
'  End If
  If fso.GetDrive(fso.GetDriveName( ZielPfad )).IsReady Then 
' testweise ein Verzeichnis anlegen
    TextX = ZielPfad & "\#" & UCase(wshnet.ComputerName) & ".tst"                ' TestVerzeichnisName
    If     fso.FolderExists(TextX) Then fso.DeleteFolder TextX                  ' TestVerzeichnis löschen, fals vorhanden
    If     fso.FolderExists(TextX) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, "  Nach 3sek bin ich weg!", vbExclamation
    fso.CreateFolder TextX                                                      ' TestVerzeichnis anlegen
    If not fso.FolderExists(TextX) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, "  Nach 3sek bin ich weg!", vbExclamation
    If not fso.FolderExists(TextX) Then                                         ' TestVerzeichnis nicht existiert?
      TextX =         "Auf   " & ZielPfad & "  konnte nicht geschrieben werden." & vbCRLF & vbCRLF 
      TextX = TextX & "Skript wird abgebrochen!"
      MsgBox TextX, 16, WScript.ScriptName
      WScript.Quit
    End If
' ######   Folgezeile freigeben
On Error GoTo 0
    If     fso.FolderExists(TextX) Then fso.DeleteFolder TextX                  ' TestVerzeichnis löschen, fals vorhanden
    If     fso.FolderExists(TextX) Then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, "  Nach 3sek bin ich weg!", vbExclamation
  End If

End Sub ' ZielLWTest