| %REM |
| Agent CalendarTasks |
| Aufruf: |
| CalenderTasks |
| Aktion (del / neu) del = Eintrag löschen, neu = neuer Eintrag |
| Datenbank Name der Datenbank z.B. kschroede.nsf |
| Server Name des Mailservers z.B. JKMAIL00/SRV/JK-Group |
| Typ (2 / 4) Abwesenheitsart (2 = mit belegt, 4 = nur als Info) |
| Datum von |
| Datum bis |
| uniqueid Eindeutige ID, erzeugt vom Intranet |
| Text Anzeigetext im Kalender (z.B. Urlaub von Knud) |
| %END REM |
| Sub Initialize |
| Dim s As New NotesSession |
| Dim db As NotesDatabase |
| Dim col As NotesDocumentCollection |
| Dim doc As NotesDocument |
| Dim view As NotesView |
| Dim vc As NotesViewEntryCollection |
| Dim arg As String, p1 As Long |
| Dim argarray As Variant |
| Dim counter As Integer |
| Dim argdb As String |
| Dim argserver As String |
| Dim argaction As String |
| Dim argvdat As String |
| Dim argbdat As String |
| Dim argtype As String |
| Dim arguid As String |
| Dim argtext As String |
| Dim vdate As NotesDateTime |
| Dim bdate As NotesDateTime |
| |
| On Error GoTo ErrHandler |
| |
| Set doc = s.DocumentContext |
| Dim qs As String |
| qs = doc.query_string(0) |
| If doc.HasItem("Request_Content") Then |
| qs=qs & "&" |
| ForAll aContent In doc.Request_Content |
| qs=qs & aContent |
| End ForAll |
| End If |
| |
| arg = qs |
| p1 = InStr(arg, "&") |
| If p1 = 0 Then ' kein Parameter angegeben? |
| Print "Error 1: keine Parameter übergeben!" |
| Exit Sub |
| End If |
| arg = Mid$(arg, p1 + 1) ' alle Parameter aus der URL extrahieren |
| |
| argarray = Split(arg,"&") ' jeden Parameter trennen und in Array speichern |
| |
| If s.DocumentContext.remote_addr(0) <> "10.1.20.23" Then |
| Print "Error 2: dieser Aufruf ist nicht End Ift!" |
| Exit Sub |
| End If |
| |
| argaction = argarray(0) |
| argdb = argarray(1) |
| argserver = argarray(2) |
| argtype = argarray(3) |
| argvdat = argarray(4) |
| argbdat = argarray(5) |
| arguid = argarray(6) |
| argtext = urlDecode(argarray(7)) |
| |
| If argaction = "del" Then |
| Dim calsubj As String |
| Dim calbody As String |
| Dim calvdat As String |
| Dim calbdat As String |
| Dim searchformula As String |
| Dim docid As String |
| Dim dummydoc As NotesDocument |
| Dim xflag As Boolean |
| |
| Set db = s.GetDatabase(argserver, argdb, False) |
| If Not db.IsOpen Then Call db.Open("", "") |
| Set view = db.GetView("Calendar") |
| |
| Set vdate = New NotesDateTime(argvdat) |
| Set vdate = New NotesDateTime (vdate.DateOnly) |
| |
| searchformula = {Form = "Appointment" & @Begins(@Text(StartDate);"} & argvdat & {")} |
| Set col = db.search(searchformula,Nothing,0) |
| |
| Set doc = col.GetFirstDocument |
| xflag = False |
| While Not(doc Is Nothing) And xflag = false |
| calvdat = CStr(doc.GetItemValue("StartDate")(0)) |
| calbdat = CStr(doc.GetItemValue("EndDate")(0)) |
| calbody = doc.GetItemValue("Body")(0) |
| If InStr(calbody,arguid) > 0 Then ' Lösch-ID suchen |
| If calvdat = argvdat Then |
| If calbdat = argbdat Then |
| Print "Eintrag wurde entfernt" |
| Set dummydoc = doc |
| Set doc = col.GetNextDocument(doc) |
| Call dummydoc.Remove (True) |
| xflag = True |
| End If |
| End If |
| End If |
| If xflag = False Then |
| Set doc = col.GetNextDocument(doc) |
| End If |
| Wend |
| End If |
| |
| If argaction = "neu" Then |
| Dim starttime As String |
| Dim endtime As String |
| Dim startDate As Variant |
| Dim endDate As Variant |
| Dim aExcludeView(1) As String |
| Dim cprofile As NotesDocument |
| Dim mailowner As String |
| Dim vDates As Variant |
| Dim iLoop As Integer |
| |
| Dim atCSWISL (0 To 4) As String |
| atCSWISL(0)="$S:1" |
| atCSWISL(1)="$L:1" |
| atCSWISL(2)="$B:1" |
| atCSWISL(3)="$R:1" |
| atCSWISL(4)="$E:1" |
| |
| Dim atWatched (0 To 4) As String |
| atWatched(0)="$S" |
| atWatched(1)="$L" |
| atWatched(2)="$B" |
| atWatched(3)="$R" |
| atWatched(4)="$E" |
| |
| aExcludeView(0) = "D" |
| aExcludeView(1) = "S" |
| |
| starttime = "07:00:00" |
| endtime = "20:00:00" |
| |
| Set db = s.GetDatabase(argserver, argdb, False) |
| |
| If Not db.IsOpen Then Call db.Open("", "") |
| |
| Set cprofile = db.GetProfileDocument("CalendarProfile") |
| mailowner = cprofile.GetItemValue("Owner")(0) |
| |
| Set view = db.GetView("Calendar") |
| |
| startdate = CDat(argvdat) |
| enddate = CDat(argbdat) |
| |
| Set doc = db.Createdocument() |
| docid = doc.UniversalID |
| doc.form = "Appointment" |
| doc.Subject = argtext |
| doc.Location = " " |
| doc.SequenceNum = "1" |
| |
| doc.StartDate = startdate |
| doc.StartTime = startdate |
| doc.StartDateTime = startdate |
| doc.EndDate = enddate |
| doc.EndTime = enddate |
| doc.EndDateTime = enddate |
| |
| iLoop = enddate - startdate |
| ReDim vDates (0 To iLoop) |
| |
| vDates (0) = startdate |
| For iLoop = 1 To UBound (vDates) |
| vDates (iLoop) = startdate + iLoop |
| Next |
| |
| doc.CalendarDateTime = vDates |
| |
| doc.Repeats = "1" |
| doc.RepeatFor = iLoop |
| doc.RepeatHow = "F" ' U=repeat until, F=repeat for |
| doc.RepeatForUnit = "D" ' repeat in days (W=weekly,M=monthly,Y=yearly) |
| doc.RepeatWeekends = "D" ' Do nothing if on a weekend |
| doc.RepeatUnit = "D" |
| doc.RepeatInterval = "1" ' dayly |
| doc.RepeatAdjust = "1" ' only used if weekly or monthly |
| doc.RepeatStartDate = startdate |
| doc.RepeatDates = vDates |
| |
| doc.ExcludeFormView = aExcludeView |
| doc.MeetingType = "1" |
| |
| doc.AppointmentType = argtype |
| doc.MessageType = "Not a draft" |
| doc.Logo = "StdNotesLtr3" |
| doc.OrgTable = "P0" |
| doc.SchedulerSwitcher = "1" |
| doc.Notes = "" |
| doc.Body = "Erzeugt durch den Urlaubsplaner im Intranet.**ID=" & arguid & "**" |
| doc.~_ViewIcon = "9" |
| doc.EndTimeZone = "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=71$ZN=W. Europe" |
| doc.StartTimeZone = "Z=-1$DO=1$DL=3 -1 1 10 -1 1$ZX=71$ZN=W. Europe" |
| doc.UpdateSeq = 1 |
| doc.WebDateTimeInit = 1 |
| doc.~$AlarmDiabled = "1" |
| doc.~$PublicAccess = "1" |
| |
| doc.~$CSWISL = atCSWISL |
| doc.~$WatchedItems = atWatched |
| doc.~$CSFlags = "m" |
| doc.OrgRepeat = "1" |
| doc.~$CSVersion = "2" |
| |
| doc.Chair = mailowner |
| doc.AltChair = mailowner |
| doc.From = mailowner |
| doc.Principal = mailowner |
| |
| If argtype = "2" Then |
| doc.BookFreeTime = "0" |
| doc.~$BusyName = mailowner |
| doc.~$BusyPriority = "1" |
| End If |
| doc.ApptUNID = docid |
| |
| Call doc.Save( True, True ) |
| Print "Eintrag wurde erstellt" |
| End If |
| ErrResume: |
| Exit Sub |
| ErrHandler: |
| Print "** CalendarTasks ** Error occured " & Str(Err) & ": " & Error$ & " in line " & Str(Erl) & ". Agent stopped." |
| Print argdb & " " & argserver & " " & argvdat & " " & argbdat |
| Resume ErrResume |
| End Sub |
| |
| Public Function urlDecode(s As String) As String |
| If Len(s) = 0 Then Exit Function |
| Dim i As Integer |
| Dim tmp As String |
| Dim c As String |
| For i = 1 To Len(s) |
| c = Mid$(s, i, 1) |
| If c = "+" Then c = " " |
| If c = "%" Then |
| c = Chr$("&H" + Mid$(s, i + 1, 2)) |
| i = i + 2 |
| End If |
| tmp = tmp + c |
| Next i |
| urlDecode = tmp |
| End Function |