Anlage des Repos

2024-01-24 16:42:38 +01:00
commit 38d6a271c4
1785 changed files with 3051496 additions and 0 deletions
--- a/current/Modules/Sicherungen/Modules_20230706/GetDateByWeekdayname.vbm
+++ b/current/Modules/Sicherungen/Modules_20230706/GetDateByWeekdayname.vbm
@@ -0,0 +1,143 @@
+' GetDateByWeekdayname
+' ----------------------------------------------------------------------------
+' Diese Funktion errechnet das Datum eines übergebenen Wochentages
+' Parameter 1 (pWeekdayname) 	 = Übergabe des zu ermittelnden Wochentags (Bsp.: "Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag","Sonntag")
+' Parameter 2 (pFromDate) 	 	 = Übergabe des Datums, ab wann gerechnet werden soll (Bsp.: "01.01.2022")
+' Parameter 3 (pIncludeToday) 	 = Übergabe "True" oder "False" um den aktuellen Tag in die Ermittlung einzubeziehen.
+' Parameter 4 (pSkipTodayByTime) = Übergabe einer Uhrzeit (Bsp.: "12:00"), bis wann der aktuelle Tag miteinbezogen werden soll.
+'								   Sofern nicht mit "99:99" oder "NULL" abgeschaltet, übersteuert Parameter 4 immer Parameter 3.
+'
+' ----------------------------------------------------------------------------
+' Copyright (c) 2021 by Digital Data GmbH
+'
+' Digital Data GmbH • Ludwig-Rinn-Strasse 16 • D-35452 Heuchelheim
+' Tel.: 0641/202360 • E-Mail: info-flow@digitaldata.works
+' ----------------------------------------------------------------------------
+' Creation Date / Author:    05.10.2021 / MK
+' Version Date / Editor:     12.10.2021 / MK
+' Version Number:            1.3.0.0
+
+Function GetDateByWeekdayname(pWeekdayname,pFromDate,pIncludeToday,pSkipTodayByTime)
+
+	'Set vars. Set current date and day and nr
+	IF (GetLocale() = 1031) then
+		Weekdaynames = Array("Sonntag","Montag","Dienstag","Mittwoch","Donnerstag","Freitag","Samstag")
+	Else				'Tag 1			2		3			4			5			6		7
+		Weekdaynames = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
+	End if
+
+	'Evaluate parameter pFromDate
+	IF (pFromDate = "today") Then
+		FromDate = Date()
+	Else
+		FromDate = cdate(pFromDate)
+	End if
+
+	IF (IsDate(FromDate) = True) Then
+
+		CurrentDayNumber = Weekday(FromDate)
+		CurrentDayOfWeek = Weekdayname(CurrentDayNumber,False,1)
+		CurrentTime		 = TimeValue(Now())
+
+		'Evaluate parameter pSkipTodayByTime
+		If (pSkipTodayByTime <> "99:99") and (pSkipTodayByTime <> "NULL") Then
+			On Error Resume Next
+			TimeValue(pSkipTodayByTime)
+			If (Err.number = 0) and (CLng(Replace(CurrentTime,":","")) > CLng(Replace(TimeValue(pSkipTodayByTime),":",""))) then
+				IncludeToday = False
+			Else
+				IncludeToday = True
+			End if
+
+		Else
+
+			'Fallback if parameter ist not bool
+			IF (VarType(pIncludeToday) = 11) Then
+				IncludeToday = pIncludeToday
+			Else
+				IncludeToday = False
+			End If
+
+		End if
+
+		If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
+			MsgBox	"Looking for next: "				 	& vbCrlf & _
+					"pWeekdayname " 	 & pWeekdayname 	& vbCrlf & _
+					"FromDate " 		 & FromDate 		& vbCrlf & _
+					"pIncludeToday " 	 & pIncludeToday 	& vbCrlf & _
+					"IncludeToday " 	 & IncludeToday 	& vbCrlf & _
+					"pSkipTodayByTime "  & pSkipTodayByTime & vbCrlf & vbCrlf & _
+					"CurrentDayOfWeek: " & CurrentDayOfWeek & vbCrlf & _
+					"CurrentDayNumber: " & CurrentDayNumber & vbCrlf & _
+					"",,"DEBUG - GetDateByWeekdayname - Parameter given:"
+		End If
+
+		CalcDate		= FromDate
+		CalcDayNumber	= CurrentDayNumber
+		Counter			= 0
+
+		DO
+
+			'If pIncludeToday = False, skip the current FromDate and add one day
+			IF (IncludeToday = False) then
+
+				Counter 		= Counter + 1
+				CalcDayNumber	= CalcDayNumber + 1
+
+			End If
+
+			'Reset day, but keep counter
+			IF (CalcDayNumber > 7) Then 
+				CalcDayNumber = 1
+			end if
+
+			CalcDate = Dateadd("d", + counter, FromDate)
+
+			If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
+				MsgBox	"pWeekdayname: "		& pWeekdayname							& vbCrlf & _
+						"pFromDate: "			& pFromDate								& vbCrlf & _
+						"pIncludeToday: "		& pIncludeToday							& vbCrlf & _
+						"pSkipTodayByTime: "	& pSkipTodayByTime						& vbCrlf & vbCrlf & _
+						"Counter: "				& Counter 								& vbCrlf & _
+						"CalcDayNumber: "		& CalcDayNumber							& vbCrlf & _
+						"CalcWeekdayname: "		& Weekdayname(CalcDayNumber,False,1) 	& vbCrlf & _
+						"CalcWeekday: " 		& Weekday(CalcDayNumber)				& vbCrlf & _
+						"CalcDate: "			& CalcDate,, "DEBUG - GetDateByWeekdayname - Loop " & Counter
+			End If
+
+			CalcDayOfWeek = Weekdayname(CalcDayNumber,False,1)
+
+			'Failsafe to prevent endless loops
+			IF ((CalcDayOfWeek = pWeekdayname) or (Counter = 31)) THEN EXIT DO
+
+			'If pIncludeToday = True, dont skip the current FromDate
+			IF (IncludeToday = True) then
+
+				Counter 		= Counter + 1
+				CalcDayNumber	= CalcDayNumber + 1
+
+			End If
+
+		LOOP
+
+		If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
+			MsgBox	"Errechnet: " & cdate(CalcDate),,"DEBUG - GetDateByWeekdayname - Ergebnis"
+		End if
+
+	Else
+
+		CalcDate = "01.01.1970"
+
+		If (DEBUG_ON = True) Or (DebugMode = "Enabled") Then
+			MsgBox	"Ungültiges Datum, failsafe auf: 01.01.1970",,"DEBUG - GetDateByWeekdayname - Ergebnis"
+		End if
+
+	End if
+
+	'Return calculated date
+	GetDateByWeekdayname = cdate(CalcDate)
+
+end function 'GetDateByWeekdayname
+
+'datetest = GetDateByWeekdayname ("Dienstag","12.10.2021",false,"12:00")
+'msgbox datetest