Tweet
Okay, not every PB programmer wants to use my Gregorian Date Library. Therefore I decided to write my date routine with corrections for Catalunya, Sweden, Wales and the UK for plain and genuine Windows as well. Unlike GetDateFormat it returns error messages for passing wrong date parameters.
Be so kind to report bugs. If you feel the need for a discussion then start a new thread in the Windows-forum, not here.
MSDN-info can be found here: http://msdn.microsoft.com/en-us/libr...86(VS.85).aspx
Be so kind to report bugs. If you feel the need for a discussion then start a new thread in the Windows-forum, not here.
MSDN-info can be found here: http://msdn.microsoft.com/en-us/libr...86(VS.85).aspx
Code:
' CORRECTDATE.BAS - Correction for Windows API function GetDateFormat. ' ' The API function GetDateFormat returns a wrong long date for Sweden, Catalunya (Spain), the UK and Wales. ' GetCorrectDateFormat repairs this annoyance. It uses 2 helper FUNCTIONs and a SUB: sDayName, sMonthName and ValidateDayOfWeek. ' It does not use the Gregorian Date Library, so it's plain and genuine Windows. ' It returns an error message, where the Windows function just returns an empty string. ' ' Developed by Egbert Zijlema; author of the Gregorian Date Library. Please send bug reports to: [email protected] ' Release date: February 11, 2009. ' This code is released into the Public Domain. ' No guarantee as to the viability, accuracy, or safety of use of this code is implied, warranted, or guaranteed. ' ALWAYS USE IT AT YOUR OWN RISK!! ' **** IMPORTANT NOTE: ********************************************** ' * the parameter dwLocale is declared as OPTIONAL * ' * if omitted, the function defaults to %LOCALE_USER_DEFAULT (= 0) * ' ******************************************************************* #IF NOT %DEF(%WINAPI) ' constants, udt & declarations from: ' WIN32API.INC (27 January 2005 -------- 8.00.0000) ' Copyright (C) 1997-2005 PowerBASIC, Inc. ' Portions Copyright (C) 1985-1999 Microsoft Corporation ' All Rights Reserved. ' *************************************************************** %DATE_SHORTDATE = &H00000001 ' use short date picture %DATE_LONGDATE = &H00000002 ' use long date picture %LOCALE_SCOUNTRY = &H00000006 ' localized name of country %LOCALE_SDAYNAME1 = &H0000002A ' localized name for Monday %LOCALE_SMONTHNAME1 = &H00000038 ' localized name for January %LOCALE_SENGCOUNTRY = &H00001002 ' English name of country %ERROR_INVALID_PARAMETER = 87 %ERROR_INSUFFICIENT_BUFFER = 122 %ERROR_INVALID_FLAGS = 1004 TYPE FILETIME dwLowDateTime AS DWORD dwHighDateTime AS DWORD END TYPE TYPE SYSTEMTIME wYear AS WORD wMonth AS WORD wDayOfWeek AS WORD wDay AS WORD wHour AS WORD ' ) wMinute AS WORD ' ) time elements not used in this function wSecond AS WORD ' ) wMilliseconds AS WORD ' ) END TYPE DECLARE FUNCTION GetDateFormat LIB "KERNEL32.DLL" ALIAS "GetDateFormatA" (BYVAL dwLocale AS DWORD, BYVAL dwFlags AS DWORD, lpDate AS SYSTEMTIME, lpFormat AS ASCIIZ, lpDateStr AS ASCIIZ, BYVAL cchDate AS LONG) AS LONG DECLARE FUNCTION GetLocaleInfo LIB "KERNEL32.DLL" ALIAS "GetLocaleInfoA" (BYVAL dwLocale AS DWORD, BYVAL LCType AS LONG, lpLCData AS ASCIIZ, BYVAL cchData AS LONG) AS LONG DECLARE FUNCTION SystemTimeToFileTime LIB "KERNEL32.DLL" ALIAS "SystemTimeToFileTime" (lpSystemTime AS SYSTEMTIME, lpFileTime AS FILETIME) AS LONG DECLARE FUNCTION FileTimeToSystemTime LIB "KERNEL32.DLL" ALIAS "FileTimeToSystemTime" (lpFileTime AS FILETIME, lpSystemTime AS SYSTEMTIME) AS LONG DECLARE FUNCTION GetLastError LIB "KERNEL32.DLL" ALIAS "GetLastError" () AS LONG #ENDIF %LOCALE_CATALUNYA = 1027 %LOCALE_SWEDEN = 1053 %LOCALE_WALES = 1106 %LOCALE_UK = 2057 FUNCTION sDayName(BYVAL wWeekDay AS WORD, OPTIONAL BYVAL dwLocale AS DWORD) AS STRING ' **************************************************************************** ' * returns the localized name for the day of the week * ' * Parameters are: wWeekDay: 1 = Monday through 7 = Sunday * ' * dwLocale: country/language specific locale * ' * (defaults to %LOCALE_USER_DEFAULT if omitted or 0) * ' * * ' * NOTE: In a Windows SYSTEMTIME structure Sunday = 0 * ' * This function accepts both, 0 and 7, in order to * ' * process wDayOfWeek inside a SYSTEMTIME structure correctly. * ' **************************************************************************** LOCAL szDayName AS ASCIIZ * 16, LCType AS LONG IF wWeekDay = 0 THEN wWeekday = 7 ' make compatible with %LOCALE_SMONTHNAME7 LCType = %LOCALE_SDAYNAME1 + wWeekDay - 1 IF GetLocaleInfo(dwLocale, LCType, szDayName, SIZEOF(szDayName)) THEN FUNCTION = szDayName ELSE FUNCTION = "" END IF END FUNCTION FUNCTION sMonthName(BYVAL wMonth AS WORD, OPTIONAL BYVAL dwLocale AS DWORD) AS STRING ' **************************************************************************** ' * returns the locale-specific name of the month * ' * parameters: wMonth : 1 = January through 12 = December * ' * dwLocale: country/language specific locale * ' * (defaults to %LOCALE_USER_DEFAULT if omitted or 0) * ' **************************************************************************** LOCAL szMonthName AS ASCIIZ * 16, LCType AS LONG LCType = %LOCALE_SMONTHNAME1 + wMonth - 1 IF GetLocaleInfo(dwLocale, LCType, szMonthName, SIZEOF(szMonthName)) THEN FUNCTION = szMonthName ELSE FUNCTION = "" END IF END FUNCTION SUB ValidateDayOfWeek(lpDate AS SYSTEMTIME) ' **************************************************************************** ' * after the 3 main date elements inside a SYSTEMTIME structure are filled, * ' * wDayOfWeek is not automatically loaded correctly (it still equals 0) * ' * so, it needs a Windows conversion from SystemTime to FileTime and back * ' **************************************************************************** LOCAL ft AS FILETIME IF ISFALSE(SystemTimeToFileTime(lpDate, ft)) THEN EXIT SUB IF ISFALSE(FileTimeToSystemTime(ft, lpDate)) THEN EXIT SUB END SUB FUNCTION GetCorrectDateFormat(BYVAL dwFlags AS DWORD, lpDate AS SYSTEMTIME, lpFormat AS ASCIIZ, OPTIONAL BYVAL dwLocale AS DWORD) AS STRING LOCAL szDate AS ASCIIZ * 64, sDateOut AS STRING LOCAL iErrorHandle AS LONG, sMsg AS STRING IF ISTRUE(GetDateFormat(dwLocale, dwFlags, lpDate, lpFormat, szDate, SIZEOF(szDate))) THEN sDateOut = REMOVE$(szDate, CHR$(0)) ELSE iErrorHandle = GetLastError() SELECT CASE AS LONG iErrorHandle CASE %ERROR_INVALID_PARAMETER IF lpDate.wYear < 1601 THEN sMsg = "Windows does not accept years prior to 1601." ELSEIF lpDate.wMonth < 1 OR lpDate.wMonth > 12 THEN sMsg = "Month must be in the range 1 - 12." ELSE IF lpDate.wMonth = 2 AND lpDate.wDay > 28 THEN sMsg = FORMAT$(lpDate.wYear) & " is not a Leap Year!" ELSE sMsg = "Day must be in the range 1 - 28, 29, 30 or 31." END IF END IF CASE %ERROR_INSUFFICIENT_BUFFER ' note: this error will not occur (I think), because SIZEOF() always sets the correct buffer-size sMsg = "Buffer too small to load the date string." CASE %ERROR_INVALID_FLAGS sMsg = "Invalid flags. Either you use a wrong combination, or dwFlags" & $CRLF & _ "should be %NULL because lpFormat is not empty." END SELECT MSGBOX sMsg, 48, " ERROR!" FUNCTION = "" EXIT FUNCTION END IF ' Windows returns wrong long dates for Great-Britain and Wales, Catalunya and Sweden IF (dwFlags AND %DATE_LONGDATE) THEN CALL ValidateDayOfWeek(lpDate) ' set correct value for lpDate.wDayOfWeek SELECT CASE AS LONG dwLocale CASE %LOCALE_CATALUNYA REPLACE "/" WITH "de" IN sDateOut ' no short date separator in long date SELECT CASE AS LONG lpDate.wMonth CASE 4, 8, 10 ' april, august and october use d' REPLACE "de " & sMonthName(lpDate.wMonth, dwLocale) WITH _ CHR$(100, 39) & sMonthName(lpDate.wMonth, dwLocale) IN sDateOut END SELECT CASE %LOCALE_SWEDEN IF INSTR(sDateOut, "den") THEN REPLACE "den" WITH _ sDayName(lpDate.wDayOfWeek, dwLocale) IN sDateOut ' use name of the day, not "den" END IF CASE %LOCALE_UK, %LOCALE_WALES sDateOut = sDayName(lpDate.wDayOfWeek, dwLocale) & ", " & _ ' add dayname and comma sDateOut END SELECT END IF FUNCTION = sDateOut END FUNCTION FUNCTION PBMain() AS LONG ' just to test it LOCAL st AS SYSTEMTIME, dwLocale AS DWORD LOCAL szDate AS ASCIIZ * 64, szCountry AS ASCIIZ * 128 LOCAL sOutput AS STRING, sTmp AS STRING LOCAL errorflag AS LONG ' test for one of these locales: ' dwLocale = %LOCALE_CATALUNYA ' despite the Catalonian Locale, country name will be returned as Spain ' dwLocale = %LOCALE_SWEDEN dwLocale = %LOCALE_WALES ' despite the Welsh Locale, country name will be returned as United Kingdom ' dwLocale = %LOCALE_UK GetLocaleInfo dwLocale, %LOCALE_SENGCOUNTRY, szCountry, SIZEOF(szCountry) ' test different erroneous situations, for instance: ' * set year < 1601 ' * set month = 1, 3, 5, 7, 8, 10 OR 12 AND day = outside the 1 - 31 range ' * set month = 2 AND day > 28 in a non-LeapYear OR > 29 in a LeapYear ' * set month = 4, 6, 9 or 11 AND day = outside the 1 - 30 range ' * set month = outside the 1 - 12 range ' default = release date: st.wYear = 2009 st.wMonth = 2 st.wDay = 11 sOutput = "GetDateFormat returns wrong result for " & REMOVE$(szCountry, CHR$(0)) & ": " IF ISTRUE(GetDateFormat(dwLocale, %DATE_LONGDATE, st, "", szDate, SIZEOF(szDate))) THEN sOutput = sOutput & CHR$(34) & REMOVE$(szDate, CHR$(0)) & CHR$(34) ELSE ' no error trapping here, in order to give way to error messages fired by FUNCTION GetCorrectDateFormat errorflag = 1 END IF sTmp = GetCorrectDateFormat(%DATE_LONGDATE, st, "", dwLocale) IF sTmp = "" THEN EXIT FUNCTION ELSE sOutput = sOutput & $CRLF & "Result returned by GetCorrectDateFormat: " & CHR$(34) & sTmp & CHR$(34) END IF IF errorflag = 1 THEN EXIT FUNCTION MSGBOX sOutput, 64, " Date correction!" END FUNCTION
