'-------------------------------------------------------------------------
' feiertage
'
' Beschreibung
' Zentrales Eintragen von Terminen in Kalendern von Anwendern
'
' Vorgehensweise
' - liest eine Liste von Terminen aus einer Textdatei
' Format siehe Outlook http://www.docoutlook.de/Umgebung/Add-on/Add-on_page.htm
' erste Zeile wird ignoriert. folgezeilen enthalten den Betreff und mit Komma getrennt das Startdatum
' [Deutschland] 2
' Test8-12-05, 2005/12/08
' Test9-12-05, 2005/12/09
' - Holt alle Empfänger aus dem AD
' - Verbindet sich per CDO 1.21 mit jedem einzelnen Postfach
' - Importiert die Termine in den Kalender, wenn noch nicht vorhanden
' - Ausgabe der Aktionen als XML
'
' Voraussetzung
' - Ausführender Benutzer muss auf alle Postfächer Vollzugriff haben
' - Verbindung zum DC/GC und Mailserver
' - CDO 1.21
'
' Version 1.0 (07. Dez 2005)
' Erste Version
' Umfangreiche Tests sind noch ausstehen
' Version 1.1 (08. Dez 2005)
' TerminKalender des Postfach cachen, verbesserte Abarbeitung
' Korrektur Berechnung Restlaufzeit
' Version 1.2 (08. Dez 2005)
' Freebusy= Frei
' Categories = Feiertag
' Version 1.3 (24. Jan 2006)
' Sonderbehandlung der LDAP-Objekte mit replace \/
' Version 1.4 (01. Feb 2006)
' Fehler mit ubound(array,2) !!!
' Version 1.5 (08. feb 2006)
' Letzter Feiertag wurde "vergessen" da ubound mit -1 eingesetzt wurde (Arrays beginnen bei 0 bis ubound
' Version 1.6 (15. Jun 2006)
' "Merker" bereits bearbeiteter Postfächer im AD setzen umd Arbeit zu sparen
' Das Script importiert aber eh nur Feiertage, die noch nicht vorhanden sind.
' Version 1.7 (13. Nov 2007)
' Fehler in FindGC Path gibt auf dem Bildschirm falsche Werte aus
' Version 1.8 (21. Dec 2007)
' oAppointment.AllDayEvent = true
' Version 1.9 (22. Sep 2008)
' MehrDebugausgaben
' Version 1.10 (14. Okt 2008)
' Prüfen und setzen der Mailbox Zeitzone
' Version 1.11 (23. Jan 2009)
' Error bei Mailbox Zeitzone abgefangen
' Location addiert
' Simulationsmode addiert
'
' Appointment Object
' http://msdn.microsoft.com/library/default.asp?URL=/library/en-us/cdo/html/aa155812-5908-4304-a855-3e9199df252a.asp
' http://www.merlyn.demon.co.uk/vb-dates.htm
'-------------------------------------------------------------------------
Option Explicit
' Bitte hier den Dateinamen der Importdatei angeben
Const STRIMPORTFILE = ".\outlook.txt"
'Const MERKER = "extensionAttribute3"
Const MERKER = ""
Const conTimezone = 3 ' Zeitzone CdoTmzGMT1
Const conLocation = "Deutschland" ' Zeitzone CdoTmzGMT1
Const conSimulation = true ' Zeitzone CdoTmzGMT1
Const CdoDefaultFolderCalendar = 0
Const CdoDefaultFolderContacts = 5
Const CdoDefaultFolderDeletedItems = 4
Const CdoDefaultFolderInbox = 1
Const CdoDefaultFolderJournal = 6
Const CdoDefaultFolderNotes = 7
Const CdoDefaultFolderOutbox = 2
Const CdoDefaultFolderSentItems = 3
const CdoDefaultFolderTasks = 8
Const CdoPR_START_DATE = &H600040
Const CdoPR_END_DATE = &H610040
Const CdoPR_SUBJECT = &H0037001F
dim totalerr, total, totalread, totalimport
dim strOutFilePrefix
dim objCommand, objConnection, objRecordSet, objUser
dim ie, document, timestart, intReady
dim strHomeServer, strMailbox, strMerker
dim strResult
dim dtStarttime
dim arrFeiertage
call ForceCScript ' must be rund with CSCRIPT
call abbruch ("Feiertage Script fortsetzen ?" ,5) ' Last question to stop
' ----- Initialisierung der Debugging und Loggingoptionen
strOutFilePrefix = "Feiertage-" & makefilename(Date() & "-" & Time()) ' Pfad und Dateiname der Log-Datei
dim objDebug
set objdebug = new DebugWriter
objDebug.target = "file:6 console:6" ' ie eventlog
objDebug.outFile = strOutFilePrefix &".log"
objDebug.start
objDebug.writeln "feiertage: gestartet", 0
' Start XML-File
dim xmlWriter
set xmlWriter = new XmlTextWriter
xmlWriter.filename = strOutFilePrefix & ".xml"
xmlWriter.Indentation = 4
call xmlWriter.WriteStylesheet("feiertage.xsl")
call writexslt("feiertage.xsl")
call xmlWriter.WriteStartElement("feiertage")
call xmlWriter.WriteElementString("starttime", now())
set ie = createobject("InternetExplorer.Application")
ie.navigate("about:blank")
ie.visible = true
ie.document.write("
Feiertagefeiertage
" & _
"Current Mailbox: | |
" & _
"Current Operation: | |
" & _
"Overall Progress: | |
" & _
"Time: Start Time: Running Time: Ende | " &_
" " & _
" " & _
" " & _
" |
" & _
"Detail: | |
" & _
"
")
dtStarttime = now()
ie.document.all("starttime").innerHTML = dtStarttime
arrFeiertage = loadappointment(STRIMPORTFILE) ' Load Appointments into the array
newlogentry "Loading List of Mailboxes from AD", 3
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 = "<" & findGCPath & ">;" & _
"(&" & _
"(mailnickname=*)" & _
"(| " & _
"(&" & _
"(objectCategory=person)" & _
"(objectClass=User)" & _
"(|" & _
"(homeMDB=*)" & _
"(msExchHomeServerName=*)" & _
")" & _
")" & _
")" & _
"(!msExchHideFromAddressLists=TRUE)" & _
");" & _
"distinguishedName,cn,HomeMDB,mail,MailNickName;subtree"
objCommand.Properties("Page Size") = 100 ' max 100 Ergebnisse auf einmal erhalten
Set objRecordSet = objCommand.Execute ' und los
objDebug.writeln "Total Mailboxes to check:" & objrecordset.recordcount, 0
newlogentry "Loading List of Mailboxes from AD DONE: Total:" & objrecordset.recordcount, 3
call xmlWriter.WriteElementString("totalfound", objrecordset.recordcount)
total = 0 : totalread = 0 : totalerr = 0 : totalimport = 0
Do until objRecordSet.EOF ' jeden Datensatz einzeln bearbeiten.
total = total + 1
call xmlWriter.WriteStartElement("object")
objDebug.writeln " Processing DN:" & objRecordSet.Fields("distinguishedName"), 0
call xmlWriter.WriteElementString("dn", objRecordSet.Fields("distinguishedName"))
if merker <> "" then ' use AD Attibute to Skip already processed Users
objDebug.writeln " Checking Object für merker", 5
set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName"))
on error resume next
strmerker = objUser.get(MERKER)
if err then ' Attribute not found
strmerker = ""
objDebug.writeln " MERKER not found - will process that object", 5
end if
err.clear
on error goto 0
if instr(strmerker ,"Feiertagupdate") = 1 then
strResult = "Object already processed at " & strmerker
strmerker = "SKIP"
objDebug.writeln " Object already processed at " & strmerker, 5
end if
else
strmerker = ""
end if
if strmerker <> "SKIP" then
objDebug.writeln " Start Processing User", 5
strHomeServer = gethomeserver(objRecordSet.Fields("HomeMDB"))
strMailbox = objRecordSet.Fields("mail")
objDebug.writeln " strHomeServer:" & strHomeServer, 6
objDebug.writeln " strMailbox :" & strMailbox , 6
if strMailbox = "" then strMailbox = objRecordSet.Fields("MailNickName")
if strMailbox = "" then
strResult = "ERROR Finding Mailbox Name"
objDebug.writeln "ERROR Finding Mailbox Name" , 1
else ' Process Mailbox
objDebug.writeln " Mailbox : " & strMailbox, 0
call xmlWriter.WriteElementString("mailbox", strMailbox)
call xmlWriter.WriteElementString("homeserver", strHomeServer)
strResult = OpenMailbox(strHomeServer ,strMailbox, arrFeiertage) ' ---Ok lets add that to the mailbox ---
if (merker <> "") and not conSimulation then
objUser.Put MERKER, "Feiertagupdate:" & NOW() & " Alt:" & strmerker
objDebug.writeln " Writing MERKER:" & MERKER, 4
objUser.SetInfo
call xmlWriter.WriteElementString("merker", "OK")
objDebug.writeln " Writing MERKER: DONE", 4
end if
intReady = round(total / (objRecordSet.recordcount) * 100, 0)
ie.document.all("progress").innerHTML = _
"" & _
"Object: " & intReady & "% "& total &" / "& objRecordSet.recordcount
ie.document.all("runtime").innerHTML = formatdatetime(now() - dtstarttime ,0)
ie.document.all("endtime").innerHTML = formatdatetime(dtstarttime + (100 / (intReady+1))* cdbl(now - dtstarttime)) & " Estimated"
ie.document.all("mailbox").innerHTML = objRecordSet.Fields("distinguishedName")
end if
else
call xmlWriter.WriteElementString("merker", "SKIP")
end if
call xmlWriter.WriteElementString("result", strResult) ' ergebnis protokollieren
call xmlWriter.WriteEndElement ' of Object
objRecordSet.movenext
Loop
ie.document.all("detail").innerHTML = "" ' Clean IE Detail Output
ie.document.all("mailbox").innerHTML = "Finished"
call xmlWriter.WriteElementString("total", total)
objDebug.writeln "Total Mailboxes checked:" & total, 0
call xmlWriter.WriteElementString("totalread", totalread)
objDebug.writeln "# inspected:" & totalread, 0
call xmlWriter.WriteElementString("totalimport", totalimport)
objDebug.writeln "# Total Importiert:" & totalimport, 0
call xmlWriter.WriteElementString("totalerr", totalerr)
objDebug.writeln "# Error:" & totalerr, 0
call xmlWriter.WriteElementString("endtime", now())
ie.document.all("runtime").innerHTML = formatdatetime(now() - dtstarttime ,0)
ie.document.all("endtime").innerHTML = now()
call xmlWriter.WriteEndElement()
call xmlWriter.Close
set ie = nothing
wscript.quit(0)
function OpenMailbox (strHomeServer,strMail,arrEntries)
dim oMapiMessages, oMapiFolder, oMapiMessage, oMapiSession
dim oAppointmentItems, oAppointment, intTimezone
on error resume next
ie.document.all("detail").innerHTML = "" ' Clean IE Detail Output
newlogentry "Create MAPI Session", 3
Set oMapiSession = CreateObject("MAPI.Session")
if Err.Number <> 0 Then
objDebug.writeln " Error creating MAPI Session Skip Mailbox",1
OpenMailbox = "ERROR CDOObject"
totalerr = totalerr + 1
Exit function
End If
objDebug.writeln " Logon to mailbox " & objRecordSet.Fields("mail"), 0
newlogentry "Logon to Mailbox", 3
oMapiSession.Logon "", "", False, True, 0, true, strHomeServer & vbLF & strMail
if Err.Number <> 0 Then
objDebug.writeln " Error MAPI Logon",1
OpenMailbox = "ERROR MapiLogon"
totalerr = totalerr + 1
Exit function
end if
newlogentry " Getting Mailbox Timezone", 3
intTimezone = oMapiSession.GetOption("TimeZone")
if Err.Number <> 0 Then
objDebug.writeln " Error getting TimeZone",2
intTimezone = 0
OpenMailbox = "ERROR GetTimeZone"
totalerr = totalerr + 1
Exit function
end if
on error goto 0
if intTimezone = 3 then
objDebug.writeln " Current Mailbox Timezone:" & intTimezone,5
else
objDebug.writeln " updating Timzone OLD:" & intTimezone,5
if not conSimulation then
oMapiSession.SetOption "TimeZone", conTimezone
end if
end if
newlogentry " Get Calendar folder", 3
Set oMapiFolder = oMapiSession.GetDefaultFolder(CdoDefaultFolderCalendar) ' http://support.microsoft.com/kb/q180696/
if Err.Number <> 0 Then
objDebug.writeln " Error MAPI Get Calendar Folder",1
OpenMailbox = "ERROR MapiGetCalendarFolder"
totalerr = totalerr + 1
Exit function
end if
on error goto 0
objDebug.writeln "Calendar successful opened",0
newlogentry "Calendar successful opened", 3
if not conSimulation then
OpenMailbox = importappointments(oMapiFolder,arrEntries)
end if
totalread = totalread + 1
objDebug.writeln "Cleanup:Logoff from Mailbox ", 0
newlogentry "Cleanup:Logoff from Mailbox ", 3
oMapiSession.Logoff
objDebug.writeln "Cleanup: Releasing MAPI Session", 0
newlogentry "Cleanup: Releasing MAPI Session", 3
Set oMapiSession = Nothing
objDebug.writeln "Cleanup:MAPI-Session released", 0
newlogentry "Cleanup:MAPI-Session released", 3
end function
function importappointments(ofolder,arrTermine)
' Importiert die Termine in den Ordner, wenn noch nicht vorhanden
dim oAppointment, oAppointments, count, oAppointmentFilter
dim oAppointmentFilterField1, oAppointmentFilterField2, oAppointmentFilterField3
dim numimport, numskip
dim dictCal
set dictCal = createObject("Scripting.dictionary")
newlogentry "Import Appointments into Dictionary", 3
objDebug.writeln " Import Appointments", 0
Set oAppointments = ofolder.Messages ' Termine einlesen
for each oAppointment in oAppointments
'~ objDebug.writeln " Cal=" & oAppointment.subject & " at " & cdbl(oAppointment.starttime) ,5
'~ objDebug.writeln " New=" & arrTermine(0,count) &" at" & cdbl(cdate(arrTermine(1,count))) ,5
if not dictcal.Exists (oAppointment.subject & cdbl(oAppointment.starttime)) then
dictCal.add oAppointment.subject & cdbl(oAppointment.starttime) , 1 ' Terminbetreff und Zeit sind Schlüssel. Doppelte Termine ignorieren
else 'Possible duplicate Appointment
call xmlWriter.WriteElementString("duplicate", oAppointment.subject & " at " & cdbl(oAppointment.starttime))
end if
next
objDebug.writeln " Got " & dictCal.count & " Appointments", 0
call xmlWriter.WriteElementString("totalincal", dictCal.count)
numimport = 0 : numskip = 0
for count = 0 to ubound(arrTermine,2)
objDebug.writeln " Checking " & arrTermine(0,count) & " at " & arrTermine(1,count),5
if dictCal.exists( arrTermine(0,count) & cdbl(cdate(arrTermine(1,count)))) then
objDebug.writeln " Already existing:" & arrTermine(0,count) & " at " & arrTermine(1,count),5
newlogentry "Skip appointment:" & arrTermine(0,count) & " at " & arrTermine(1,count),4
call xmlWriter.WriteElementString("skip", arrTermine(0,count) & " at " & arrTermine(1,count))
numskip = numskip +1
else
objDebug.writeln " Import appointment:" & arrTermine(0,count) & " at " & arrTermine(1,count),5
newlogentry "Import appointment:" & arrTermine(0,count) & " at " & arrTermine(1,count),4
call xmlWriter.WriteElementString("import", arrTermine(0,count) & " at " & arrTermine(1,count))
'~ ' Termin anlegen http://msdn.microsoft.com/library/en-us/cdo/html/aa155812-5908-4304-a855-3e9199df252a.asp
set oAppointment = oAppointments.add
oAppointment.subject = arrTermine(0,count)
oAppointment.StartTime = arrTermine(1,count)
'~ oAppointment.EndTime = cdate(cdbl(cdate(arrTermine(1,count)))+1)
oAppointment.AllDayEvent = true
oAppointment.BusyStatus = 0 'http://msdn.microsoft.com/library/default.asp?URL=/library/en-us/cdo/html/49803859-dcc7-423a-9f2a-fa2357ead7e7.asp
oAppointment.Categories = array("Feiertag") 'http://msdn.microsoft.com/library/default.asp?URL=/library/en-us/cdo/html/84308137-3e82-4e2b-9db2-bab6cca8273d.asp
oAppointment.reminderset = false
oAppointment.Location = conLocation
oAppointment.update
set oAppointment = nothing
numimport = numimport +1
totalimport = totalimport + 1
end if
next
call xmlWriter.WriteElementString("numimport", numimport)
call xmlWriter.WriteElementString("numskip", numskip)
newlogentry "Import Appointments DONE", 3
objDebug.writeln "Import Appointments DONE", 0
importappointments = "OK"
end function
function loadappointment(filename)
' Load appointments into an array
const FOR_READING = 1
dim fs, file
dim arrLine, importtotal, header
dim arrAppointments()
call xmlWriter.WriteStartElement("source")
call xmlWriter.WriteElementString("filename", filename)
newlogentry "Loading Appointments from File", 3
Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.OpenTextFile(filename, FOR_READING)
objDebug.writeln " reading Header",5
header = file.readline() ' skip first line
call xmlWriter.WriteElementString("header", header)
importtotal = 0
Do until file.AtEndofLine
importtotal = importtotal + 1
objDebug.writeln " Importing Entry:" & importtotal,5
newlogentry "Loading Appointments " & importtotal, 3
call xmlWriter.WriteStartElement("entry")
arrLine = split (file.readline(), ",")
redim preserve arrAppointments (2,importtotal-1)
arrappointments(0,importtotal-1) = arrline(0)
arrappointments(1,importtotal-1) = arrline(1)
newlogentry "Cal: " & arrline(0) & " at " & arrline(1), 4
call xmlWriter.WriteElementString("subject", arrline(0))
call xmlWriter.WriteElementString("date", arrline(1))
call xmlWriter.WriteEndElement
Loop
call xmlWriter.WriteElementString("total", importtotal)
file.Close
call xmlWriter.WriteEndElement
loadappointment = arrappointments
end function
function GetHomeServer(dn)
' ermittelt den WINS-Namen des HomeServers aus dem HomeMDB-Feldformat
'z.B. CN=Postfachspeicher (SRV01),CN=Erste Speichergruppe,CN=InformationStore,CN=SRV01,CN=Servers,CN=AG1,CN=Administrative Groups,CN=MSXFAQ,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=msxfaq,DC=local
dim oHomeMDB, oHomeServer
objDebug.writeln " GetHomeServer für : " & dn, 5
set oHomeMDB = getobject("LDAP://" & replace(dn,"/","\/"))
set oHomeServer = getobject("LDAP://" & replace(oHomeMDB.get("msExchOwningServer"),"/","\/"))
objDebug.writeln " GetHomeServer is : " & oHomeServer.get("name"), 5
gethomeserver = oHomeServer.get("name")
end function
sub newlogentry(msg, level)
dim counter, s
objDebug.writeln " newlogentry: " & level & " - " & msg, 6
s = ""
for counter = 1 to level
s = s + "
"
next
s = s & msg
for counter = 1 to level
s = s + "
"
next
s = s & "
"
if level = 4 then
if ie.document.all("detail").innerHTML = "" then
ie.document.all("detail").innerHTML = msg
else
ie.document.all("detail").innerHTML = ie.document.all("detail").innerHTML & "
" & msg
end if
end if
if level <= 3 then ie.document.all("operation").innerHTML = msg
end sub
sub writexslt(strfilename)
dim txtxsl
txtxsl = _
"" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf & _
"feiertage Status" & vbcrlf & _
"" & vbcrlf & _
"feiertage Status
" & vbcrlf & _
"Parameters
" & vbcrlf & _
"" & vbcrlf & _
" Starttime | |
" & vbcrlf & _
" EndTime | |
" & vbcrlf & _
" Importierte Termine insgesamt | |
" & vbcrlf & _
" Mailboxen ohne Fehler | |
" & vbcrlf & _
" Mailboxen mit Fehler | |
" & vbcrlf & _
"
" & vbcrlf & _
"Details
" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf & _
" Mailbox: | " & vbcrlf & _
" Homeserver: | " & vbcrlf & _
" #Import | " & vbcrlf & _
" #Skip | " & vbcrlf & _
" Ergebnis | " & vbcrlf & _
"
" & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" | " & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" | " & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" | " & vbcrlf & _
" " & vbcrlf & _
" " & vbcrlf & _
" | " & vbcrlf & _
" " & vbcrlf & _
" | " & vbcrlf & _
" | " & vbcrlf & _
" " & vbcrlf & _
"
" & vbcrlf & _
"" & vbcrlf & _
"
" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf & _
"" & vbcrlf & _
" "
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 ==========================
function findGCPath
objDebug.write "Looking für GC"
dim oCont, oGC, strGCPath
Set oCont = GetObject("GC:")
For Each oGC In oCont
strGCPath = oGC.ADsPath
Next
objDebug.writeln "strGCPath=" & strGCPath, 5
findGCPath = strGCPath
end function
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 "" & vbcrlf
End Property
public Property let Indentation(wert)
intIndentation = wert
End Property
sub Writestylesheet (item)
'*
xmlfile.write "" & 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ä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) ' - wert
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 ,"&","&")
tempwert=replace(tempwert ,"<","<")
tempwert=replace(tempwert ,">",">")
tempwert=replace(tempwert ,"""",""")
tempwert=replace(tempwert ,"'","'")
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 "