Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Correct date formats for Catalunya, Sweden, Wales and UK

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Correct date formats for Catalunya, Sweden, Wales and UK

    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
    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
    Last edited by Egbert Zijlema; 11 Feb 2009, 05:19 PM. Reason: Added: Link to MSDN-info for GetDateFormat API

    Egbert Zijlema, journalist and programmer (zijlema at basicguru dot eu)
    http://zijlema.basicguru.eu
    *** Opinions expressed here are not necessarily untrue ***
Working...
X