'v2.6*************************************************** ' File: SWinventar.VBS ' Autor: dieseyer@gmx.de ' dieseyer.de ' ' Das Script ermittelt die zu prüfenden PC's aus den ' vorhandenen #PCName - Verzeichnissen ' 1. Gibt es bereits eine #PCName-SW.txt wird dieser PC ' Übersprungen. ' 2. Ist der PC per Ping nicht erreichbar, wird er nicht ' geprüft. ' 3. Ist der PC per Ping erreichbar, wird in der Datei ' #PCName-SW.txt die Win-Version und die installierte ' SoftWare mit Uninstall-Routine abgelegt. '******************************************************* Option Explicit Dim TmpTxt, Text1, Text2, Text3, TextX, KeyX, oVal, XoVal, i, i1, i2 Dim PCText, Ziel, ZielPfad, FileIn, FileOut, Verz, Dateien, Folder Dim WSHShell, FSO, WSHnet, WshSysEnv, ObjReg, ObjRemote, RootKey, XRootKey, oArgs Set WSHShell = WScript.CreateObject("WScript.Shell") Set WshSysEnv = WshShell.Environment("SYSTEM") Set FSO = CreateObject("Scripting.FileSystemObject") Set WSHNet = WScript.CreateObject("WScript.Network") set oArgs = Wscript.Arguments if not WshSysEnv("OS") = "Windows_NT" then MsgBox """SWinventar.vbs"" muss auf einem WinNT/2k-PC mit Administrator-Rechten ausgeführt werden! " & vbCRLF & vbCRLF & "Info's gibt's bei ""dieseyer.de""", , WScript.ScriptName WScript.Quit End If 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") Else wshshell.Popup "REGSVR32.EXE " & "REGOBJ.DLL" & " /S" & vbTab & " konnte nicht aufgerufen werden!", 15, WScript.ScriptName & " - Ende", vbExclamation WScript.Quit End If TmpTxt = "" 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 Set Folder = fso.GetFolder( ZielPfad ).SubFolders ' Liste aller UnterVerzeichnisse im akt. Verz. For Each Verz In Folder ' alle UnterVerzeichnisse if Mid(Verz, len( ZielPfad ) +2, 1) = "#" then ' beginnt UnterVerz.Name mit '#' ? PCText = UCase(Mid(Verz, len( ZielPfad ) +3)) ' PC-Name extrahieren If (fso.FileExists( ZielPfad & "\#" & PCText & "\#" & PCText & ".txt" )) Then wshshell.Popup "Ist " & PCText & " verfügbar?" , 1, WScript.ScriptName, vbExclamation ' ###################################### PCTest ' ###################################### End If End If Next If TmpTxt = "" Then ' PCText = InputBox ("Von welchem PC soll eine SoftWare-Liste erstellt werden?", WScript.ScriptName, wshnet.ComputerName) If PCText = "" then MsgBox " . . . denn eben nicht!", , WScript.ScriptName If PCText = "" Then WScript.Quit PCText = UCase(PCText) PCTest WshShell.Run ("NotePad " & Ziel),,True End If WshShell.Run ("REGSVR32.EXE " & "REGOBJ.DLL" & " /U /S"),,TRUE ' REGOBJ.DLL - Registrierung entfernen Set FileOut = fso.OpenTextFile(ZielPfad & "\inventar.log", 8, true) ' Datei zum Erweitern öffnen (notfals anlegen) fileOut.WriteLine (now & " - " & WScript.ScriptName & " beendet" & vbCRLF & TmpTxt) Set FileOut = Nothing ' Datei schließen wshshell.Popup ZielPfad & vbCRLF & TmpTxt, 15, WScript.ScriptName, vbExclamation WScript.Quit Sub SWListe ' ------------------------------------- ' 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 = objRemote.RegKeyFromString(KeyX) For Each oVal In RootKey.SubKeys ' Auflistung Schlüssel Set XRootKey = objRemote.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) fileOut.WriteLine (now) Set FileOut = Nothing ' Datei schließen Set RootKey = nothing Set XRootKey = nothing End Sub ' SWListe Sub OSType ' ------------------------------------- ' Betriebssystem ermitteln ' ------------------------------------- KeyX = "\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion" Text1 = "" Text2 = "" On Error Resume Next Set RootKey = objRemote.RegKeyFromString(KeyX) For Each oVal In RootKey.Values ' Auflistung Werte if oVal.Name = "ProductName" then Text1 = oVal.Value if oVal.Name = "CurrentVersion" then Text1 = "Windows NT " & oVal.Value if oVal.Name = "CSDVersion" then Text2 = oVal.Value ' MsgBox oVal.Name & vbCRLF & oVal.Value Next On Error GoTo 0 fileOut.WriteLine (" " & Text1 & " " & Text2 & " " & vbCRLF) End Sub ' OSType Sub PCTest ' ------------------------------------- ' PC auf installierte Software testen ' ------------------------------------- if not fso.FolderExists( ZielPfad & "\#" & PCText) then fso.CreateFolder( ZielPfad & "\#" & PCText) Ziel = ZielPfad & "\#" & PCText & "\#" & PCText & "-SW.txt" TmpTxt = TmpTxt & "\\" & UCase(PCText) & " " if fso.FileExists(Ziel) Then ' erneute Überprüfung überspringen TmpTxt = TmpTxt & "war geprüft" & vbCRLF Exit Sub End If TextX = WshSysEnv("COMSPEC") ' TextX ist bei Win98Se leer (Keine Ahnung warum!) ' MsgBox WshSysEnv("COMSPEC") & " /c Ping " & PCText & " -n 2 -w 500 > """ & Ziel & """" If TextX = "" then WshShell.run ( "command.com /c Ping " & PCText & " -n 2 -w 500 > """ & Ziel & """"),0 ,true If not TextX = "" then WshShell.run (WshSysEnv("COMSPEC") & " /c Ping " & PCText & " -n 2 -w 500 > """ & Ziel & """"),0 ,true ' PING nur zweimal ausführen => nur eine Zeile mit TTL= If not fso.FileExists( Ziel ) then wshshell.Popup "Bitte nicht OK drücken!!!" , 3, " Nach 3sek bin ich weg!", vbExclamation ' damit Zieldatei RICHTIG geschreben ist Set FileIn = fso.OpenTextFile(Ziel, 1, true) ' Datei zum Lesen öffnen TextX = FileIn.ReadAll ' alles lesen Set FileIn = nothing if fso.FileExists(Ziel) Then fso.DeleteFile(Ziel), True ' Datei löschen TextX = Split(TextX,vbCrLf,1) ' alles gelesene in Zeilen aufteilen for i1 = 0 to ubound(TextX) ' jede Zeile überprüfen If InStr(TextX(i1), "TTL=") > 1 Then ' ob TTL= enthalten ist, wenn ja (PING war erfolgreich) Set FileOut = fso.OpenTextFile(Ziel, 2, true) ' Datei zum Schreiben öffnen (notfals anlegen) fileOut.WriteLine ("Getest wird """ & PCText & """ - Datei: " & Ziel & vbCRLF ) PCText = "\\" & PCText ' PC, der abgefragt werden soll Set ObjRemote = objReg.RemoteRegistry(PCText) ' Objekt auf Remote-PC zeigen (REGOBJ.DLL) ' ############################### OSType SWListe ' ############################### Set ObjRemote = nothing Set FileOut = nothing TmpTxt = TmpTxt & "jetzt geprüft" & vbCRLF Exit For End If next If not fso.FileExists(Ziel) Then TmpTxt = TmpTxt & "nicht verfügbar" & vbCRLF End If End Sub ' PCTest ' ------------------------------------- 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 ' MsgBox ZielPfad, , "ZielPfad 1" End Sub ' ZielLWTest