'mbFileMail2.vbs

'FullName:	mbFileMail.vbs
'Autor:		mb
'Datum:		11.08.1997
'Version:	0.1.a

'Funktion:	.

'Zweck:		.

'To-Do:		.

'===========================================================================================
'Dieses Beispiel-Script sendet eine Mail an den Benutzer "SENL".
'SENL=SentEventNotificationLog ist eine persönliche Verteilerliste
'im Profile "IUSR_M1" (IUSR_M1="Internet Information Server").

'Das Profile muß so konfiguriert sein, daß der Benutzer sich ohne
'Angabe eines Kennwortes einloggen kann. Es wird der Default-Benutzer
'des Profiles verwendet. Der Postoffice-Account kann demnach frei
'gewählt werden.

'Dieses Script wird mittels Scheduler-Service ausgefuehrt. Deshalb
'muss ".VBS" im Scheduler-Benutzer-Kontext registriert sein. Ebenso
'muss dieser Benutzer ein Profile "IUSR_M1" konfiguriert haben.


Option Explicit


Dim	Usr
Dim	Pwd
Dim	Subj
Dim	Msg

Dim	oSH
Dim	oFSO
Dim	oArgs

Dim	AppName
Dim	rtc
Dim	DoDeleteFile
Dim	MailFileName

Dim	gEnvMode			'INTERACTIVE/BATCH
Dim	gEnvOS				'Operating System
Dim	gAppStartTime			'Startzeit des Scripts.


AppName = "mbFileMail"		'Name dieser Anwendung.
rtc = 1				'Default ist Error (=1; 0=OK)
Usr = "IUSR_M1"			'User fuer die Funktion SendMail.
Pwd = ""			'Pwd fuer die Funktion SendMail.
Msg = ""			'Initialize message var.
DoDeleteFile = True		'Normalerweise wird die zu mailende Datei hinterher geloescht.
MailFileName = ""		'Wird durch Argument 0 ersetzt.

Set oSh = WScript.CreateObject("WScript.Shell")
Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oArgs = WScript.Arguments	'Use build-in-object


GetEnvironment		'Ermittelt z. Zt. nur, ob das Programm interaktiv oder im Batch laeuft.
SignOn			'Verwendet bereits die von "GetEnvironment" ermittelten Werte !!


If oArgs.Count = 0 Then
	AppMsg "Keine Programmargumente angegeben!"
	Help
Else
	'Program code goes here.
	If (oArgs.Count = 2) Or (oArgs.Count = 3) Then
		'Alle Parameter sind da, an die Arbeit!

		'Wenn ein dritter Parameter angegeben ist, wird nur "/NODELETE"
		'akzeptiert. Die Schreibweise spielt keine Rolle.
		If oArgs.Count = 3 Then
			If UCase(oArgs(2)) = "/NODELETE" Then DoDeleteFile = False
		End If
		MailFileName = oArgs(0)
		If oFSO.GetFileName(MailFileName) = MailFileName Then
			'Kein Pfadname im Dateinamen angegeben. Versuche es durch
			'Hinzufuegen des aktuellen Verzeichnisses:
			MailFileName = oFSO.GetAbsolutePathName(".") & "\" & MailFileName
		End If
		If oFSO.FileExists(MailFileName) Then
			If GetMsgFromMailFile(MailFileName, Msg) Then
				rtc = SendMail(Usr, Pwd, oArgs(1), Msg)
				On Error Resume Next
				If DoDeleteFile Then
					oFSO.DeleteFile(MailFileName)
					If Err <> 0 Then
						AppMsg "Datei " & MailFileName & " konnte nicht gelöscht werden!"
						Err.Clear
						rtc = 1
					Else
						AppMsg "Die Datei " & MailFileName & " wurde gelöscht."
					End If
				Else
					AppMsg "Die Datei " & MailFileName & " wurde nicht gelöscht."
				End If
				On Error Goto 0
			Else
				AppMsg "Angegebene Datei ist leer oder kann nicht gelesen werden!"
			End If
		Else
			AppMsg "Angegebene Datei " & MailFileName & " existiert nicht!"
		End If

	Else	'Parameterfehler!
		AppMsg "Zu wenige / zu viele Programmargumente angegeben!"
		Help
	End If
End If


'Wieder Aufraeumen:
SignOff
DelEnvironment


'Release all objects:
Set oSh = Nothing
Set oFSO = Nothing
Set oArgs = Nothing

WScript.Quit(rtc)



'=== +++ subs +++ ======================================================

'=== +++ lcl subs +++ ==================================================

Function SendMail(aUsr, aPwd, aSubj, aMsg)

	'Diese Funktion versendet die eigentliche Mail. Sie liefert
	'TRUE zurueck wenn alles klappt, sonst FALSE. Sie gibt eigene
	'Fehlermeldungen aus und verwendet dazu "AppMsg".

	Dim	objOneRecip
	Dim	objMessage
	Dim	objSession
	Dim	showDialog

	Dim	rtc


	On Error Resume Next

	rtc = 1		'Default-Returnkode ist ERROR(1; 0=OK)


	'Create a session and log on -- username and password in profile 
	Set objSession = WScript.CreateObject("MAPI.Session") 
	If Not Err <> 0 Then
		AppMsg "Das Session Object wurde erstellt."
	Else
		AppMsg "Fehler beim Erstellen des Session Objects, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	'Hier werden Funktionsparameter zum Logon benutzt:
	objSession.Logon aUsr, aPwd, False, True, 0, False
	If Not Err <> 0  Then
		AppMsg "Der Benutzer wurde eingeloggt."
	Else
		AppMsg "Der Benutzer konnte nicht eingeloggt werden, Nr=" & Err.Number & ", Text=" & Err.Description
	End If

 	'create a message and fill in its properties 
	Set objMessage = objSession.Outbox.Messages.Add 
	If Not Err <> 0  Then
		AppMsg "Das Message Object wurde erstellt."
	Else
		AppMsg "Das Message Object konnte nicht erstellt werden, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	'Hier werden die Funktionsparameter benutzt:
	objMessage.Subject = aSubj
	objMessage.Text = aMsg


	'create the recipient 
	Set objOneRecip = objMessage.Recipients.Add 
	If Not Err <> 0  Then
		AppMsg "Das Empfaenger Object wurde erstellt."
	Else
		AppMsg "Das Empfaenger Object konnte nicht erstellt werden, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	objOneRecip.Name = "SENL" 
	objOneRecip.Type = 1		'ActMsgTo 
	objOneRecip.Resolve 		'get MAPI to determine complete e-mail address 
	If Not Err <> 0  Then
		AppMsg "Die Empfaengeradresse konnte 'aufgeloest' werden."
	Else
		AppMsg "Die Empfaengeradresse konnte nicht 'aufgeloest' werden, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	objMessage.Update 
	If Not Err <> 0  Then
		AppMsg "Das Message Object konnte aktualisiert werden."
	Else
		AppMsg "Das Message Object konnte nicht aktualisiert werden, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	'send the message and log off 
	objMessage.Send showDialog = False
	If Not Err <> 0  Then
		AppMsg "Die Mail wurde gesendet."
	Else
		AppMsg "Die Mail wurde nicht gesendet, Fehler, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	'Deliver the mail:
	objSession.DeliverNow()


	objSession.Logoff 
	If Not Err <> 0  Then
		AppMsg "Der Benutzer wurde abgemeldet."
	Else
		AppMsg "Der Benutzer konnte nicht abgemeldet werden, Fehler, Nr=" & Err.Number & ", Text=" & Err.Description
	End If


	'Alle Objektreferenzen loeschen:
	Set objOneRecip = Nothing
	Set objMessage = Nothing
	Set objSession = Nothing

	rtc = 0	'Dummy-OK
	SendMail = rtc

End Function	'SendMail


Function GetMsgFromMailFile(aFileName, aMsg)

	'Diese Funktion liesst den gesamten Text der in "aFileName"
	'angegebenen Datei in die Variable "aMsg" ein. Sie liefert TRUE
	'zurueck wenn alles klappt, sonst FALSE.

	'ACHTUNG: Das FileSystemObject muss bereits erstellt sein und die
	'Datei muss existieren.

	Dim	rtc, oTS

	On Error Resume Next

	rtc = True	'Default ist kein Fehler(True; Fehler=False).

	'Lies den ganzen Mist auf einen Schlag ein:
	Set oTS = oFSO.OpenTextFile(aFileName, 1, False)
	If Err <> 0 Then
		rtc = False
		aMsg = ""
	Else
		aMsg = oTS.ReadAll
		oTS.Close
	End If

	Set oTS = Nothing
	GetMsgFromMailFile = rtc

End Function


Sub Help

	PutCon ""
	PutCon ""
	PutCon "HELP (für " & AppName & ")"
	PutCon ""
	PutCon "FileMail versendet Dateien als Mail."
	PutCon ""
	PutCon "Parameter1 ist der Dateiname, der Datei, die"
	PutCon "versendet werden soll; Parameter2 ist das Subject"
	PutCon "der zu versendenden Mail."
	PutCon "Ohne diese Parameter kann die Mail nicht versendet werden."
	PutCon ""
	PutCon "FileMail sendet immer an die Verteilerliste SENL des"
	PutCon "verwendeten Mail Benutzers (APM)."
	PutCon ""
	PutCon "Als Zusatzargument (Parameter3) kann '/NODELETE' angegeben werden."
	PutCon "Die zu versendende Datei wird dann ansachliessend nicht geloescht."
	PutCon ""

End Sub

'=== --- lcl subs --- ==================================================

'=== +++ gbl subs +++ ==================================================

Sub GetEnvironment

	'Ermittelt die Arbeitsumgebung des Programmes. Z. Zt. wird nur
	'festgestellt, ob es im Batch oder Interaktiv laeuft. Das wird
	'an Hand der Environment-Variablen "TEMP" festgestellt. Sie existiert
	'nur fuer interaktiv eingeloggte Benutzer aber auch nur im
	'Prozess Environment!
	'Der Parameter "WScript.Interactive" funktioniert NICHT!!

	'Die Ergebnisse werden in den globalen Variablen "gEnvMode", "gEnvOS"
	'zurueckgeliefert.

	Dim	oShell
	Dim	oEnvPrc
	Dim	oEnvSys

	Set oShell = WScript.CreateObject("WScript.Shell")
	Set oEnvPrc = oShell.Environment("Process")
	Set oEnvSys = oShell.Environment("System")

	gEnvOs = oEnvSys.Item("OS")
	If oEnvPrc.Item("TEMP") = "" Then
		gEnvMode = "BATCH"
	Else
		gEnvMode = "INTERACTIVE"
	End If

	gAppStartTime = Now()

	'Release Objects:
	Set oShell = Nothing
	Set oEnvPrc = Nothing
	Set oEnvSys = Nothing

End Sub


Sub DelEnvironment

	'Raeumt wieder auf. Noch Entwursfstadium. Nach dem Ausfuehren
	'dieser Prozedur stehen die ueblichen Objekte und Methoden
	'nicht mehr zur Verfuegung!!!

	'Nicht implementiert.

End Sub


Sub AppMsg(aString)

	'Diese Prozedur vereinfacht die Ausgabe eines Strings auf die Console.
	'Dabei wird zusaetzlich zum String immer der Anwendungsname angegeben.

	WScript.Echo AppName & ":" & aString

End Sub


Sub PutCon(aString)

	'Diese Prozedur vereinfacht die Ausgabe eines Strings auf die Console.

	WScript.Echo aString

End Sub


Sub SignOn

	'Diese Prozedur zeigt die Runtime Umgebung und alle
	'Scriptparameter an. Das volle Script-Environment
	'steht hier noch nicht zur Verfügung (Es muss deshalb
	'PutCon anstatt AppMsg verwendet werden).

	Dim	oWScript
	Dim	oArgs
	Dim	i

	'Get application object.
	Set oWScript = WScript.Application

	'Show standard properties
	PutCon "Application Name            : " & oWScript.Name
	PutCon "Application Version         : " & oWScript.Version
	PutCon "Application Context         : " & oWScript.FullName
	PutCon "Application Execution Mode  : " & gEnvMode	'oWScript.Interactive
	PutCon "Application Script Name     : " & oWScript.ScriptFullName
	PutCon "Application Hosting OS      : " & gEnvOS
	PutCon "Application Execution Time  : " & Now()

	'Show command line arguments
	Set oArgs = oWScript.Arguments
	For i = 0 to oArgs.Count - 1
		PutCon "Application Argument     #" & i & " : " & oArgs(i) & " "
	Next

	PutCon ""

	'Release Objects:
	Set oWScript = Nothing
	Set oArgs = Nothing

End Sub


Sub SignOff

	'Diese Prozedur zeigt zum Schluss die Laufzeit an.
	'Das volle Script-Environment steht hier nicht mehr zur
	'Verfügung (Es muss deshalb PutCon anstatt AppMsg verwendet
	'werden).

	PutCon ""
	PutCon "Application Run Time        : " & "         " & FormatDateTime(Now() - gAppStartTime, vbLongTime)
	PutCon "Application Exit Time       : " & Now()

End Sub

'=== --- gbl subs --- ==================================================

'=== --- subs --- ======================================================