Option Explicit
'-------------------------------------------------------------------------
' checkgrp.vbs
'
' Beschreibung

' Aufgabe dieses Script ist es, alle Domain/Universal Gruppen des ADs zu lesen 
' und die Mitglieder zu prüfen
'
' Group:Member ist User -> User enthält Gruppe in "memberof"  = OK
' Group:Member ist User -> User enthält Gruppe nicht in "memberof"  = Error
' Group:Member ist Group -> Group enthält Gruppe in "memberof"  = OK
' Group:Member ist Group -> Group enthält Gruppe NICHT in "memberof"  = Error
' Object:MemberOf > 120 Objekte = WARN120    Siehe KB327825 Kerberos
' Object:MemberOf > 1015 Objekte = WARN1015  Siehe KB328889 LSA SIDs
' Object:MemberOf > 5000 Objekte = WARN5000  Siehe KB275523 W2K Replikation
'
' umgekehrt muss es nicht stimmen !! d.h. Memberof enthält z.B: keine lokalen Gruppen
' Aber in "memberOf" darf nichts drinstehen, was nicht auch als "member" drin steht.
'
' Sonderfall primäryGroupID: Jeder User hat eine primäry Group. Dabei gilt:
' - User tauchen nicht in der "member" Liste von der Gruppe auf, die ihre primäry
' - die primäryGroup ist ebenfalls NICHT in der "memberof" des Users geführt.
'  d.h. im Script ist dies nicht zu berücksichtigen
' ACHTUNG: Die Ausgabe in der XML-Datei enthält daher keine primäryGroups und ist dahingehend unvollständig
' Dies betrifft überwiegend die Gruppe "DomainUser" und "DomainController"
' http://www.rlmueller.net/Get%20Primary%20Group.htm
'
' Programmlogik
' - Lade "memberfeld" aller Gruppen des Forrest in ein Dictionary
'	dict.add GruppenDN + memberDN = 1
'	Zähle Anzahl und gebe eventuell Warnungen aus
' durchlaufe alle User und gruppen
'	binde Object
'	Streiche "memberof"-GruppenDN + ObjectDN aus Dictionary
' Melde verbliebenen Dictionary Objekte
'
' Achtung  BIND auf "Ziel" macht viel WAN-Last
' Das Feld "MemberOf" und "Member" ist wahlweise ein Array, ein String oder NULL. Das muss abgefangen werden
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
'
' (c)2006 Net at Work Netzwerksysteme GmbH
'
' Version 1.0 (15. Feb 2006) Frank Carius
'	Initial Release
' Version 1.1 (16. Feb 2006) Frank Carius
'	1500 User Problem
' TODO
'	USN Schnappschuss ? als verbesserunge aber keine Lösung 
'
' Infos zu Laufzeitdaten:
'  37000 Gruppen benötigen etwa 
'	62 MB für den LDAP Query private Bytes
'	500 MB für das Dictionary
'
' Gruppen mit mehr als 1000 (W2K) bzw 1500 (Win2003) Usern werden per VBScript nicht komplett im "member" zurück gegeben
' http://www.rlmueller.net/DocumentLargeGroup.htm
'
'-------------------------------------------------------------------------

Dim total, totalmemberof, totalmatchfound, totalmatcherror, result, strGCPath
Dim oConnection, oCommand, oRecordset, oUser, oGroup, oMember, oMemberOf, oObject
Dim strResult, strTemp, strQuery, strOutFilePrefix, intrangestart
dim dictMember, arrkeys
dim objDebug, xmlwriter, count

strOutFilePrefix = makefilename("checkgrp-" & Date() & "-" & Time())  ' common name of the output files without extension
set objdebug = new DebugWriter 
objDebug.target = "file:6 console:4" ' 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
objDebug.writeln "checkgrp: gestartet", 0

set xmlWriter = new XmlTextWriter
xmlWriter.filename = strOutFilePrefix & ".xml"
xmlWriter.Indentation = 4
call xmlWriter.WriteStylesheet("checkgrp.xsl")
call writexslt("checkgrp.xsl")
call xmlWriter.WriteStartElement("checkgrp")
call xmlWriter.WriteElementString("starttime", now())

objDebug.write "Looking für GC"
dim oCont, oGC
Set oCont = GetObject("GC:")
For Each oGC In oCont
    strGCPath = oGC.ADsPath
Next
objDebug.writeln "strGCPath=" & strGCPath, 3

'
'  Walk though all groups and collect all Memberships into and dictionary
'

objDebug.writeln "Querying AD für Objects at " & strGCPath,4
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
oCommand.ActiveConnection = oConnection
oCommand.Properties("Page Size") = 100
oCommand.CommandText = "<" & strGCPath & ">;(&(objectClass=group));distinguishedName,name;subtree"
Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0

call xmlWriter.WriteElementString("starttime2", now())
total = 0
set dictMember = CreateObject("Scripting.dictionary")
dictMember.comparemode = 0 ' binary compare

do until oRecordset.EOF
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." ,4
	total = total + 1
	
	call xmlWriter.WriteStartElement("group")
	call xmlWriter.WriteElementString("name", oRecordset.Fields("name"))
	call xmlWriter.WriteElementString("dn", oRecordset.Fields("distinguishedname"))

	on error resume next
	set oGroup = GetObject ("LDAP://" & replace(oRecordset.Fields("distinguishedName"),"/","\/"))
	if err.number = 0 then  ' Object bound successfully
		on error goto 0
		call xmlWriter.WriteStartElement("members")
		intrangestart = 0
		do
			objDebug.writeln "PageSearch Start:" & intrangestart,6
			on error resume next
			oGroup.GetInfoEx ARRAY("member;range=" & intrangestart & "-*"),0  ' do a paged search
			if err.number = 0 then
				on error goto 0
				objDebug.writeln "PageSearch OK " & VarType(oGroup.Member),6
				Select Case VarType(oGroup.Member)
				Case vbarray, vbarray + vbVariant, vbarray + vbstring
					For Each oMember in oGroup.member
						objDebug.writeln "Adding:" & intrangestart & ":" & oMember & " to " & oGroup.distinguishedname, 5
						call xmlWriter.WriteElementString("member", oMember)
						dictMember.add oGroup.distinguishedname & vbtab & omember , "1"	'Loading dictionary. Using TAB as space
						intrangestart = intrangestart + 1
					Next
				Case vbString
					strResult = "1"
					objDebug.writeln "Adding:" & oGroup.Member & " to " & oGroup.distinguishedname, 5
					dictMember.add oGroup.distinguishedname & vbtab & oGroup.Member, "1"	'Loading dictionary. Using TAB as space
					call xmlWriter.WriteElementString("member", oGroup.Member)
					exit do
				Case vbempty, vbnull
					strResult = "0"
					exit do
				Case Else
					strResult = "Err:unbekannt Vartype:" & VarType(oGroup.Member)
					exit do
				End Select
			else
				err.clear
				on error goto 0				
				exit do
			end if
		loop
		call xmlWriter.WriteEndElement()   ' of ("member")
	else
		err.clear
		on error goto 0
		objDebug.writeln "Object nicht gefunden", 3
		strResult = "Err:Object NotFound"
	end if
	call xmlWriter.WriteElementString("result", strResult)
	call xmlWriter.WriteEndElement()   ' of ("group")
	oRecordset.MoveNext
loop
objDebug.writeln "Dictionary loaded:" & total, 0
call xmlWriter.WriteElementString("totalgroup", total)

'
'  Walt through all possible members and read their "memberOf" Attribute
'

call xmlWriter.WriteElementString("starttime3", now())
objDebug.writeln "Querying AD für Objects at " & strGCPath,4
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
oCommand.ActiveConnection = oConnection
oCommand.Properties("Page Size") = 100
oCommand.CommandText = "<" & strGCPath & ">;(|(objectClass=group)(objectClass=User)(objectClass=foreignSecurityPrincipal));distinguishedName,name;subtree"
Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0

call xmlWriter.WriteElementString("starttime4", now())
total = 0 : totalmatcherror = 0 : totalmatchfound = 0

do until oRecordset.EOF
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." ,4
	total = total + 1
	totalmemberof = 0
	call xmlWriter.WriteStartElement("object")
	call xmlWriter.WriteElementString("name", oRecordset.Fields("name"))
	call xmlWriter.WriteElementString("dn", oRecordset.Fields("distinguishedName"))
	on error resume next
	set oObject = GetObject ("LDAP://" & replace(oRecordset.Fields("distinguishedName"),"/","\/"))
	if err.number = 0 then
		on error goto 0
		intrangestart = 0
		do
			on error resume next
			objDebug.writeln "PageSearch Start:" & intrangestart,6
			oObject.GetInfoEx ARRAY("memberof;range=" & intrangestart & "-*"),0  ' do a paged search
			if err.number = 0 then
				on error goto 0
				objDebug.writeln "Vartype MEMBEROF:" & vartype(oObject.MemberOf),6
				if IsArray(oObject.MemberOf)  then
					For Each oMemberOf in oObject.memberof
						objDebug.writeln "Loop:" & intrangestart,6
						if dictMember.Exists(oMemberOf & vbtab & oObject.distinguishedname) then
							objDebug.writeln "Match:" & oMemberOf & " in " & oObject.distinguishedname,5
							dictMember.remove oMemberOf & vbtab & oObject.distinguishedname 
							totalmatchfound = totalmatchfound +1
						else
							objDebug.writeln "Match not found !:" & oMemberOf & " NOT in " & oObject.distinguishedname ,1
							call xmlWriter.WriteStartElement("matchnotfound")
							call xmlWriter.WriteElementString("group", oMemberOf)
							call xmlWriter.WriteElementString("object", oObject.distinguishedname)
							call xmlWriter.WriteEndElement()   ' of ("matchnotfound")
							totalmatcherror = totalmatcherror +1
						end if 
						intrangestart = intrangestart + 1
					Next
					totalmemberof = intrangestart
				Elseif oObject.MemberOf <>"" then 	' only member of one group
					totalmemberof = totalmemberof + 1
					if dictMember.Exists(oObject.MemberOf & vbtab & oObject.distinguishedname) then
						objDebug.writeln "Match:" & oObject.distinguishedname & " in " & oObject.MemberOf,5
						dictMember.remove oObject.MemberOf & vbtab & oObject.distinguishedname
					else
						objDebug.writeln "Match not found !:" & oObject.MemberOf & " NOT in " & oObject.distinguishedname,1
						call xmlWriter.WriteStartElement("matchnotfound")
						call xmlWriter.WriteElementString("group", oObject.MemberOf)
						call xmlWriter.WriteElementString("object", oObject.distinguishedname)
						call xmlWriter.WriteEndElement()   ' of ("matchnotfound")
						totalmatcherror = totalmatcherror +1
					end if 
					exit do 
				else
					' No remaining membership to precess
					exit do 
				End If
			else
				err.clear
				on error goto 0
				exit do 
			end if
		loop		

		call xmlWriter.WriteElementString("totalmemberof", totalmemberof)
		if totalmemberof > 5000 then 
			call xmlWriter.WriteElementString("totalmemberstatus", "Warn5000")
		elseif totalmemberof > 1015 then 
			call xmlWriter.WriteElementString("totalmemberstatus", "Warn1015")
		elseif totalmemberof > 120 then 
			call xmlWriter.WriteElementString("totalmemberstatus", "Warn120")
		else
			call xmlWriter.WriteElementString("totalmemberstatus", "OK")
		end if

		select case oObject.PrimaryGroupID
			Case 512, 513, 514, 515, 516
					'~ DOMAIN_GROUP_RID_Administratoren = &H200 (=>512 dec) 
					'~ DOMAIN_GROUP_RID_UserS  = &H201 (=>513 dec) 
					'~ DOMAIN_GROUP_RID_GUESTS = &H202 (=>514 dec) 
					'~ DOMAIN_GROUP_RID_COMPUTERS = &H203 (=>515 dec) 
					'~ DOMAIN_GROUP_RID_CONTROLLERS = &H203 (=>516 dec) 
				call xmlWriter.WriteElementString("PrimaryGroup", "OK:" & oObject.PrimaryGroupID)
			Case ""
				call xmlWriter.WriteElementString("PrimaryGroup", "OK: IS-Group")
			Case Else
				call xmlWriter.WriteElementString("PrimaryGroup", "WARN:" & oObject.PrimaryGroupID)
		end select

	else
		on error goto 0
		call xmlWriter.WriteElementString("totalmemberstatus", "WARN:Unabletobind")
		objDebug.writeln "Unable to bind Object !:" & oObject.distinguishedname,2
		err.clear
	end if

	call xmlWriter.WriteEndElement()   ' of ("object")
	oRecordset.MoveNext
loop

call xmlWriter.WriteElementString("starttime5", now())
arrkeys = dictMember.keys
for count = 0 to dictMember.count - 1
	objDebug.writeln "Missing member of!:" & arrkeys(count),1
	call xmlWriter.WriteStartElement("missing")
	call xmlWriter.WriteElementString("group", split(arrkeys(count),vbtab)(0))
	call xmlWriter.WriteElementString("object", split(arrkeys(count),vbtab)(1))
	call xmlWriter.WriteEndElement()   ' of ("missing")
next

objDebug.writeln "totalmissing:" & dictMember.count, 0
call xmlWriter.WriteElementString("totalmissing", dictMember.count)

call xmlWriter.WriteElementString("totalmatcherror", totalmatcherror)
objDebug.writeln "totalmatcherror:" & totalmatcherror, 0

call xmlWriter.WriteElementString("totalmatchfound", totalmatchfound)
objDebug.writeln "totalmatchfound:" & totalmatchfound, 0

call xmlWriter.WriteElementString("totalobjects", total)
objDebug.writeln "Total objects resolved:" & total, 0

call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("checkgrp")
call xmlWriter.Close               ' XML schreiben
WScript.quit(0)


sub writexslt(strfilename)
	dim txtxsl
	txtxsl = _
		"<?xml version=""1.0"" encoding=""utf-8"" ?> " & vbcrlf & _
		"<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & vbcrlf & _
		"<xsl:template match=""/"">" & vbcrlf & _
		"<html>" & vbcrlf & _
		"<head><title>checkgrp Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>checkgrp Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""checkgrp""> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Start Query AD für groups</th><td><xsl:value-of select=""starttime"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Load Memberlist into dictionary</th> <td><xsl:value-of select=""starttime2"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Query AD für objects</th> <td><xsl:value-of select=""starttime3"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Match members to dictionary</th> <td><xsl:value-of select=""starttime4"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Dump missing members</th> <td><xsl:value-of select=""starttime5"" /></td></tr>" & vbcrlf & _
		"	<tr><th>EndTime</th> <td><xsl:value-of select=""endtime"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Total Objects processed</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalobjects"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Total Groups processed</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalgroup"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Total relations found</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalmatchfound""/></td></tr>" & vbcrlf & _
		"	<tr><th># Membership not in MemberOF</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totalmissing""/></td></tr>" & vbcrlf & _
		"	<tr><th># Memberof not in Member</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totalmatcherror""/></td></tr>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"<h2>Inconsistent memberships based on Member</h2> " & vbcrlf & _
		"<p>These objects are in the member list of the group but the membership is not represented in the memberof property of the object itself. So check the infrastructure master FSMO role</p>" & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>User</th> " & vbcrlf & _
		"	<th>Group</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""checkgrp/missing""> " & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""object"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""group"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	</tr>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"</table>" & vbcrlf & _		
		"<h2>Inconsistent memberships based on Memberof</h2> " & vbcrlf & _
		"<p>These objeckt contain the group in MemberOf but they are not in the member property of the group. So check the infrastructure master FSMO role</p>" & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>User</th> " & vbcrlf & _
		"	<th>Group</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""checkgrp/object/matchnotfound""> " & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""object"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""group"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	</tr>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"</table>" & vbcrlf & _		
		"<h2>Objectlist</h2> " & vbcrlf & _
		"<p>Please check these oObjects. To many group memberships can cause problems</p>" & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>name:</th> " & vbcrlf & _
		"	<th>dn:</th> " & vbcrlf & _
		"	<th>totalmemberof:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""checkgrp/object""> " & vbcrlf & _
		"	<xsl:sort select=""totalmemberof"" data-type=""number"" order=""descending""/>" & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""name"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""dn"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<xsl:choose>" & vbcrlf & _
		"		<xsl:when test=""totalmemberof &gt; '5000'"">" & vbcrlf & _
		"			<td bgcolor=""#ff0000"">" & vbcrlf & _
		"			<xsl:value-of select=""totalmemberof"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:when>  " & vbcrlf & _
		"		<xsl:when test=""totalmemberof &gt; '1015'"">" & vbcrlf & _
		"			<td bgcolor=""#ff8000"">" & vbcrlf & _
		"			<xsl:value-of select=""totalmemberof"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:when>" & vbcrlf & _
		"		<xsl:when test=""totalmemberof &gt; '120'"">" & vbcrlf & _
		"			<td bgcolor=""#ffff00"">" & vbcrlf & _
		"			<xsl:value-of select=""totalmemberof"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:when>" & vbcrlf & _
		"		<xsl:otherwise>" & vbcrlf & _
		"			<td bgcolor=""#00ff00"">" & vbcrlf & _
		"			<xsl:value-of select=""totalmemberof"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:otherwise>" & vbcrlf & _
		"	</xsl:choose>" & vbcrlf & _
		"	</tr>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</body>" & vbcrlf & _
		"</html>" & vbcrlf & _
		"</xsl:template>" & vbcrlf & _
		"</xsl:stylesheet>"

	Const ForWriting = 2
	dim fs, file
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set file = fs.OpenTextFile(strfilename, ForWriting, True)
	file.writeline Convert2Text(txtxsl)
	file.Close
end sub

' ==================================================  Auxilary procedures and classes ==========================

class XMLTextWriter
'~ usage in VBScript. Please define StyleSheet and filename first and than start writing the data
'~ set xmlWriter = new XmlTextWriter
'~ xmlWriter.filename = "filename.xml"
'~ xmlWriter.Indentation = 4
'~ call xmlWriter.WriteStylesheet("stylesheet.xsl")
'~ call xmlWriter.WriteStartElement("Root")
'~ call xmlWriter.WriteElementString("starttime", now())
'~ call xmlWriter.WriteEndElement
'~ call xmlWriter.close

	dim intIndentation
	dim level, tagopen
	dim Stack(100)  ' i have problems using redim, so i use a fixed number für the depth
	dim fs, xmlfile


	private Sub Class_Initialize
		intIndentation = 4 
		level  = 0 
		tagopen = false
	End Sub

	public Property let filename(wert)    
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set xmlfile = fs.OpenTextFile(wert, 2, True)  ' 2 = ForWriting
		xmlfile.write "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbcrlf
	End Property
	
	public Property let Indentation(wert)
		intIndentation = wert
	End Property

	sub Writestylesheet (item)
		'* <?xml-stylesheet type="text/xsl" href="transform.xsl" ?>
		xmlfile.write "<?xml-stylesheet type=""text/xsl"" href="""& item &"""?>" & vbcrlf
	end sub

	sub WriteStartElement(item)
		xmlfile.write vbcrlf & space(intIndentation*level) & "<" & quote(trim(item))  ' & ">"  ' Ende offen
		tagopen = true
		stack(level) = item
		level = level + 1
	end sub

	sub WriteAttributeString(item,wert)  ' erg&auml;nzt eine ID zum aktuellen Element
		if tagopen then 
			xmlfile.write " id=""" & Quote(wert) & """"
		else
			wscript.echo "XMLWriter: Tag not open"
			wscript.quit(255)
		end if
	end sub

	sub WriteElementString(item,wert)  ' <item>wert</item>
		if tagopen then 
			xmlfile.write ">" : tagopen = false
		end if
		xmlfile.write vbcrlf & space(intIndentation*level) 
		xmlfile.write "<" & quote(trim(item)) & ">" 
		xmlfile.write quote(wert)
		xmlfile.write "</" & quote(item) & ">"
	end sub

	sub WriteEndElement
		if tagopen then 
			xmlfile.write ">" : tagopen = false
		end if
		level = level - 1
		xmlfile.write vbcrlf & space(intIndentation*level) & "</" & quote(stack(level))& ">"
	end sub

	private function quote(wert)
		' 308060 HOW TO: Locate and Replace Special Characters in an XML File with Visual Basic .NET
		' 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 
		next
		if len (tempwert ) > 0 then
			tempwert=replace(tempwert ,"&","&amp;")
			tempwert=replace(tempwert ,"<","&lt;")
			tempwert=replace(tempwert ,">","&gt;")
			tempwert=replace(tempwert ,"""","&quot;")
			tempwert=replace(tempwert ,"'","&apos;")
		end if
		quote=tempwert 
	end function

	sub close() : xmlfile.Close : end sub
	
end class


class debugwriter
	' Generic Class für writing debugging information

	private objIE, file, fs, debugfilename, status, strline
	private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole

	private Sub Class_Initialize
		status = "active" : strline = "" : debugfilename = ""
		debuglevelIE = -1
		debuglevelfile = -1 
		debugleveleventlog = -1
		debuglevelConsole = -1
	End Sub

	private Sub Class_Terminate()
		if isobject(OBJIE) then
			objie.document.write "</table></body></html>"
		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
		strMessage = strline & strMessage
		if (status = "active") Then
           if (debuglevelfile >= intseverity) 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))
            end if

           if debugleveleventlog >=intSeverity 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 >=intSeverity 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 >=intSeverity 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 "<html><head><title>DebugWriter Output</title></head><body>"
					objIE.document.write "<table  border=""1"" width=""100%""><tr><th>Time</th><th>intseverity</th><th>Description</th></tr>"
				end if
           		strieline = "<tr><td>" & now () & "</td>"
                Select Case intseverity
                    Case 0  strieline = strieLine & "<td bgcolor=""#00FF00"">Out0</td>"
                    Case 1  strieline = strieLine & "<td bgcolor=""#FF0000"">Err1</td>"
                    Case 2  strieline = strieLine & "<td bgcolor=""#FFFF00"">Wrn2</td>"
                    Case 3  strieline = strieLine & "<td>Inf3</td>"
                    Case Else strieline = strieLine & "<td>Dbg"&intseverity&"</td>"
                End Select
                strieline = strieline & "<td>" & strmessage & "</td></tr>"
				objIE.document.write cstr(strieline)
           end if

           '~ if (instr(DebugTarget,"mom") <>0) 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

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