Option Explicit
'-------------------------------------------------------------------------
' smtpclient 1.2
'
' Beschreibung
' Konsolidiert alle IP-Verbindungen zum virtuellen SMTP-Server
'
' Laufzeitfehler werde nicht abgefangen und beenden das Skript. !!!
'
' Das Skript liest alle Textdateien ex*.log im angegebenen Verzeichnis
' Addiert das Auftreten des dritten feldes auf
'
' (c)2005 Net at Work Netzwerksysteme GmbH
'
' Version 1.2 (02. Sep 2005) Frank Carius
'	Debugausgabe XML-Pfad
' Version 1.1 (02. Sep 2005) Frank Carius
'	CINT Überlauf bei der Anzeige ->clng
' Version 1.0 (19. Sep 2005) Frank Carius
'	Initial Release
'-------------------------------------------------------------------------

const ForReading = 1
const TristateUseDefault = -2

Dim key, totalhosts, totalfiles, totallines, totalfilesprocessed, totalfilesread
Dim strOutFilePrefix, strLine, strSMTPClientIP
Dim objDebug, xmlwriter, objFSO, objFolder, objFiles, objFile,objTXTFile
Dim dictSMTPClient

strOutFilePrefix = makefilename("smtpclient-" & 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 "smtpclient: gestartet", 0


if WScript.Arguments.Count <> 1 then 
	objDebug.writeln "smtpclient: Bitte Pfadname angeben", 0
	wscript.quit(1)
end if

set xmlWriter = new XmlTextWriter
xmlWriter.filename = strOutFilePrefix & ".xml"
objDebug.writeln "XML Outfile: " & strOutFilePrefix & ".xml", 0
xmlWriter.Indentation = 4
call xmlWriter.WriteStylesheet("smtpclient.xsl")
call writexslt("smtpclient.xsl")
call xmlWriter.WriteStartElement("smtpclient")
call xmlWriter.WriteElementString("starttime", now())

Set objFSO = CreateObject("Scripting.FileSystemObject")

'Set objFolder = objFSO.GetFolder("C:\fcarius\script\smtpclient")
Set objFolder = objFSO.GetFolder(WScript.Arguments(0))

objDebug.writeln "Processing Folder: " & objfolder.path, 0
Set objFiles = objFolder.Files
'objDebug.writeln "Total files found: " & objfolder.count, 0
Set dictSMTPClient = CreateObject("Scripting.Dictionary")
totalfiles = 0 : totalfilesprocessed = 0 :  totallines = 0
for each objfile in objfiles 
	totalfiles = totalfiles + 1
	objDebug.writeln "Check file: " & objfile.name, 0
	if (right(objfile.name,4) = ".log") and (left(objfile.name,2) = "ex") then
		objDebug.writeln "  Reading", 0
		totalfilesprocessed = totalfilesprocessed + 1
		Set objTXTFile = objfile.OpenAsTextStream(ForReading, TristateUseDefault)
		'objFSO.OpenTextFile(objfile.name, 1)
		Do until objTXTFile.AtEndOfStream
			strLine = objTXTFile.Readline()
			totallines = totallines + 1
			if (left(strline,1)<> "#")and (strline <> "") and (ubound(split(strLine," ")) =>2) then 
				strSMTPClientIP = split(strLine," ")(2)
				if ubound(split(strSMTPClientIP,".")) <> 3 then
					objDebug.writeln "  ERROR: ungültige IP-Adresse:" & strSMTPClientIP, 1
				else
					objDebug.writeln "  Add :""" & strSMTPClientIP & """", 0
					wscript.echo "Alt:" & dictSMTPCLient.item(strSMTPClientIP) 
					dictSMTPCLient.item(strSMTPClientIP) = clng(dictSMTPCLient.item(strSMTPClientIP)) + 1
				end if
			end if
		Loop
	else
		objDebug.writeln "  Skip. File not ex*.LOG", 0
	end if
next

totalhosts = 0
for each key in dictSMTPCLient.keys 
	totalhosts = totalhosts +1
	objDebug.writeln "SMTPCLient:" & key & "=" & dictSMTPCLient.Item(key),0
	call xmlWriter.WriteStartElement("host")
	call xmlWriter.WriteElementString("IP", key)
	call xmlWriter.WriteElementString("count", dictSMTPCLient.Item(key))
	call xmlWriter.WriteEndElement()   ' of ("host")		
Next


call xmlWriter.WriteElementString("totalhosts", totalhosts)
objDebug.writeln "Total Hosts found:" & totalhosts, 0
call xmlWriter.WriteElementString("totalfiles", totalfiles)
objDebug.writeln "Total Files found:" & totalfiles, 0
call xmlWriter.WriteElementString("totalfilesprocessed", totalfilesprocessed)
objDebug.writeln "Total Files processed:" & totalfilesprocessed, 0
call xmlWriter.WriteElementString("totallines", totallines)
objDebug.writeln "Total lines processed:" & totallines, 0
call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("smtpclient")
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>SMTPClient Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>smtpclient Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""smtpclient""> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Starttime</th><td><xsl:value-of select=""starttime"" /></td></tr>" & vbcrlf & _
		"	<tr><th>EndTime</th> <td><xsl:value-of select=""endtime"" /></td></tr>" & vbcrlf & _
		"	<tr><th># File found</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalfiles""/></td></tr>" & vbcrlf & _
		"	<tr><th># Files processed</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totalfilesprocessed""/></td></tr>" & vbcrlf & _
		"	<tr><th># Lines processed</th><td bgcolor=""#FFFFFF""> <xsl:value-of select=""totallines""/></td></tr>" & vbcrlf & _
		"	<tr><th># Hosts found</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totalhosts"" /></td></tr>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"<h2>SMTP Clients</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>IP-Address</th> " & vbcrlf & _
		"	<th>Total commands</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""smtpclient/host""> " & vbcrlf & _
		"	<xsl:sort select=""IP"" data-type=""text"" order=""descending""/>" & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""IP"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""count"" /> " & 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=""
		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

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