Option Explicit '------------------------------------------------------------------------- ' DumpServiceaccounts.vbs ' ' Beschreibung ' ' Das Script sucht alle Server in der Domäne ab und sammelt Dienste samt Anmeldekonto ' Version 1.0 (basierend auf NAWINVENTORY) '------------------------------------------------------------------------- ' Pfad und Dateiname der Log-Datei Dim computerliste ' Array für die Computer Dim count, total dim strOutFilePrefix Dim objWMIService Dim objItem, colItems Dim ExecQuery ' Pfad und Dateiname der Log-Datei dim objDebug strOutFilePrefix = makefilename("DumpServiceaccounts-" & Date() & "-" & Time()) ' common name of the output files without extension set objdebug = new DebugWriter objDebug.target = "file:7 console:7" ' errorlogging 0=only output, 1=Error 2=Warning 3=information 5++ =debug objDebug.outFile = strOutFilePrefix &".log" objDebug.start call ForceCScript ' must be rund with CSCRIPT call abbruch ("Script fortsetzen ?" ,5) ' Last question to stop objDebug.writeln "DumpServiceaccounts: gestartet", 0 ' ------------------ Einlesen der Computerliste aus einer Datei oder dem Active Directory if wscript.Arguments.named("AD") <> "" then objDebug.writeln "Loading Computer Objects from AD:" & wscript.Arguments.named("AD"), 0 computerliste = getcomputersfromAD(wscript.Arguments.named("AD")) ' FSMORollen = " " ElseIf wscript.Arguments.named("FILE") <> "" then objDebug.writeln "Loading Computer Objects from FILE:" & wscript.Arguments.named("FILE") , 0 computerliste = getcomputersfromFile(wscript.Arguments.named("FILE")) ElseIf wscript.Arguments.named("PC")<> "" then objDebug.writeln "Single Computer Mode:" & wscript.Arguments.named("PC"), 0 Redim computerliste (0) computerliste(0) = wscript.Arguments.named("PC") Else objDebug.writeln "DumpServiceaccounts: Bitte Parameter angeben", 0 objDebug.writeln "DumpServiceaccounts: Beispiel", 0 objDebug.writeln "DumpServiceaccounts: ", 0 objDebug.writeln "DumpServiceaccounts: Alle Systeme einer Domain holen. DC selbst ermitteln", 0 objDebug.writeln "DumpServiceaccounts: CSCRIPT DumpServiceaccounts /AD:""dc=netatwork,dc=de""", 0 objDebug.writeln "DumpServiceaccounts: ", 0 objDebug.writeln "DumpServiceaccounts: Alle Systeme einer Domain holen. DC explizit angegeben", 0 objDebug.writeln "DumpServiceaccounts: CSCRIPT DumpServiceaccounts /AD:""server/dc=netatwork,dc=de""", 0 objDebug.writeln "DumpServiceaccounts: ", 0 objDebug.writeln "DumpServiceaccounts: Nur angegebenen Computer inventarisieren", 0 objDebug.writeln "DumpServiceaccounts: CSCRIPT DumpServiceaccounts /PC:computername", 0 objDebug.writeln "DumpServiceaccounts: ", 0 objDebug.writeln "DumpServiceaccounts: Computer in der Datei inventarisieren (lokaler voller Pfad erforderlich", 0 objDebug.writeln "DumpServiceaccounts: CSCRIPT DumpServiceaccounts /FILE:dateiname", 0 wscript.quit(1) End if dim csvfile set csvfile = new clsCSVWriter csvfile.OpenFile strOutFilePrefix & ".csv",csvfile.Overwrite ' Overwrite csvfile.Delimiter = ";" '~ csvfile.Quote = "'" csvfile.WriteRawLine("# Created with MSXFAQ.CSVWriter") csvfile.AddHeader "Server" : csvfile.AddHeader "Service" : csvfile.AddHeader "Account" csvfile.WriteHeader("# Field: ") total = 0 For count = 0 To uBound(computerliste) ' Verarbeite jeden Computer. total = total + 1 objDebug.writeln "Processing:" & total & "/" & uBound(computerliste)+1 &":" & computerliste(count) ,3 Call processcomputer(computerliste(count)) Next objDebug.writeln "Total objects checked:" & total, 0 objDebug.writeln "DumpServiceaccounts: beendet", 0 WScript.quit(0) Function processcomputer(target) Const wbemFlagReturnImmediately = &h10 Const wbemFlagForwardOnly = &h20 dim strIPAddress, objEvent, colLoggedEvents, strIPAddresses, arrIPAddresses If wmiping(target) = False Then csvfile.StartLine csvfile.AddField "Server",target csvfile.AddField "Service","NOPING" csvfile.AddField "Account","NOPING" csvfile.Writeline 'Zeile rausschreiben objDebug.writeln "DumpServiceaccounts: NoPing", 0 Else on error resume next Set objWMIService = GetObject("winmgmts://" & target& "\root\CIMV2") if err.number <> 0 then err.clear on error goto 0 objDebug.writeln "DumpServiceaccounts: WMIFailure", 0 csvfile.StartLine csvfile.AddField "Server",target csvfile.AddField "Service","WMIFailure" csvfile.AddField "Account","WMIFailure" csvfile.Writeline 'Zeile rausschreiben else on error goto 0 objDebug.writeln "DumpServiceaccounts: Collecting WMI Win32_Service", 5 Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Service") For Each objItem In colItems csvfile.StartLine csvfile.AddField "Server",target csvfile.AddField "Service",objItem.name csvfile.AddField "Account",objItem.StartName csvfile.Writeline 'Zeile rausschreiben Next on error goto 0 End If End If End Function Function getcomputersfromAD (ADDomain) ' Liest die Computer aus dem Active Directory Const ADS_SCOPE_SUBTREE = 2 Dim objCommand ' Dim objConnection ' Dim objRecordSet ' Dim arr_computers() Dim count objDebug.writeln "DumpServiceaccounts: Searching AD Container "& ADDomain, 5 Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.CommandText = "Select Name from 'LDAP://"& ADDomain &"' where objectClass='computer'" objCommand.Properties("Page Size") = 1000 objCommand.Properties("Timeout") = 30 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.Properties("Cache Results") = False objDebug.writeln "DumpServiceaccounts: Start ADO Query", 5 Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst count = 0 Do until objRecordSet.EOF Redim Preserve arr_computers (count) arr_computers(count) = LCase(objRecordSet.Fields("Name").Value) objDebug.writeln "DumpServiceaccounts: Add Computer "& arr_computers(count) &" to list", 5 count = count +1 objRecordSet.MoveNext Loop getcomputersfromAD = arr_computers End Function Function getcomputersfromfile (strFilename) ' Computer aus einer Dateiliste einlesen Dim arr_computers() Dim count, objFSO, objTextStream, strline const FOR_READING = 1 Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strFilename) Then Set objTextStream = objFSO.OpenTextFile(strFilename, FOR_READING) objDebug.writeln "Reading " & strFilename & ".", 5 Else objDebug.writeln "Datei " & strFilename & " nicht vorhanden.", 1 WScript.Quit (1) End If count = 0 Do until objTextStream.AtEndOfStream Redim Preserve arr_computers(count) strline = objTextStream.ReadLine if strline <> "" then ' skip empty lines arr_computers(count) = strline objDebug.writeln "DumpServiceaccounts: Add Computer "& arr_computers(count) &" to list", 5 count = count + 1 end if Loop objTextStream.Close getcomputersfromfile = arr_computers End Function Function wmiping(strComputer) Dim PingResults, Pingresult Set PingResults = GetObject("winmgmts://localhost/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = '" + strComputer + "'") For Each PingResult In PingResults If PingResult.StatusCode = 0 Then wmiping = True Else wmiping = False End If Next End Function Function WMIDateStringToDate(dtmDate) WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _ Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _ & " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2)) End Function Sub AppendLog(strLog, errlevel) 'Fügt einen Eintrag in die Log-Datei ein Dim file Dim fs If LogLevel>=errlevel Then Set fs = CreateObject("Scripting.FileSystemObject") Set file = fs.OpenTextFile(LogFile, 8, True) file.Write(Now & ",") Select Case errlevel Case 1 file.Write("Fatal Line" & Err.Source) Case 2 file.Write("Error") Case 3 file.Write("Warning") Case 4 file.Write("Information") Case 5 file.Write("Debug") Case Else file.Write("Code:"&errlevel) End Select file.WriteLine(","&strLog) file.Close End If End Sub ' ================================================== Auxilary procedures and classes ========================== class debugwriter ' Generic Class für writing debugging information and handling runtime errors ' By default al Level 1 Messaegs are logged to the Console ' Version 29. Mar 2006 private objIE, file, fs, debugfilename, status, strline private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole private Sub Class_Initialize status = "active" : strline = "" : debugfilename = "" debuglevelIE = 0 debuglevelfile = 0 debugleveleventlog = 0 debuglevelConsole = 1 End Sub private Sub Class_Terminate() if isobject(OBJIE) then objie.document.write "" end if if debugfilename <> "" then file.Close end if End Sub public sub start status = "active" end sub public sub pause status = "pause" end sub public property let outfile(wert) if debugfilename <> "" then 'Close existing debug file file.close : file = nothing : fs = nothing end if debugfilename = wert ' open debug file Set fs = CreateObject("Scripting.FileSystemObject") Set file = fs.OpenTextFile(makefilename(debugfilename), 8, True) end property public property let setie (wert) : set objIE = wert : objie.visible = true end property public property let target (wert) dim arrTemp, intcount arrTemp = split(wert," ") ' spit by space for intcount = 0 to ubound(arrTemp) select case lcase(split(arrtemp(intcount),":")(0)) case "ie" debuglevelIE = cint(right(arrtemp(intcount),1)) case "file" debuglevelfile = cint(right(arrtemp(intcount),1)) case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1)) case "console" debuglevelConsole = cint(right(arrtemp(intcount),1)) end select next end property sub write(strMessage) strline = strline & strMessage end sub Sub writeln(strMessage, intseverity) 'Fügt einen Eintrag in die Log-Datei ein dim blnerror strMessage = strline & strMessage ' add existing Output Messages strline = "" if err <> 0 then ' Sonderbehandlung als "ErrorHandler" blnerror = true strmessage= "RUNTIME ERROR :" & strMessage & vbcrlf & _ "ERR.Number :" & err.number & vbcrlf & _ "ERR.Description:" & err.Description & vbcrlf & _ "ERR.Source :" & err.source & vbcrlf & _ "ERR.HelpFile :" & err.HelpFile & vbcrlf & _ "ERR.HelpContext:" & err.HelpContext & vbcrlf err.clear else blnerror = false end if if ((status = "active") or blnerror) then if (debuglevelfile > 0) and ((debuglevelfile >= intseverity) or blnerror) and (debugfilename <> "") then file.Write(Now & ",") Select Case intseverity Case 0 file.Write("Out0") Case 1 file.Write("Err1") Case 2 file.Write("Wrn2") Case 3 file.Write("Inf3") Case Else file.Write("Dbg"&intseverity) End Select file.WriteLine("," & Convert2Text(strMessage)) strline = "" end if if (debugleveleventlog > 0) and ((debugleveleventlog >=intSeverity) or blnerror) then dim objWSHShell Set objWSHShell = Wscript.CreateObject("Wscript.Shell") Select Case intseverity Case 0 objWSHShell.LogEvent 0, strMessage ' Const EVENT_SUCCESS = 0 Case 1 objWSHShell.LogEvent 1, strMessage ' const EVENT_ERROR = 1 Case 2 objWSHShell.LogEvent 2, strMessage ' Const EVENT_WARNING = 2 Case else objWSHShell.LogEvent 4, strMessage ' Const EVENT_INFO = 4 End Select end if if (debuglevelconsole > 0) and ((debuglevelconsole >=intSeverity) or blnerror) then Select Case intseverity Case 0 wscript.echo now() & ",OUT0:" & strMessage Case 1 wscript.echo now() & ",ERR1:" & strMessage Case 2 wscript.echo now() & ",WRN2:" & strMessage Case 3 wscript.echo now() & ",INF3:" & strMessage Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage End Select end if if (debuglevelie > 0) and ((debuglevelie >= intSeverity) or blnerror) then dim strieline if not isobject(objIE) then Set objIE = CreateObject("InternetExplorer.Application") objIE.navigate("about:blank") objIE.visible = true Do While objIE.Busy WScript.Sleep 50 Loop objIE.document.write "DebugWriter Output" objIE.document.write "
" end if strieline = "" Select Case intseverity Case 0 strieline = strieLine & "" Case 1 strieline = strieLine & "" Case 2 strieline = strieLine & "" Case 3 strieline = strieLine & "" Case Else strieline = strieLine & "" End Select strieline = strieline & "" objIE.document.write cstr(strieline) end if '~ if (instr(DebugTarget,"mom") <>0) or blnerror then '~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage '~ end if end if ' if status = active strline = "" End Sub private function makefilename(wert) ' Converts all invalid characters to valid file names wert = replace(wert,"\","-") wert = replace(wert,"/","-") wert = replace(wert,":","-") wert = replace(wert,"*","-") wert = replace(wert,"?","-") wert = replace(wert,"<","-") wert = replace(wert,"|","-") wert = replace(wert,"""","-") makefilename = wert end function private function Convert2Text(wert) ' Converts non printable characters to "X" , so that Textfile is working dim loopcount, tempwert, inttest tempwert="" for loopcount = 1 to len(wert) ' replace all unprintable characters maybe easier and faster with RegEx tempwert = tempwert & chr(ascb(mid(wert,loopcount,1))) next Convert2Text = tempwert end function end class sub ForceCScript If InStr(1,WScript.FullName,"cscript",vbTextCompare) = 0 Then ' Prüfung ob mit CSCRIPT gestartet wurde wscript.echo "Bitte mit CSCRIPT aufrufen" wscript.quit (255) end if end sub Sub abbruch(info,waittime) ' usage: call abbruch ("Script abbrechen" ,5) dim WshShell, result Set WshShell = CreateObject("WScript.Shell") result = WshShell.Popup("Continue script at position "& vbcrlf & info & vbcrlf & "Waiting "&waittime&" Seconds", waittime, "Stop Script", 33) 'OKCancel(1) + Question (32) If result = 2 Then WScript.echo "Abbruch durch Anwender (Exitcode = 255)" WScript.Quit(255) End If End Sub function Convert2Text(wert) ' Converts non printable characters to "X" , so that Textfile is working dim loopcount, tempwert, inttest tempwert="" for loopcount = 1 to len(wert) ' replace all unprintable characters maybe easier and faster with RegEx '~ inttest = ascw(mid(wert,loopcount,1)) '~ if ((inttest>=32) and (inttest<127)) or (inttest=10) or (inttest=13) or (inttest=9) then '~ tempwert = tempwert & chr(inttest) ' printable Character or CR LF TAB '~ else '~ tempwert = tempwert & "X" '~ end if tempwert = tempwert & chr(ascb(mid(wert,loopcount,1))) next Convert2Text = tempwert end function class clsCSVWriter ' Class to write generic CSVFiles ' Version 1.0 Initial Version ' Version 1.1 WriteHeader + Prefix, WriteRawLine ' Version 1.2 Add "Exists"-Methode und Fehler in "Append"-Methode ' Last Modified: 30. Jan 2008 ' Pending: Quotataion of '"'-Character in Data !! private csvfilename, csvfs, csvfile, chrDelimiter, chrQuote, strline private dictLine private Sub Class_Initialize chrDelimiter =";" : chrQuote = """" : csvfilename = "" set dictLine = createobject("scripting.dictionary") End Sub public property let Delimiter (wert) ' Konfigure the delimiter. Default is ";" chrDelimiter =wert end property public property let Quote(wert) ' Konfigure the sting enquoting. Default is " chrQuote = wert end property public property get Overwrite ' Contant für Filemode Overwrite = 2 end property public property get Append ' Contant für Filemode Append = 8 end property public property get Exist(strFile) Set csvfs = CreateObject("Scripting.FileSystemObject") if csvfs.FileExists(strFile) then Exist = true else Exist = False end if end property sub OpenFile(wert,intFileMode) ' Open and start a new CSV-File if csvfilename <> "" then 'Close existing debug file csvfile.close : csvfile = nothing : csvfs = nothing end if csvfilename = wert ' open debug file Set csvfs = CreateObject("Scripting.FileSystemObject") Set csvfile = csvfs.OpenTextFile(csvfilename, intFileMode, True) end sub sub AddHeader(strvalue) ' Add a new column to the csv dataset if dictLine.exists(strvalue) then objDebug.writeln "CSVWriter: duplicate Header definition:" & strValue, 1 else dictLine.add strvalue, empty end if end sub Sub WriteHeader(strPrefix) ' Write the current Header Definition to the file. optional with a prefix ' Prefix can be used to fake IISLogs with "# Field: " dim key, strline strline = "" for each key in dictLine.keys if strline <> "" then strline = strline & chrDelimiter end if strline = strline & chrQuote & cstr(key) & chrQuote next csvfile.WriteLine(strPrefix & strline) End Sub sub AddField(strfieldname,strvalue) ' add a valuue together with the field name if dictLine.exists(strfieldname) then dictLine.item(strfieldname) = strvalue else objDebug.writeln "CSVWriter: Field not declared:" & strFieldname, 1 end if end sub Sub WriteLine ' Write the current filled fields to the disk and starte a new line dim key, strline strline = "" for each key in dictLine.keys if strline <> "" then strline = strline & chrDelimiter end if strline = strline & chrQuote & dictLine(key) & chrQuote dictLine.item(key) = empty next csvfile.WriteLine(strline) End Sub Sub WriteRawLine(strLine) ' Write line without any formatting etc. Ideal für comments and other custom output csvfile.WriteLine(strline) End Sub sub StartLine ' Start a new line. Remove all existing data of the current line dim key, strline strline = "" for each key in dictLine.keys dictLine.item(key) = empty next End Sub end class function makefilename(wert) ' Converts all invalid characters to valid file names wert = replace(wert,"\","-") wert = replace(wert,"/","-") wert = replace(wert,":","-") wert = replace(wert,"*","-") wert = replace(wert,"?","-") wert = replace(wert,"<","-") wert = replace(wert,"|","-") wert = replace(wert,"""","-") makefilename = wert end function
TimeintseverityDescription
" & now () & "Out0Err1Wrn2Inf3Dbg"&intseverity&"" & strmessage & "