Option Explicit
'-------------------------------------------------------------------------
' grp2quota.vbs
'
' Description:
' uses group memberships to set mailbox storage limits
' ATTN: You have to create groups and memberships in the AD to make that working!!
'
' the script walks through every exchange mailbox object and checks the "member of"
' attributs against special Quotagroups
'
' Runtime error are not controlled. So check, if the script runs correctly
' The script uses the permission of the calling User. Make sure that you have enough permissions
'
' (c)2007 Net at Work Netzwerksysteme GmbH
' 
' Version 1.0 (15. Jan 2007)
'		+ initial version based on grp2exinet.vbs
' Version 2.0 (11. Apr 2007)
'	NEW DESIGN. No longer using dynamic group names. need to configure static groups
'	SECURITY: Otherwise an OU Admin could create his own group to define private limits
'
'	Step1: Extract group Membership (memberOf) into a dictionary. 
'		Can handly memberships >1000 Groups (Default LDAP Limit)
'		Memberships are not parsed recursively ! only one level
'	Step2: Check Quotadefinitions.
'		FIRST MATCH WINS! (similar zu RUS polices)
'		NoMatch -> reset quota to "UserDefaults" (Mailboxstore quotas are applied by Exchange
' Version 2.1 (27. Nov 2008)
'	Added Option "IGNORE"  to do not modify the settings if member of that group.  All three must be set to ignore
'
' Details
' 	mDBUserDefaults:  (text) TRUE if all settings are default Else "FALSE"
' 	MDBStorageQuota:  (text) Must be numeric (limit in KB) or not existing (default). "emptystring" not allowed !
'	"object.setinfo" only writes, if something has changed. USN are not incremented. no unneeded replication
'-------------------------------------------------------------------------

'Const conDNSDomain = "dc=ihredomain,dc=ihretld"
Const conDNSDomain 			= "ou=GRP2Quota,dc=msxfaq,dc=local"		
' BaseDN to search für Users. Usage is limited für a single Domain. Use multiple instances für different domains

const action			= "readonly"   ' set to 'write'  to enable writing
'const action			= "write"
' "ReadOnly" Mode: You can check the XML-Output to verify the settings.
' if you are sure, that the script  does, what you want, then set action to "true"

dim arrQuotagroup
arrQuotagroup  = array (array("cn=GRP2Quota-1,ou=GRP2Quota,dc=msxfaq,dc=local","IGNORE","IGNORE","IGNORE"),_
				array("cn=GRP2Quota-1,ou=GRP2Quota,dc=msxfaq,dc=local","200000","250000","300000"),_
				array("cn=GRP2Quota-2,ou=GRP2Quota,dc=msxfaq,dc=local","300000","350000","400000"),_
				array("cn=GRP2Quota-3,ou=GRP2Quota,dc=msxfaq,dc=local","500000","550000","600000")_
			)
' Values are Numeric (in KILOByte !!or DEFAULT

Const ADS_PROPERTY_CLEAR  = 1
Const ADS_PROPERTY_UPDATE = 2
Const ADS_PROPERTY_APPEND = 3

call ForceCScript  ' must be rund with CSCRIPT
call abbruch ("Continue script ?" ,5)  ' Last question to stop

' ----- Initialisierung der Debugging und Loggingoptionen
dim strOutFilePrefix
strOutFilePrefix = "grp2quota-" & makefilename(Date() & "-" & Time()) ' complete file name für debug file
dim objDebug
set objdebug = new DebugWriter 
objDebug.target = "file:5 console:6 noie:0 noeventlog:0" ' errorlogging  0=only output, 1=Error 2=Warning 3=information  5++ =debug
objDebug.outFile = strOutFilePrefix & ".log"
objDebug.start
objDebug.writeln "grp2quota: Started", 0

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


Dim objCommand ,objConnection, objRecordSet
Set objCommand = CreateObject("ADODB.Command")  				' mit ADO das Active Directory durchsuchen
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "<LDAP://" & conDNSDomain & ">;" &_
		"(&(&(& (mailnickname=*)(| (&(objectCategory=person)(objectClass=User)(|(homeMDB=*)(msExchHomeServerName=*)))))));" &_
		"distinguishedName;subtree"  	' LDAP query zusammenbauen

objCommand.Properties("Page Size") = 100					' max 100 Ergebnisse auf einmal erhalten
Set objRecordSet = objCommand.Execute						' und los
objDebug.writeln "Total Objects to check:" & objrecordset.recordcount, 0
call xmlWriter.WriteElementString("totalfound", objrecordset.recordcount)

'
'  Loop through all exchange objects and check the memberOf Atribute to find groups
'

dim dictgroups
set dictgroups = CreateObject("Scripting.Dictionary")

Dim strDN, objUser, oMemberOf
Dim count, intrangestart
count = 0
Do until objRecordSet.EOF 							' jeden Datensatz einzeln bearbeiten.
	call xmlWriter.WriteStartElement("object")
	strDN = objRecordSet.Fields("distinguishedName")			' DN ermitteln
	count = count + 1
	objDebug.writeln "Processing:" & count & ":" & strDN, 4
	on error resume next
	Set objUser= GetObject("LDAP://" & replace(strDN,"/","\/"))			' User verbinden
	if err.number = 0 then
		on error goto 0
		objDebug.writeln " - Object bound", 5
		call xmlWriter.WriteElementString("dn", objUser.distinguishedname)
		call xmlWriter.WriteElementString("cn", objUser.cn)
		call xmlWriter.WriteElementString("name", objUser.name)

		dictgroups.removeall
		intrangestart = 0
		
		' =============================================================================
		' Collect groupmembership into a dictionary
		' =============================================================================
		do
			on error resume next
			objDebug.writeln "PageSearch Start:" & intrangestart,6
			objUser.GetInfoEx ARRAY("memberof;range=" & intrangestart & "-*"),0  ' do a paged search
			if err.number = 0 then
				on error goto 0
				objDebug.writeln "Vartype MEMBEROF:" & vartype(objUser.MemberOf),5
				if IsArray(objUser.MemberOf) then
					For Each oMemberOf in objUser.memberof
						objDebug.writeln "MemberXof:" & oMemberOf,5
						dictgroups.add lcase(oMemberOf),"1"
						intrangestart = intrangestart + 1
					Next
				Elseif objUser.MemberOf <>"" then 	' only member of one group
					objDebug.writeln "Member1of:" & objUser.MemberOf,5
					dictgroups.add lcase(objUser.MemberOf),"1"
					exit do ' No remaining membership to process
				else
					objDebug.writeln "No membership to process",7
					exit do ' No remaining membership to process
				End If
			else
				err.clear
				objDebug.writeln "Error Getting MemberOf",1
				on error goto 0
				exit do
			end if
		loop  		' End of converting Group Membership to 

		
		' =============================================================================
		' Find matching Quota policy
		' =============================================================================
		objDebug.writeln "Processing Policy groups für User:"& objUser.distinguishedname,3
		dim arrpolicygroup, strEffectivePolicyGrp
		dim mDBStorageQuota, mDBOverQuotaLimit, mDBOverHardQuotaLimit
		strEffectivePolicyGrp = "NONE"
		mDBStorageQuota = "DEFAULT"
		mDBOverQuotaLimit = "DEFAULT"
		mDBOverHardQuotaLimit  = "DEFAULT"

		for each arrpolicygroup in arrQuotagroup
			if dictgroups.exists (lcase(arrPolicygroup(0))) then
				objDebug.writeln " MATCH:"& arrPolicygroup(0),5
				strEffectivePolicyGrp = cstr(arrPolicygroup(0))
				mDBStorageQuota = cstr(arrPolicygroup(1))
				mDBOverQuotaLimit = cstr(arrPolicygroup(2))
				mDBOverHardQuotaLimit  = cstr(arrPolicygroup(3))
				exit für  ' Policy found 
			else
				objDebug.writeln " SKIP:"& arrPolicygroup(0),5
			end if
		next
		objDebug.writeln " Effective Policy: " & mDBStorageQuota & ":" &mDBOverQuotaLimit& ":" & mDBOverHardQuotaLimit, 3

		' =============================================================================
		' Apply Quota policy
		' =============================================================================
		call xmlWriter.WriteElementString("strEffectivePolicyGrp", strEffectivePolicyGrp)
		call xmlWriter.WriteElementString("mDBStorageQuota", mDBStorageQuota)
		call xmlWriter.WriteElementString("mDBOverQuotaLimit", mDBOverQuotaLimit)
		call xmlWriter.WriteElementString("mDBOverHardQuotaLimit", mDBOverHardQuotaLimit)

		if (mDBStorageQuota = "IGNORE") and (mDBOverQuotaLimit = "IGNORE") and (mDBOverHardQuotaLimit = "IGNORE") then
			call xmlWriter.WriteElementString("mDBUseDefaults", "IGNORE")
		elseif (mDBStorageQuota = "DEFAULT") and (mDBOverQuotaLimit = "DEFAULT") and (mDBOverHardQuotaLimit = "DEFAULT") then
			objUser.Put "mDBUseDefaults", "TRUE"
			call xmlWriter.WriteElementString("mDBUseDefaults", "TRUE")
			objUser.PutEx ADS_PROPERTY_CLEAR, "mDBStorageQuota", 0
			objUser.PutEx ADS_PROPERTY_CLEAR, "mDBOverQuotaLimit", 0
			objUser.PutEx ADS_PROPERTY_CLEAR, "mDBOverHardQuotaLimit", 0
		else
			objUser.Put "mDBUseDefaults", "FALSE"
			call xmlWriter.WriteElementString("mDBUseDefaults", "FALSE")
			if mDBStorageQuota = "DEFAULT" then 
				objUser.PutEx ADS_PROPERTY_CLEAR, "mDBStorageQuota", 0
			else
				objUser.Put "mDBStorageQuota", mDBStorageQuota
			end if
			
			if mDBOverQuotaLimit = "DEFAULT" then 
				objUser.PutEx ADS_PROPERTY_CLEAR, "mDBOverQuotaLimit", 0
			else
				objUser.Put "mDBOverQuotaLimit", mDBOverQuotaLimit
			end if

			if mDBOverHardQuotaLimit = "DEFAULT" then 
				objUser.PutEx ADS_PROPERTY_CLEAR, "mDBOverHardQuotaLimit", 0
			else
				objUser.Put "mDBOverHardQuotaLimit", mDBOverHardQuotaLimit
			end if
		end if

		' =============================================================================
		' Write back to Active Directory
		' =============================================================================
		If action = "write" Then
			call xmlWriter.WriteElementString("action", "write")
			objDebug.writeln " WRITE modifications", 4
			objUser.setinfo
		Else
			call xmlWriter.WriteElementString("action", "readonly")		' Nothing to do
			objDebug.writeln "READONLY modifications", 4
		End If

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

	objDebug.writeln "Done", 3
	call xmlWriter.WriteEndElement()	'object
	objRecordSet.MoveNext										' N&auml;chster Benutzer
Loop

call xmlWriter.WriteElementString("totalprocessed", count)
objDebug.writeln "Total objects processed:" & count, 0
call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()
call xmlWriter.Close
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>grp2quota Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>grp2quota Status</h1> " & vbcrlf & _
		"<h2>Parameters</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Starttime</th><td><xsl:value-of select=""grp2quota/starttime"" /></td></tr>" & vbcrlf & _
		"	<tr><th>EndTime</th> <td><xsl:value-of select=""grp2quota/endtime"" /></td></tr>" & vbcrlf & _
		"	<tr><th>Action</th> <td><xsl:value-of select=""grp2quota/action"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Processed</th> <td><xsl:value-of select=""grp2quota/totalprocessed"" /></td></tr>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"<h2>Details</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>CN:</th> " & vbcrlf & _
		"	<th>Name:</th> " & vbcrlf & _
		"	<th>mDBUseDefaults:</th> " & vbcrlf & _
		"	<th>mDBStorageQuota:</th> " & vbcrlf & _
		"	<th>mDBOverQuotaLimit:</th> " & vbcrlf & _
		"	<th>mDBOverHardQuotaLimit:</th> " & vbcrlf & _
		"	<th>Action:</th> " & vbcrlf & _
		"	<th>EffectivePolicyGrp:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""grp2quota/object""> " & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td><xsl:value-of select=""cn"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""name"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""mDBUseDefaults"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""mDBStorageQuota"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""mDBOverQuotaLimit"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""mDBOverHardQuotaLimit"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""action"" /></td>" & vbcrlf & _
		"	<td><xsl:value-of select=""strEffectivePolicyGrp"" /></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
			quote = ""
		else
			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
			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 if
	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 makefilename(byVal 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 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 
	next
	Convert2Text = tempwert
end function