Ich habe heute noch ein wenig gebastelt und den Code weiter eingedampft. Den meisten Platz nimmt das Error Handling ein.
Im Agenten wird sich letztendlich nur noch ein 2-Zeiler finden
Dim engine As New EscalationEngine
Call engine.Run
Neben den Constructor gibt es nur noch eine Methode "Run"; der Rest wird in der Klasse "EscalationEngine" abgefackelt.
Ich weiss, ist noch nicht vollständig, soll auch nur einen ersten Eindruck vermitteln.
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Public Class EscalationEngine
'///////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////
Private pCol As NotesDocumentCollection
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/* CONSTRUCTOR
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub New ()
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set pCol = s.CurrentDatabase.Search ({@UpperCase(Form) = "NOTIFICATION PROFILE" & nStatus = "1"} , dt, 0 )
EXITPOINT:
Exit Sub
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Sub
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function TicketCollection ( idx As Integer ) As NotesDocumentCollection
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Set TicketCollection = s.CurrentDatabase.Search (Me.pCol.GetNthDocument ( idx ).nFormula(0) , dt, 0 )
EXITPOINT:
Exit Function
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Function
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function Recipients ( idx As Integer ) As Variant
On Error Goto ERRHANDLE
Recipients = Me.pCol.GetNthDocument ( idx ).nFirstEscalationSendTo
EXITPOINT:
Exit Function
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Function
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Function SetField ( idx As Integer ) As Variant
On Error Goto ERRHANDLE
SetField = Me.pCol.GetNthDocument ( idx ) .nStampAll
EXITPOINT:
Exit Function
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Function
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Private Sub StampAll ( idx As Integer )
On Error Goto ERRHANDLE
Dim s As New NotesSession
Dim dt As New NotesDateTime(Cstr(Datenumber(2004, 5, 1)))
Dim varStampValues As Variant
Dim strFieldToStamp As String
Dim strStampFieldWith As String
Dim strAtAdjust As Variant
Dim strColDocFieldFound As String
Dim atNow As New NotesDateTime( Now )
Dim thisdate As New NotesDateTime("")
Call thisdate.setnow
Dim col As NotesDocumentCollection
Set col = Me.TicketCollection ( idx )
varStampValues = Me.SetField ( idx )
If Trim ( varStampValues (0) ) ="" Then
Exit Sub ' nothing to do; let's get outa here
Else
strColDocFieldFound = Left$ ( strStampFieldWith , 2 ) ' <<TAG>>
Forall v In varStampValues
strFieldToStamp = Trim(Strtoken ( Cstr ( v ) , "|" , 1 ))
strStampFieldWith = Trim(Strtoken ( Cstr ( v ) , "|" , 2 ))
If Left$ ( strStampFieldWith , 1 ) = "@" Or strColDocFieldFound = "<<" Then
If Instr ( Ucase ( strStampFieldWith ) , "@ADJUST") Then
strAtAdjust = Split ( strStampFieldWith , ";")
strStampFieldWith = Left ( Ucase ( strStampFieldWith ) , 7 )
End If
Select Case Ucase ( strStampFieldWith )
Case "@NOW"
strStampFieldWith = Cstr(Now)
Case "@DATE(@NOW)"
strStampFieldWith = Cstr(atNow.DateOnly)
Case "@TIME(@NOW)"
strStampFieldWith = Cstr(atNow.TimeOnly)
Case "@ADJUST"
Call thisdate.AdjustYear( Cint(strAtAdjust(1)) )
Call thisdate.AdjustMonth( Cint(strAtAdjust(2)) )
Call thisdate.AdjustDay( Cint(strAtAdjust(3)) )
Call thisdate.AdjustHour( Cint(strAtAdjust(4)) )
Call thisdate.AdjustMinute( Cint(strAtAdjust(5)) )
Call thisdate.AdjustSecond( Cint(Left(strAtAdjust(6),1)) )
strStampFieldWith = Cstr(thisdate.LocalTime)
End Select
End If
End Forall
End If
EXITPOINT:
Exit Sub
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
End Sub
%REM
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
%END REM
Public Sub Run
' put stuff here
Me.StampAll ( 1 )
End Sub
End Class
und wer eine Idee hat, wie man das immer wiederkehrende
EXITPOINT:
Exit Sub
ERRHANDLE:
xProc = Getthreadinfo(LSI_THREAD_PROC)
xError = xProc & ": " &Trim$(Str$(Err)) & " on line " & Cstr(Erl) & ": " & Error$
If UseOpenLog Then
Call LogError
Elseif LogScriptErrors Then
Call ThrowException ( xProc, xError )
End If
Print xError 'In all cases
If ResumeMethodNext Then
Resume Next
Else
Resume EXITPOINT
End If
ersetzen kann, ohne den Fokus auf die Routine zu verlieren, der möge das bitte hier posten ...
Ich finde es übrigens klasse, daß der ScriptParser ein Konstrukt wie
Set TicketCollection = s.CurrentDatabase.Search (Me.pCol.GetNthDocument ( idx ).nFormula(0) , dt, 0 )
umsetzen kann.
ein
If IsEmpty ( varStampValues) Then
Exit Sub ' nothing to do; let's get outa here
funktioniert nicht. Oder bin ich da auf dem falschen Dampfer ? Ich dachte, IsEmptry prüft, ob ein Variant leer ist ...
Thema: Änderungen und Fixes im nächsten point Release 1.5.1 von !!Help!! (Gelesen 14691 mal)