Imports System.Data.SqlClient Public Class cAuditFlow ''' ''' Erzeugt alle fälligen Prüfungen ab dem gegebenen Startdatum. ''' Unterstützt sowohl Intervall-basierte als auch einmalige Prüfobjekte. ''' Berücksichtigt das Enddatum und Erinnerungsvorlauf jedes Prüfobjekts. ''' ''' Datum, ab dem fällige Prüfungen nachträglich berechnet werden sollen Public Shared Sub ErzeugeFaelligePruefungen(vonDatum As Date) Dim pruefobjekte = cAuditFlow_Pruefobjekte.LoadAllAktiv() Dim heute As Date = Date.Today For Each obj In pruefobjekte ' Intervalltyp ermitteln (immer in Großbuchstaben, Leerzeichen entfernt) Dim intervallTyp As String = If(obj.wartPO_IntervallTyp, "").Trim().ToUpper() ' Erinnerungsvorlauf ermitteln Dim vorlauf As Integer = obj.wartPO_Erinnerung_VorlaufInTagen ' Enddatum aus Datenbank (leer = unbegrenzt) Dim dbEndDatum As Date = If(obj.wartPO_enddatum > Date.MinValue, obj.wartPO_enddatum, Date.MaxValue) ' System-Enddatum = heute + Vorlauf (aber max. bis zum definierten Enddatum) Dim systemEndDatum As Date = heute.AddDays(vorlauf) Dim endDatum As Date = If(systemEndDatum <= dbEndDatum, systemEndDatum, dbEndDatum) ' Startdatum zur Prüfung: das spätere von vonDatum oder Startdatum aus DB Dim startDatum As Date = If(vonDatum > obj.wartPO_startdatum, vonDatum, obj.wartPO_startdatum) ' Wenn Startdatum bereits hinter dem Enddatum liegt → überspringen If startDatum > endDatum Then Continue For ' === EINMALIGE PRÜFUNG === If intervallTyp = "EINMALIG" Then Dim faellig As Date = obj.wartPO_startdatum If faellig >= startDatum AndAlso faellig <= endDatum Then If Not cAuditFlow_Pruefungen.ExistiertBereits(obj.wartPO_Id, faellig) Then Dim einmaligePruefung As New cAuditFlow_Pruefungen With { .wartPruef_wartPOId = obj.wartPO_Id, .wartPruef_Faelligkeitsdatum = faellig, .wartPruef_Erledigung = False, .wartPruef_Bemerkung = "Einmalige Prüfung" } einmaligePruefung.SAVE() End If End If Continue For End If ' === WIEDERKEHRENDE PRÜFUNG === If Not obj.wartPO_IntervallWert.HasValue Then Continue For Dim laufDatum As Date = startDatum Do While laufDatum <= endDatum If Not cAuditFlow_Pruefungen.ExistiertBereits(obj.wartPO_Id, laufDatum) Then Dim neuePruefung As New cAuditFlow_Pruefungen With { .wartPruef_wartPOId = obj.wartPO_Id, .wartPruef_Faelligkeitsdatum = laufDatum, .wartPruef_Erledigung = False } neuePruefung.SAVE() End If ' Nächstes Datum berechnen laufDatum = BerechneNaechstesDatum(laufDatum, intervallTyp, obj.wartPO_IntervallWert.Value) Loop Next End Sub ''' ''' Berechnet das nächste Fälligkeitsdatum auf Basis eines Ausgangsdatums, des Intervalltyps und -werts. ''' ''' Ausgangspunkt für die nächste Fälligkeit ''' Intervalltyp: "TAGE", "WOCHEN", "MONATE", "JAHRE" ''' Anzahl der Einheiten, die zwischen zwei Fälligkeiten liegen ''' ''' Beispiele: ''' typ: "TAGE", wert: 10 → alle 10 Tage ''' typ: "WOCHEN", wert: 1 → jede Woche ''' typ: "MONATE", wert: 3 → alle 3 Monate ''' typ: "JAHRE", wert: 2 → alle 2 Jahre ''' Private Shared Function BerechneNaechstesDatum(start As Date, typ As String, wert As Integer) As Date Select Case typ.Trim.ToUpper() Case "TAGE" Return start.AddDays(wert) Case "WOCHEN" Return start.AddDays(wert * 7) Case "MONATE" Return start.AddMonths(wert) Case "JAHRE" Return start.AddYears(wert) Case Else Throw New ArgumentException("Ungültiger Intervalltyp: " & typ) End Select End Function End Class