Option Explicit
'-------------------------------------------------------------------------
' DumpAddressLists.vbs
'
' Beschreibung
' List rekursiv die Mitglieder von Gruppen und findet Gruppen ohne Mitglieder (Computer oder User)
'
' 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 (12. Apr 2006) Frank Carius
'	Initial Release
' Version 1.1 (12. Apr 2006) Frank Carius
'	Zählt nun auch noch die User dieser Adressliste
'	Farbliche Kennzeichnung der Ausgabe
'
' 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, totalmember, 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
dim strRootDSE
dim oCont, oGC

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

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

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

'
'  Walk though all adress lists
'
set strRootDSE = GetObject ("LDAP://rootDSE")

objDebug.writeln "Querying AD für Addresslists at " & strRootDSE.get ("configurationNamingContext") ,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 = "<LDAP://" & strRootDSE.get ("configurationNamingContext") & ">;(objectClass=addressBookContainer);distinguishedName,name,purportedSearch;subtree"
Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0
call xmlWriter.WriteElementString("total1", oRecordset.recordcount)

call xmlWriter.WriteElementString("starttime2", now())
total = 0

do until oRecordset.EOF
	total = total + 1
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." ,4
	if oRecordset.Fields("purportedSearch")<>"" then
		total = total + 1
		call xmlWriter.WriteStartElement("object")   ' of ("DumpAddressLists")
		call xmlWriter.WriteElementString("dn", oRecordset.Fields("distinguishedName"))
		call xmlWriter.WriteElementString("name", oRecordset.Fields("name"))
		call xmlWriter.WriteElementString("filter", oRecordset.Fields("purportedSearch"))
		call xmlWriter.WriteElementString("entries", countobjects(oRecordset.Fields("purportedSearch")))
		call xmlWriter.WriteEndElement()   ' of ("DumpAddressLists")
	end if
	oRecordset.MoveNext
loop
call xmlWriter.WriteElementString("total2", total)

call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("DumpAddressLists")
objdebug.writeln "Write XML-Output",0
call xmlWriter.Close               ' XML schreiben
objdebug.writeln "DumpAdressLists finished",0
WScript.quit(0)


function countobjects (ldapfilter)
dim o2Connection, o2Recordset, o2Command 

	objdebug.writeln "Querying AD für Objects:" & ldapfilter,3
	Set o2Connection = CreateObject("ADODB.Connection")
	Set o2Recordset = CreateObject("ADODB.Recordset")
	Set o2Command = CreateObject("ADODB.Command")
	o2Connection.Provider = "ADsDSOObject"  'The ADSI OLE-DB provider
	o2Connection.Open "ADs Provider"
	o2Command.ActiveConnection = oConnection
	o2Command.Properties("Page Size") = 100
	o2Command.CommandText = "<" & strGCPath & ">;" & ldapfilter &";distinguishedName;subtree"
	Set o2Recordset = o2Command.Execute
	objdebug.writeln "Done Total Records found:" & o2Recordset.recordcount,3
	countobjects = o2Recordset.recordcount
end function


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>DumpAddressLists Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>DumpAddressLists Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""DumpAddressLists""> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Start AD-Search</th><td><xsl:value-of select=""starttime1"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Dump Adresslist</th> <td><xsl:value-of select=""starttime2"" /></td></tr>" & vbcrlf & _
		"	<tr><th>EndTime</th> <td><xsl:value-of select=""endtime"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Addresslists Total</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""total1""/></td></tr>" & vbcrlf & _
		"	<tr><th># Addresslists processed</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""total2""/></td></tr>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"<h2>Details</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>Name:</th> " & vbcrlf & _
		"	<th>Filter:</th> " & vbcrlf & _
		"	<th>Entries:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""DumpAddressLists/object""> " & vbcrlf & _
		"	<xsl:sort select=""name"" data-type=""number"" order=""descending""/>" & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""name"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""filter"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<xsl:choose>" & vbcrlf & _
		"		<xsl:when test=""entries &gt; '10'"">" & vbcrlf & _
		"			<td bgcolor=""#80FF80"">" & vbcrlf & _
		"			<xsl:value-of select=""entries"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:when>  " & vbcrlf & _
		"		<xsl:when test=""entries &gt; '1'"">" & vbcrlf & _
		"			<td bgcolor=""#FFFF80"">" & vbcrlf & _
		"			<xsl:value-of select=""entries"" /> " & vbcrlf & _
		"			</td>" & vbcrlf & _
		"		</xsl:when>  " & vbcrlf & _
		"		<xsl:otherwise>" & vbcrlf & _
		"			<td bgcolor=""#FF0000"">" & vbcrlf & _
		"			<xsl:value-of select=""entries"" /> " & 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 xmlfilename	'stores the filename
	dim xmldom  	'DOM Object
	dim xmlparent	'currentNode
	dim xmlroot		'RootNode
	dim xmlobject	'PArent of currentNode
	dim intIndentation

	'~ xmlfile.write "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbcrlf

	private Sub Class_Initialize
		dim xmldeclaration
		Set xmlDom = CreateObject("Microsoft.XMLDOM")
		xmlDom.loadxml "<?xml version='1.0'?>"
		set xmlobject = xmlDom
	End Sub

	private Sub Class_Terminate
		xmldom.LoadXML getFormattedXML
		xmldom.save(xmlfilename)
	End Sub
	
	public Property let filename(wert)    
		xmlfilename = wert
	End Property

	public Property get filename
		filename = xmlfilename 
	End Property

	public Property let Indentation(wert)
		' only für Backwards compatibility
	End Property

	public Property let Formatting(wert)
		' writer.Formatting = Formatting.Indented   ' Funktioniert nur mit .nEtg ?
	End Property

	sub Writestylesheet (item)
		dim stylePI 
		Set stylePI = xmlDom.createProcessingInstruction("xml-stylesheet", "type=""text/xsl"" href="""&item & """")
		xmlDom.appendChild(stylePI)
	end sub

	sub WriteStartElement(item)
		dim xmlobject2
		set xmlobject2 = xmlDom.createElement(item)
		xmlobject.appendchild xmlobject2
		set xmlobject = xmlobject2
	end sub


	sub WriteAttributeString(name,value)  ' erg&auml;nzt eine ID zum aktuellen Element
		if isnull(value) then value = ""
		xmlobject.setAttribute name, value
	end sub
	

	sub WriteElementString(item,value)  ' add XML tag and Data
		dim xmldata
		set xmldata = xmlDom.createElement(item)
		if isnull(value) then value = ""
		xmldata.text = value
		xmlobject.appendchild(xmldata)
	end sub
	
	sub WriteEndElement
	' Schliesse den aktuellen Client und gehe ein objekt h&ouml;her
		set xmlobject = xmlobject.parentnode
	end sub

	sub DeleteEndElement
	' Entferne den letzten Client komplett
		dim xmlobject2
		set xmlobject2 = xmlobject
		set xmlobject = xmlobject.parentnode
		xmlobject.removechild(xmlobject2)
	end sub


	function getXML
	' gebe die aktuelle XML-Information unformtiert aus
		getxml = xmldom.xml
	end function

	function LoadXML(strxml)
	' ersetze die Information durch eine neue XML-Information
		xmldom.loadXML(strxml)
	end function

	sub Flush()
	' Schreibe die aktuelle XML-Struktur als Datei heraus
		'~ xmldom.LoadXML getFormattedXML   ' wenn dsa aktiv wird, ist die XML Datei nicht komplett
		xmldom.save(xmlfilename)
	end sub


	function getFormattedXML
	' Gebe die XML-Struktur formatiert und besser lesbar aus
		dim oStylesheet
		set oStylesheet = CreateObject("Microsoft.XMLDOM")
		oStylesheet.async = False
		oStylesheet.loadXML ("<?xml version=""1.0"" encoding=""UTF-8""?>" & vbcrlf & _
						"<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & vbcrlf & _
						"<xsl:output method=""xml"" indent=""yes"" encoding=""UTF-8"" />" & vbcrlf & _
						"<xsl:template match=""@* | node()"">" & vbcrlf & _
						"   <xsl:copy>" & vbcrlf & _
						"        <xsl:apply-templates select=""@* | node()"" />" & vbcrlf & _
						"   </xsl:copy>" & vbcrlf & _
						"</xsl:template>" & vbcrlf & _
						"</xsl:stylesheet>")
		getFormattedXML = xmlDOM.transformNode(oStylesheet)
	end function


	sub close()
		xmldom.LoadXML getFormattedXML
		xmldom.save(xmlfilename)
	end sub
	
end class



class debugwriter
	' Generic Class für writing debugging information and handling runtime errors
	' By default al Level 1 Messaegs are logged to the Console

	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 "</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
		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 "<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) 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

Class ValidSMTP
	' Generic Class to validate an given SMTP-Address against formal rules (not a real NSLookup etc.)
	dim SMTPRegEx

	private Sub Class_Initialize
		Set SMTPregEx = New RegExp
		'  von http://www.twilightsoul.com/Default.aspx?tabid=134
		'~ SMTPregEx.Pattern =   "^((([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+[\t\x20]*|" _
							'~ & """[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F]*"")+"_
							'~ & ")?[\t\x20]*<([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+"_
							'~ & "(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|""[\x01-\x09\x0B\x0C"_
							'~ & "\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@(([a-zA-Z0-9][-a-zA-Z0-9]*"_
							'~ & "[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|\[(([0-9]?[0-9]|1[0-9][0-9]|"_
							'~ & "2[0-4][0-9]|25[0-5])\.){3}([0-9]?[0-9]|1[0-9][0-9]|"_
							'~ & "2[0-4][0-9]|25[0-5])\])>[\t\x20]*|([\t\x20]*"_
							'~ & "[!#-'\*\+\-/-9=\?A-Z\^-~]+(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|"_
							'~ & """[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@"_
							'~ & "(([a-zA-Z0-9][-a-zA-Z0-9]*[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|"_
							'~ & "\[(([0-9]?[0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])\.){3}"_
							'~ & "([0-9]?[0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])\]))$"
		' von http://www.twilightsoul.com/Default.aspx?PageContentID=10&tabid=134
		SMTPregEx.Pattern = "([\t\x20]*[!#-'\*\+\-/-9=\?A-Z\^-~]+"_
						&"(\.[!#-'\*\+\-/-9=\?A-Z\^-~]+)*|""[\x01-\x09\x0B\x0C"_
						&"\x0E-\x21\x23-\x5B\x5D-\x7F]*"")@(([a-zA-Z0-9][-a-zA-Z0-9]*"_
						&"[a-zA-Z0-9]\.)+[a-zA-Z]{2,}|\[(([0-9]?[0-9]|1[0-9][0-9]|"_
						&"2[0-4][0-9]|25[0-5])\.){3}([0-9]?[0-9]|1[0-9][0-9]|"_
						&"2[0-4][0-9]|25[0-5])\])"
		SMTPregEx.IgnoreCase = true
	End Sub

	private Sub Class_Terminate() : Set SMTPregEx = nothing : End Sub
	
	function Test(wert)
		test =  SMTPregEx.test(wert)   ' Test is true if Match is found
	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


Function OctetToGUIDStr (arrbytOctet)
	' Function to convert OctetString (byte array) to GUID string.
	' based on Code from Richard Mueller, a MS MVP in Scripting and ADSI

	Dim k,strtemp
	OctetToGUIDStr = ""
	For k = 1 To Lenb (arrbytOctet)
		OctetToGUIDStr = OctetToGUIDStr & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
	Next
	
'~ In     FB72F95DB430704983082BB1C79FFB38
'~ Out {5DF972FB-30B4-4970-8308-2BB1C79FFB38}
	
	strtemp= "{"
	strtemp = strtemp & mid(OctetToGUIDStr,7,2)
	strtemp = strtemp & mid(OctetToGUIDStr,5,2)
	strtemp = strtemp & mid(OctetToGUIDStr,3,2)
	strtemp = strtemp & mid(OctetToGUIDStr,1,2)
	strtemp = strtemp & "-"
	strtemp = strtemp & mid(OctetToGUIDStr,11,2)
	strtemp = strtemp & mid(OctetToGUIDStr,9,2)
	strtemp = strtemp & "-"
	strtemp = strtemp & mid(OctetToGUIDStr,15,2)
	strtemp = strtemp & mid(OctetToGUIDStr,13,2)
	strtemp = strtemp & "-"
	strtemp = strtemp & mid(OctetToGUIDStr,17,4)
	strtemp = strtemp & "-"
	strtemp = strtemp & mid(OctetToGUIDStr,21,12)
	OctetToGUIDStr = strtemp & "}"

End Function