Option Explicit
'-------------------------------------------------------------------------
' GetLocality
'
' Beschreibung
' Das Programm exportiert alle "ORT"-Felder und fasst diese in einem dictionary Objekct zur Ausgabe zusammen
	
' (c)2006 Net at Work Netzwerksysteme GmbH
'
' Version 1.0 (03 Mrz 2006) Frank Carius

Dim xmlwriter, strGCPath
Dim oConnection, oCommand, oRecordset
Dim strTemp, strQuery, strObjectClass, strOutFilePrefix
Dim dictlocality, strLocality 
Dim total

strOutFilePrefix = makefilename("GetLocality-" & Date() & "-" & Time())
' Pfad und Dateiname der Log-Datei
dim objDebug
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
'~ call abbruch ("Script fortsetzen ?" ,5)  ' Last question to stop
objDebug.writeln "GetLocality: gestartet", 0

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

objDebug.writeln "Looking für GC",5
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" & strGCPath,0
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"  'The ADSI OLE-DB provider
oConnection.Open "ADs Provider"
oCommand.ActiveConnection = oConnection
oCommand.Properties("Page Size") = 100
oCommand.CommandText = "<" & strGCPath & ">;" & _
	"(|" & _
	  "(&(objectClass=User)(objectCategory=person))"& _
	");" & _
    "distinguishedName,ObjectClass,displayName,l," & _
	";subtree"

Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0
call xmlWriter.WriteElementString("starttime2", now())

total = 0
set dictlocality = CreateObject("scripting.dictionary")

do until oRecordset.EOF
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20)&"..",3
	strObjectClass = lcase(join(oRecordset.Fields("ObjectClass"),","))
	total = total + 1
	
	'~ call xmlWriter.WriteStartElement("object")
	'~ call xmlWriter.WriteElementString("distinguishedName", oRecordset.Fields("distinguishedName"))
	'~ call xmlWriter.WriteElementString("displayName", oRecordset.Fields("displayName"))
	strLocality = oRecordset.Fields("l")
	if strLocality= "" then strLocality = "--EMPTY--"
	if isnull(strLocality) then strLocality = "--NULL--"
	strLocality = "!"&strLocality&"!"
	'~ call xmlWriter.WriteElementString("l", strLocality )
	if dictLocality.exists (strLocality) then
		dictLocality.item(strLocality ) = dictLocality.item(strLocality) + 1
		objDebug.writeln "Dict INC:" & strLocality & "-" & dictLocality.item(strLocality),6
	else
		dictLocality.add strLocality, "1"
		objDebug.writeln "Dict ADD:" & strLocality,6
	end if 
	'~ call xmlWriter.WriteEndElement   ' of ("object")
	oRecordset.MoveNext
loop


objDebug.writeln "Dump Locality",0
call xmlWriter.WriteElementString("starttime3", now())



Dim arrKeys, count

arrKeys = dictLocality.keys
for count = 0 to dictLocality.count - 1
	call xmlWriter.WriteStartElement("locality")
	call xmlWriter.WriteElementString("name", arrKeys(count))
	'~ on error resume next
	if dictLocality.exists (arrKeys(count)) then
		call xmlWriter.WriteElementString("count", dictLocality.item(arrKeys(count)))
	else
		call xmlWriter.WriteElementString("count", "0")
	end if
	call xmlWriter.WriteEndElement   ' of ("policy")
next

call xmlWriter.WriteElementString("total", total)
objDebug.writeln "Total objects checked:" & total, 0
call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("GetLocality")
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>GetLocality Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>GetLocality Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""GetLocality""> " & 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>Start Dump Locality</th> <td><xsl:value-of select=""starttime3"" /></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 & _
		"</table>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"<h2>Locality</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>Name:</th> " & vbcrlf & _
		"	<th>Count:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""GetLocality/locality""> " & vbcrlf & _
		"	<xsl:sort select=""l"" data-type=""text"" order=""descending""/>" & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""name"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""count"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	</tr>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"<h2>Users</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>distinguishedName:</th> " & vbcrlf & _
		"	<th>Displayname:</th> " & vbcrlf & _
		"	<th>Location</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""GetLocality/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=""distinguishedName"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""displayname"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""l"" /> " & 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 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