Option Explicit
'-------------------------------------------------------------------------
' addself 1.1
'
' Beschreibung
' Prueft Objekte auf das Alter des Kennworts
'
' Laufzeitfehler werde nicht abgefangen und beenden das Skript. !!!
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
' http://www.microsoft.com/technet/scriptcenter/scripts/ad/Users/pwds/uspwvb09.mspx
' http://www.paulsadowski.com/WSH/cdo.htm
'
' (c)2004 Net at Work Netzwerksysteme GmbH
'
' Version 1.0 (23. Sep 2005) Frank Carius
'	- Neubeginn mit XML und LDAP-Suche statt OU-Rekursion
'	- AddSelf Funktion angepasst uebernommen von altem Script (Henning Krause)
' Version 1.1 (12. Nov 2008) Frank Carius
'	Tippfehler Koirrektur


' http://support.microsoft.com/kb/278966/en-us You cannot move or log on to an Exchange resource mailbox
' To determine how many disabled User accounts do not have the msExchMasterAccountSid attribute, you can generate an LDIF formatting export file. To do this, run the following Ldifde.exe command: 
' ldifde -f file.txt -d "dc=domain,dc=com" -l nothing -r "(&(objectcategory=person)(objectclass=User)(msexchUseraccountcontrol=2)(!(msexchmasteraccountsid=*)))"
' Skript AddSelf und entfernen des Users selbst (und SidHistory dinge)
' http://support.microsoft.com/kb/296479 Details zu msexchUseraccountcontrol
'-------------------------------------------------------------------------

' Constants für the NameTranslate object.
'Constants used in AD
const ADS_UserDISABLED = &H00002
const ADS_NAME_TYPE_1779 = &H000001 ' Name format as specified in RFC 1779. für example, "CN=fcarius,CN=Users,DC=msxfaq,DC=de".
const ADS_NAME_TYPE_NT4 = &H00003
const E2K_MB_FULL_MB_ACCESS = &H00001
const E2K_MB_SEND_AS = &H00002
const E2K_MB_EXTERNAL_ACCOUNT = &H00004
const E2K_MB_READ_PERMISSIONS = &H20000
const E2K_MB_TAKE_OWNERSHIP = &H80000
const ADS_ACE_REVISION_DS = &H00004
const ADS_ACETYPE_ACCESS_ALLOWED = &H00000
const ADS_ACEFLAG_INHERIT_ACE = &H00002

Dim total, totalok, totalwarn1, totalwarn2, result, strGCPath, strNTName 
Dim oConnection, oCommand, oRecordset, oUser
Dim strTemp, strQuery, lngpage, strOutFilePrefix, dtmvalue, intUserAccountControl, intpwage
dim oSMTPTest, objMessage, objDebug, xmlwriter, objTrans
Dim con
Dim rs
Dim fso
Dim file
Dim strCommand
dim intCounter
dim objUser, objSD, objACL, objACE
dim found
dim rootdse

strOutFilePrefix = makefilename("addself-" & 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
call abbruch ("Script fortsetzen ?" ,5)  ' Last question to stop
objDebug.writeln "addself: gestartet", 0

set xmlWriter = new XmlTextWriter
xmlWriter.filename = strOutFilePrefix & ".xml"
xmlWriter.Indentation = 4
call xmlWriter.WriteStylesheet("addself.xsl")
call writexslt("addself.xsl")
call xmlWriter.WriteStartElement("addself")
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

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 & ">;"&_
				"(&(objectcategory=person)(objectclass=User)(msexchUseraccountcontrol=2)(!(msexchmasteraccountsid=*)));" & _
				" distinguishedName,name,mail,mailNickName,msExchMasterAccountSid,msexchUseraccountcontrol,UserAccountControl;subtree"
Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0

Set objTrans = CreateObject("NameTranslate")

call xmlWriter.WriteElementString("starttime2", now())
total = 0 : totalwarn1 = 0 : totalwarn2 = 0 : totalok = 0
do until oRecordset.EOF
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&".." ,3
	total = total + 1
	call xmlWriter.WriteStartElement("object")
	call xmlWriter.WriteElementString("name", oRecordset.Fields("name"))
	call xmlWriter.WriteElementString("dn", oRecordset.Fields("distinguishedname"))
	objTrans.Set ADS_NAME_TYPE_1779, oRecordset.Fields("distinguishedname") ' use the Set method to specify the RPC 1779 format of the object name.
	strNTName = objTrans.Get(ADS_NAME_TYPE_NT4)  ' use the Get method to retrieve the NT Name.
	call xmlWriter.WriteElementString("nt4domain", Mid(strNTName, 1, InStr(strNTName, "\") - 1))
	call xmlWriter.WriteElementString("nt4User", Mid(strNTName, InStr(strNTName, "\") + 1))
	call xmlWriter.WriteElementString("oldmsexchUseraccountcontrol", oRecordset.Fields("msexchUseraccountcontrol"))
	call xmlWriter.WriteElementString("oldmsExchMasterAccountSid", oRecordset.Fields("msExchMasterAccountSid"))


' Logic: Muss muss Exchange enabled sein.
' wenn dann noch disabled, dann muss msexchUseraccountcontrol = 2 und Self addiert werden, wenn kein anderer external account
' wenn dann nicht disabled, dann muss msexchUseraccountcontrol = 0 und es darf kein  external account eingetragen sein


	if oRecordset.Fields("mailNickName") <> "" then  						'Must be set if User is mail enabled
		if (oRecordset.Fields("UserAccountControl") and ADS_UserDISABLED ) > 0 then 
			'User is disabled
			call xmlWriter.WriteElementString("disabled", "true")
			objDebug.writeln " User is DISABLED", 5

			if oRecordset.Fields("msexchUseraccountcontrol") = 2 then 'must be 2 if disabled User
				call xmlWriter.WriteElementString("msexchUseraccountcontrol", "OK")
				objDebug.writeln " msexchUseraccountcontrol is OK", 5
			else
				call xmlWriter.WriteElementString("msexchUseraccountcontrol", "FIX")
				objDebug.writeln " msexchUseraccountcontrol is NOT 2 Fixing", 5
			end if

			if not isnull(oRecordset.Fields("msExchMasterAccountSid")) then  	'check if the User has a masteraccount set. Err.Number will be zero if Masteraccount is set
					fixUser(child)
					counterFixed = counterFixed + 1
			else
				call xmlWriter.WriteElementString("status", "OK1")
			
			end if
		
		else
			call xmlWriter.WriteElementString("disabled", "false")
			objDebug.writeln " User ist ENABLED", 5
			if oRecordset.Fields("msexchUseraccountcontrol") = 0 then 'must be 0 if enabled User
				call xmlWriter.WriteElementString("status", "OK2")
				objDebug.writeln " msexchUseraccountcontrol is NOT 0 Fixing", 5
				
			else
				objDebug.writeln " msexchUseraccountcontrol is NOT 0 Fixing", 5
				msexchUseraccountcontrol = 0
			end if
		end if 
	else
		' User is NOT mailenabled, skip
		call xmlWriter.WriteElementString("status", "No MailNicname")
	end if

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

call xmlWriter.WriteElementString("total", total)
objDebug.writeln "Total objects checked:" & total, 0
call xmlWriter.WriteElementString("totalok", totalok)
objDebug.writeln "Total objects with ok:" & totalok, 0
call xmlWriter.WriteElementString("totalwarn1", totalwarn1)
objDebug.writeln "Total objects with warn1:" & totalwarn1, 0
call xmlWriter.WriteElementString("totalwarn2", totalwarn2)
objDebug.writeln "Total objects with warn2:" & totalwarn2, 0
call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("addself")
call xmlWriter.Close               ' XML schreiben
WScript.quit(0)



function fixUser(objUser)              	'Fixes the accountinformations of the given User
	
	dim objSD, objACL, objACE

	'Set the primäry Account to SELF
	objUser.Put "msExchMasterAccountSid", objUser.Get("objectSID")

	'Get the mailbox security descriptor
	set objSD = objUser.Get("msExchMailboxSecurityDescriptor")
	set objACL = objSD.DiscretionaryAcl
	found = false
	
	for each objACE in objACL               	'Iterate through the ACL to find the SELF-Account
		if objACE.Trustee = "SELF" Then 
			found = true
			Exit For
		end if
	next
	
	if not found then 	'If no SELF-Account is present, create it
		set objACE = CreateObject("AccessControlEntry")
		objace.Trustee = "SELF"
		objace.AceFlags = ADS_ACEFLAG_INHERIT_ACE
		objace.AceType = ADS_ACETYPE_ACCESS_ALLOWED
		objacl.addace objace
	end if
	
	'Give the SELF-Account the External-Account right
	objace.AccessMask = objace.accessmask OR E2K_MB_READ_PERMISSIONS OR  E2K_MB_FULL_MB_ACCESS OR E2K_MB_EXTERNAL_ACCOUNT

	'Save the changes
	objUser.Put "msExchMailboxSecurityDescriptor", objSD
	objUser.setInfo		
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>addself Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>addself Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""addself""> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Starttime</th><td><xsl:value-of select=""starttime"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Start Verarbeitung</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># Objects</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""total""/></td></tr>" & vbcrlf & _
		"	<tr><th># OK</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totalok""/></td></tr>" & vbcrlf & _
		"	<tr><th># Warn1</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totalwarn1""/></td></tr>" & vbcrlf & _
		"	<tr><th># Warn2</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalwarn2"" /></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>dn:</th> " & vbcrlf & _
		"	<th>nt4domain:</th> " & vbcrlf & _
		"	<th>nt4User:</th> " & vbcrlf & _
		"	<th>age:</th> " & vbcrlf & _
		"	<th>status:</th> " & vbcrlf & _
		"	<th>action:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""addself/object""> " & vbcrlf & _
		"	<xsl:sort select=""status"" data-type=""text"" order=""descending""/>" & vbcrlf & _
		"	<xsl:sort select=""exchange"" data-type=""text"" 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 & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""nt4domain"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""nt4User"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""status"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""action"" /> " & vbcrlf & _
		"	</td>" & 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=""
		if isnull(wert) then wert = ""
		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