udfWeekOfYearISO
str udfWeekOfYearISO (str)
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfWeekOfYearISO_V2 (strYmdHms) ; Returns string list of format "YYYY:WW:D".
intEMLast = ErrorMode (@OFF)
LastError ()
intJulNow = TimeJulianDay (strYmdHms)
intLastError = LastError ()
ErrorMode (intEMLast)
If intLastError > 0 Then Return "0000:00:0" ; If the given DateTime parameter is invalid.
intDowNow = ((intJulNow + 4) mod 7) + 1     ; Range=1..7=Monday..Sunday.
intThursday = intJulNow - intDowNow + 4     ; Thursday rule. Is year change in this week?
If intThursday < 1 Then Return "0000:00:0"  ; Cannot handle the year before year zero.
strThursday = TimeJulToYmd (intThursday)
intYear = Int (ItemExtract (1, strThursday, ":"))
intJulJan4 = TimeJulianDay (StrFixLeft (intYear, "0", 4) : ":01:04")
intDowJan4 = ((intJulJan4 + 4) mod 7) + 1   ; Range=1..7=Monday..Sunday.
intWeek = (intJulNow - intJulJan4 + intDowJan4 + 6) / 7
Return StrFixLeft (intYear, "0", 4) : ':' : StrFixLeft (intWeek, "0", 2) : ':' : intDowNow
;..........................................................................................................................................
; This UDF "udfWeekOfYearISO" calculates the number of the calendar week as defined by ISO 8601
; and converts a YMD date into a YWD date.
;
; Parameter strYmdHms must be a valid WinBatch DT-10 or DT-19 DateTime string of format "YYYY:MM:DD" or "YYYY:MM:DD:HH:MM:SS".
;
; The return value is a string list of format "YYYY:WW:D".
; On error the string list has the content "0000:00:0".
;
; In a next step, the result can be formatted to an ISO date string as it is needed, for example "2011-W08-2" or "2011W082".
;..........................................................................................................................................
; ISO 8601 defines Monday as the first day of any week.
; Week W01 of any year is the first week that contains January 4.
; In some years the days January 1, 2 or 3 could fall into week W52 or W53 of the previous year.
; In some years the days December 29, 30, 31 could fall into week W01 of the following year.
;
; This UDF returns valid results for dates from "0000:01:03" to "9999:12:31" as ISO weeks from "0000:01:1" to "9999:52:5".
; Days before "0000:01:01" or beyond "9999:12:31" cannot be represented by the WinBatch YmdHms DateTime datatype.
;..........................................................................................................................................
; The algorithm may return the same week number 52 resp. 53 for days at the beginning or at the end of the year.
; Example:
; For the day "2010-01-01" the algorithm returns the week number 53.
; For the day "2010-12-31" the algorithm returns the week number 52.
; In December 2010 the week number 52 has the meaning "week 52 of year 2010".
; In January 2010 the week number 53 has the meaning "week 53 of year 2009".
;..........................................................................................................................................
; This code appearance made by Detlev Dalitz.20110222.
; Crucious DateTime math by Lars M. Doornbos.20110216.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfWeekOfYearISO_V1 (strYmdHms) ; Returns string list of format "YYYY:WW:D".
intEMLast = ErrorMode (@OFF)
LastError ()
intDow = ((4 + TimeJulianDay (strYmdHms)) mod 7) + 1 ; ISO Days 1..7.
intLastError = LastError ()
ErrorMode (intEMLast)
If intLastError > 0 Then Return "0000:00:0" ; If the given DateTime parameter is invalid.
blnVerify = @FALSE
While @TRUE
   intJulianNow = TimeJulianDay (strYmdHms)
   intJulianJan4 = TimeJulianDay (ItemExtract (1, strYmdHms, ":") : ":1:4")
   intJulianDowJan4 = (intJulianJan4 + 5) mod 7 ; Range=0..6 = Sunday..Saturday
   intJulianMonday = 1 + intJulianJan4 - intJulianDowJan4 - (7 * !intJulianDowJan4)
   intWeek = (intJulianNow - intJulianMonday) / 7
   intWeek = intWeek + (intJulianNow >= intJulianMonday)
   If blnVerify
      If intWeek == 2 Then Return ItemExtract (1, strYmdHms, ":") : ":" : StrFixLeft ("01", "0", 2) : ":" : intDow
      If intWeek == 1 Then Return ItemExtract (1, strYmdHms, ":") : ":" : StrFixLeft (intWeekLast, "0", 2) : ":" : intDow
      Return ItemExtract (1, strYmdHms, ":") : ":" : StrFixLeft (intWeek, "0", 2) : ":" : intDow
   EndIf
   If intWeek > 52 ; Look into next week.
      intWeekLast = intWeek
      blnVerify = @TRUE
      intYearNext = Int (ItemExtract (1, strYmdHms, ":")) + 1
      If intYearNext > 9999 Then Return "0000:00:0"
      strYmdHms = TimeAdd (strYmdHms, "0:0:7")
      Continue
   EndIf
   If intWeek < 1 ; Look into last year.
      blnVerify = @TRUE
      intYearBefore = Int (ItemExtract (1, strYmdHms, ":")) - 1
      If intYearBefore < 0 Then Return "0000:00:0"
      strYmdHms = StrFixLeft (intYearBefore, "0", 4) : ":12:31" ; Make valid DateTime string, especially for years < 100.
      Continue
   EndIf
   Return ItemExtract (1, strYmdHms, ":") : ":" : StrFixLeft (intWeek, "0", 2) : ":" : intDow
EndWhile
Return ; We should not reach here.
;..........................................................................................................................................
; This UDF "udfWeekOfYearISO" calculates the number of the calendar week as defined by ISO 8601.
; and converts a YMD date into a YWD date.
;
; Parameter strYmdHms must be a valid WinBatch DT-10 or DT-19 DateTime string of format "YYYY:MM:DD" or "YYYY:MM:DD:HH:MM:SS".
;
; The return value is a string list of format "YYYY:WW:D".
; On error the string list has the content "0000:00:0".
;
; In a next step, the result can be formatted to an ISO date string as it is needed, for example "2011-W08-2" or "2011W082".
;..........................................................................................................................................
; ISO 8601 defines Monday as the first day of any week.
; Week W01 of any year is the first week that contains January 4.
; In some years the days January 1, 2 or 3 could fall into week W52 or W53 of the previous year.
; In some years the days December 29, 30, 31 could fall into week W01 of the following year.
;
; This UDF returns valid results for dates from "0000:01:03" to "9999:12:31" as ISO weeks from "0000:01:1" to "9999:52:5".
; Days before "0000:01:01" or beyond "9999:12:31" cannot be represented by the WinBatch YmdHms DateTime datatype.
;..........................................................................................................................................
; The algorithm may return the same week number 52 resp. 53 for days at the beginning or at the end of the year.
; Example:
; For the day "2010-01-01" the algorithm returns the week number 53.
; For the day "2010-12-31" the algorithm returns the week number 52.
; In December 2010 the week number 52 has the meaning "week 52 of year 2010".
; In January 2010 the week number 53 has the meaning "week 53 of year 2009".
;..........................................................................................................................................
; Detlev Dalitz.20010325.20090726.20110222.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


;==========================================================================================================================================
; Test1.

strYWD111 = udfWeekOfYearISO_V1 ("10000:01:01") ; "0000:00:0"
strYWD112 = udfWeekOfYearISO_V1 ("0000:01:01")  ; "0000:00:0"
strYWD113 = udfWeekOfYearISO_V1 ("0000:01:02")  ; "0000:00:0"
strYWD114 = udfWeekOfYearISO_V1 ("0000:01:03")  ; "0000:01:1"
strYWD115 = udfWeekOfYearISO_V1 ("0001:01:01")  ; "0001:01:1"
strYWD116 = udfWeekOfYearISO_V1 ("1993:10:05")  ; "1993:40:2"
strYWD117 = udfWeekOfYearISO_V1 ("2009:02:01")  ; "2009:05:7"
strYWD118 = udfWeekOfYearISO_V1 ("2010:01:01")  ; "2009:53:5"
strYWD119 = udfWeekOfYearISO_V1 ("2010:12:31")  ; "2010:52:5"
strYWD120 = udfWeekOfYearISO_V1 ("2014:12:31")  ; "2015:01:3"
strYWD121 = udfWeekOfYearISO_V1 ("2015:01:01")  ; "2015:01:4"
strYWD122 = udfWeekOfYearISO_V1 ("2101:01:02")  ; "2100:52:7"
strYWD123 = udfWeekOfYearISO_V1 ("9999:12:31")  ; "9999:52:5"

strYWD211 = udfWeekOfYearISO_V2 ("10000:01:01") ; "0000:00:0"
strYWD212 = udfWeekOfYearISO_V2 ("0000:01:01")  ; "0000:00:0"
strYWD213 = udfWeekOfYearISO_V2 ("0000:01:02")  ; "0000:00:0"
strYWD214 = udfWeekOfYearISO_V2 ("0000:01:03")  ; "0000:01:1"
strYWD215 = udfWeekOfYearISO_V2 ("0001:01:01")  ; "0001:01:1"
strYWD216 = udfWeekOfYearISO_V2 ("1993:10:05")  ; "1993:40:2"
strYWD217 = udfWeekOfYearISO_V2 ("2009:02:01")  ; "2009:05:7"
strYWD218 = udfWeekOfYearISO_V2 ("2010:01:01")  ; "2009:53:5"
strYWD219 = udfWeekOfYearISO_V2 ("2010:12:31")  ; "2010:52:5"
strYWD220 = udfWeekOfYearISO_V2 ("2014:12:31")  ; "2015:01:3"
strYWD221 = udfWeekOfYearISO_V2 ("2015:01:01")  ; "2015:01:4"
strYWD222 = udfWeekOfYearISO_V2 ("2101:01:02")  ; "2100:52:7"
strYWD223 = udfWeekOfYearISO_V2 ("9999:12:31")  ; "9999:52:5"


; If someone needs the return value as of datatype array, then use Arrayize().

arrYWD211 = Arrayize (strYWD211, ":") ; Array "0000"|"00"|"0"
arrYWD212 = Arrayize (strYWD212, ":") ; Array "0000"|"00"|"0"
arrYWD213 = Arrayize (strYWD213, ":") ; Array "0000"|"00"|"0"
arrYWD214 = Arrayize (strYWD214, ":") ; Array "0000"|"01"|"1"
arrYWD215 = Arrayize (strYWD215, ":") ; Array "0001"|"01"|"1"
arrYWD216 = Arrayize (strYWD216, ":") ; Array "1993"|"40"|"2"
arrYWD217 = Arrayize (strYWD217, ":") ; Array "2009"|"05"|"7"
arrYWD218 = Arrayize (strYWD218, ":") ; Array "2009"|"53"|"5"
arrYWD219 = Arrayize (strYWD219, ":") ; Array "2010"|"52"|"5"
arrYWD220 = Arrayize (strYWD220, ":") ; Array "2015"|"01"|"3"
arrYWD221 = Arrayize (strYWD221, ":") ; Array "2015"|"01"|"4"
arrYWD222 = Arrayize (strYWD222, ":") ; Array "2100"|"52"|"7"
arrYWD223 = Arrayize (strYWD223, ":") ; Array "9999"|"52"|"5"



; Display test results via text file.

DirChange (DirScript ())
strFileThis = IntControl (1004, 0, 0, 0, 0)
strFileOut = ItemReplace ("out.txt", -1, strFileThis, ".")

strYWD = ""
For intI = 211 To 223
   strYWD = strYWD : @CRLF : strYWD%intI%
Next
strYWD = StrSub (strYWD, 3, -1)

FilePut (strFileOut, strYWD)
Run (strFileOut, "")
If FileExist (strFileOut) == 1 Then FileDelete (strFileOut)


;==========================================================================================================================================
; Test2.

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfCalendar (sYmdHms)

iDayWidthMax = 3 ; Default=Minimum=3; Maybe enlarge this value to spread the table in horizontal direction.
iDayMax = 7
iWeekWidthMax = 3
iLineMax = (iDayMax * iDayWidthMax) + iWeekWidthMax + StrLen (@CRLF)
iRowMax = 8
iCalSizeMax = iLineMax * iRowMax
iOffsCrLf = iLineMax - 2
iOffsYear = (iDayMax * iDayWidthMax) - 1
iOffsMonth = 0
iOffsWeek = 1 + iOffsYear + iLineMax + iLineMax
iOffsDayNames = iLineMax
iOffsDayTab = iOffsDayNames + iLineMax

sMonthNameList = "Januar,Februar,März,April,Mai,Juni,Juli,August,September,Oktober,November,Dezember"
sDayNameList = "Mo,Di,Mi,Do,Fr,Sa,So"
;sMonthNameList = "January,February,March,April,May,June,July,August,September,October,November,December"
;sDayNameList = "Mo,Tu,We,Th,Fr,Sa,Su"


intEMLast = ErrorMode (@OFF)
LastError ()
sYmdHms = TimeAdd (sYmdHms, "0:0:0") ; Make valid DateTime string, for sure.
intLastError = LastError ()
ErrorMode (intEMLast)
Drop (intEMLast)
If intLastError > 0 Then sYmdHms = TimeYmdHms () ; If given YmdHms parameter is invalid, then use current DateTime.

sYmdHms = ItemReplace ("01", 3, sYmdHms, ":") ; Set Date to first day of month.
iYear = Int (ItemExtract (1, sYmdHms, ":"))
iMonth = Int (ItemExtract (2, sYmdHms, ":"))
sMonthName = ItemExtract (iMonth, sMonthNameList, ",")
If sYmdHms < "0000:01:03:00:00:00" Then sYmdHms = "0000:01:03:00:00:00" ; This is the first Monday in the first ISO calendar week.

hbbCal = BinaryAlloc (iCalSizeMax)
BinaryEodSet (hbbCal, iCalSizeMax)
BinaryReplace (hbbCal, "", " ", @TRUE)

While (iOffsCrLf < iCalSizeMax)
   BinaryPokeStr (hbbCal, iOffsCrLf, @CRLF)
   iOffsCrLf = iOffsCrLf + iLineMax
EndWhile

For iCol = 1 To iDayMax
   BinaryPokeStr (hbbCal, iOffsDayNames, ItemExtract (iCol, sDayNameList, ","))
   iOffsDayNames = iOffsDayNames + iDayWidthMax
Next

BinaryPokeStr (hbbCal, iOffsYear, StrFixLeft (iYear, "0", 4))
BinaryPokeStr (hbbCal, iOffsMonth, sMonthName)


iDow01 = ((TimeJulianDay (sYmdHms) + 4) mod 7) + 1 ; Range=1..7 = Monday..Sunday.
sDTMonday = TimeSubtract (sYmdHms, "0:0:" : iDow01 - 1)

sYmdHms = sDTMonday ; Start from Monday.
iOffsRow = iOffsDayTab
iOffsCol = iOffsRow
iDay = 0
If sYmdHms == "0000:01:03:00:00:00" Then iDay = 2 ; Cannot handle the first two days in month "0000:01".
sWeek = ""
While @TRUE
   For iCol = 1 To iDayMax
      iMonthWork = Int (ItemExtract (2, sYmdHms, ":"))
      If (iMonth == iMonthWork)
         iDay = iDay + 1
         BinaryPokeStr (hbbCal, iOffsCol, StrFixLeft (iDay, " ", 2))

         If (sWeek == "")
            sWeek = "W" : StrFixLeft (ItemExtract (2, udfWeekOfYearISO_V1 (sYmdHms), ":"), "0", 2)
            BinaryPokeStr (hbbCal, iOffsWeek, sWeek)
         EndIf
      EndIf
      iOffsCol = iOffsCol + iDayWidthMax
      sYmdHms = TimeAdd (sYmdHms, "0:0:1") ; Note: TimeAdd() can add (only) one day over the limit without error.
      If sYmdHms == "10000:01:01:00:00:00" Then Break
   Next

   iYearWork = Int (ItemExtract (1, sYmdHms, ":"))
   If (iYear < iYearWork) Then Break
   iMonthWork = Int (ItemExtract (2, sYmdHms, ":"))
   If (iMonth < iMonthWork) Then Break

   iOffsRow = iOffsRow + iLineMax
   iOffsCol = iOffsRow
   iOffsWeek = iOffsWeek + iLineMax
   sWeek = ""
EndWhile

sCal = BinaryPeekStr (hbbCal, 0, iCalSizeMax)
BinaryFree (hbbCal)

Return (sCal)
;..........................................................................................................................................
; This Function "udfCalendar" returns a small calender table for the given year and month.
;
;   +------------------------+
;   |Januar              2003|
;   |Mo Di Mi Do Fr Sa So    |
;   |       1  2  3  4  5 W01|
;   | 6  7  8  9 10 11 12 W02|
;   |13 14 15 16 17 18 19 W03|
;   |20 21 22 23 24 25 26 W04|
;   |27 28 29 30 31       W05|
;   |                        |
;   +------------------------+
;
; Detlev Dalitz.20020721.20110222.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


strCal01 = udfCalendar ("9999:12:31")
strCal02 = udfCalendar ("0000:01:01")
strCal03 = udfCalendar ("0001:01:01")
strCal04 = udfCalendar ("1993:10:05")
strCal05 = udfCalendar ("2009:02:01")
strCal06 = udfCalendar ("2010:01:01")
strCal07 = udfCalendar ("2010:12:31")
strCal08 = udfCalendar ("2014:12:31")
strCal09 = udfCalendar ("2015:01:01")
strCal10 = udfCalendar ("2101:01:02")


; Display test results via text file.

DirChange (DirScript ())
strFileThis = IntControl (1004, 0, 0, 0, 0)
strFileOut = ItemReplace ("out.txt", -1, strFileThis, ".")

FilePut (strFileOut, strCal01 : strCal02 : strCal03 : strCal04 : strCal05 : strCal06 : strCal07 : strCal08 : strCal09 : strCal10)
Run (strFileOut, "")
If FileExist (strFileOut) == 1 Then FileDelete (strFileOut)


;   Dezember            9999
;   Mo Di Mi Do Fr Sa So
;          1  2  3  4  5 W48
;    6  7  8  9 10 11 12 W49
;   13 14 15 16 17 18 19 W50
;   20 21 22 23 24 25 26 W51
;   27 28 29 30 31       W52
;
;   Januar              0000
;   Mo Di Mi Do Fr Sa So
;    3  4  5  6  7  8  9 W01
;   10 11 12 13 14 15 16 W02
;   17 18 19 20 21 22 23 W03
;   24 25 26 27 28 29 30 W04
;   31                   W05
;
;   Januar              0001
;   Mo Di Mi Do Fr Sa So
;    1  2  3  4  5  6  7 W01
;    8  9 10 11 12 13 14 W02
;   15 16 17 18 19 20 21 W03
;   22 23 24 25 26 27 28 W04
;   29 30 31             W05
;
;   Oktober             1993
;   Mo Di Mi Do Fr Sa So
;                1  2  3 W39
;    4  5  6  7  8  9 10 W40
;   11 12 13 14 15 16 17 W41
;   18 19 20 21 22 23 24 W42
;   25 26 27 28 29 30 31 W43
;
;   Februar             2009
;   Mo Di Mi Do Fr Sa So
;                      1 W05
;    2  3  4  5  6  7  8 W06
;    9 10 11 12 13 14 15 W07
;   16 17 18 19 20 21 22 W08
;   23 24 25 26 27 28    W09
;
;   Januar              2010
;   Mo Di Mi Do Fr Sa So
;                1  2  3 W53
;    4  5  6  7  8  9 10 W01
;   11 12 13 14 15 16 17 W02
;   18 19 20 21 22 23 24 W03
;   25 26 27 28 29 30 31 W04
;
;   Dezember            2010
;   Mo Di Mi Do Fr Sa So
;          1  2  3  4  5 W48
;    6  7  8  9 10 11 12 W49
;   13 14 15 16 17 18 19 W50
;   20 21 22 23 24 25 26 W51
;   27 28 29 30 31       W52
;
;   Dezember            2014
;   Mo Di Mi Do Fr Sa So
;    1  2  3  4  5  6  7 W49
;    8  9 10 11 12 13 14 W50
;   15 16 17 18 19 20 21 W51
;   22 23 24 25 26 27 28 W52
;   29 30 31             W01
;
;   Januar              2015
;   Mo Di Mi Do Fr Sa So
;             1  2  3  4 W01
;    5  6  7  8  9 10 11 W02
;   12 13 14 15 16 17 18 W03
;   19 20 21 22 23 24 25 W04
;   26 27 28 29 30 31    W05
;
;   Januar              2101
;   Mo Di Mi Do Fr Sa So
;                   1  2 W52
;    3  4  5  6  7  8  9 W01
;   10 11 12 13 14 15 16 W02
;   17 18 19 20 21 22 23 W03
;   24 25 26 27 28 29 30 W04
;   31                   W05

:CANCEL
Exit