Find Out More About Your Date s Background | Advanced Microsoft Visual Basic (Mps)

There is one last piece in the date jigsaw. Visual Basic relies on the underlying operating system for some of its date functionality—you have already seen how it takes its date windowing from the system file OLEAUT32.DLL and how the Short Date and Long Date are based on the Regional Settings in the Control Panel. Both of these dependencies can alter the way our applications interpret and report dates.

Unfortunately, Visual Basic does not make this information freely available to you and retrieving it can be a little tricky. Listing 8-5 is a module that provides functions to get this information from the system. This module contains functions that retrieve the Long Date and Short Date formats for the current System Locale. There is also a function to retrieve the version number of OLEAUT32.DLL and another to work out which date window it provides.

This information can be used in a number of ways. You could make it available on your application's About box. Alternatively, you can check it as part of your application's startup routines. If OLEAUT32.DLL's version number is not one you expect, you can abort the startup and display a message to the user telling him or her to contact the help desk.

NOTE
You can find this application on the companion CD in the Chap08\Date Environment folder.

Listing 8-5 The Date Information module

Option Explicit ' Used to hold the date format passed to  ' sPiEnumDateFormatsProc so that it can be passed to  ' the GetLongDateFormat and GetShortDateFormat functions Private m_sDateFormat   As String Private Declare Function WinGetFileVersionInfo Lib "version.dll" _                         Alias "GetFileVersionInfoA" _                         (ByVal lptstrFilename As String, _                         ByVal dwHandle As Long, _                         ByVal dwLen As Long, _                         ByVal lpData As String) As Long                          Private Declare Function WinGetFileVersionInfoSize _                         Lib "version.dll" _                         Alias "GetFileVersionInfoSizeA" _                         (ByVal lptstrFilename As String, _                         lpdwHandle As Long) As Long Private Declare Function WinEnumDateFormats Lib "kernel32" _                         Alias "EnumDateFormatsA" _                         (ByVal lpDateFmtEnumProc As Long, _                         ByVal Locale As Long, _                         ByVal dwFlags As Long) As Long                          Private Declare Sub WinCopyMemory Lib "kernel32" _                         Alias "RtlMoveMemory" _                         (ByVal lpDestination As Any, _                         ByVal lpSource As Long, _                         ByVal Length As Long)                          Private Declare Function Winlstrlen Lib "kernel32" _                         Alias "lstrlenA" (ByVal lpString As Long) _                         As Long Private Const LOCALE_SYSTEM_DEFAULT     As Long = &H400 Private Const DATE_LONGDATE             As Long = &H2 Private Const DATE_SHORTDATE            As Long = &H1 Public Function GetLongDateFormat() As String ' 32-bit VB function to retrieve the system "Long Date" format          ' Call the API routine that will enumerate the system date     ' format. This will call back the bPiEnumDateFormatsProc     ' routine in this module, passing it a string containing the     ' Long Date format.     Call WinEnumDateFormats(AddressOf bPiEnumDateFormatsProc, _                 LOCALE_SYSTEM_DEFAULT, DATE_LONGDATE)       ' Return the date format that will have been stored module     ' wide by the bPiEnumDateFormatsProc.     GetLongDateFormat = m_sDateFormat End Function Public Function GetShortDateFormat() As String ' 32-bit VB function to retrieve the system "Short Date" format          ' Call the API routine that will enumerate the system date     ' format. This will call back the bPiEnumDateFormatsProc     ' routine in this module, passing it a string containing     ' the system Short Date format.     Call WinEnumDateFormats(AddressOf bPiEnumDateFormatsProc, _                 LOCALE_SYSTEM_DEFAULT, DATE_SHORTDATE)       ' Return the date format that will have been stored module     ' wide by the routine bPiEnumDateFormatsProc.     GetShortDateFormat = m_sDateFormat End Function Public Function GetOLEAUT32Version() As String ' 32-bit VB function to retrieve the string version number of ' the OLEAUT32.DLL to which our process is linked. The routine ' returns the string version number.     Dim sVerInfo    As String         Dim sVersion    As String     Dim n           As Integer     Dim nPos        As Integer     Dim sVer        As String           Const sOLEAUT32 As String = "OLEAUT32" ' Don't need the '.DLL'.     Const sSEARCH   As String = "FILEVERSION"            ' Allocate space for the string version information.     SVerInfo = String$(WinGetFileVersionInfoSize(sOLEAUT32, 0), 0)          ' Retrieve info. If sVerInfo is "" it's OK, we don't need to     ' test it.     If 0 <> WinGetFileVersionInfo(sOLEAUT32, 0, Len(sVerInfo), _                                   sVerInfo) Then                      ' We might have to search for the info twice, the first             ' time as an ANSI string, and if that doesn't work,             ' the second time as a Unicode string.             For n = 1 To 2                                  ' Copy the version info, converting it to ANSI                 ' from Unicode if this is the second attempt to                 ' get it.                 If n = 1 Then                         sVersion = sVerInfo                     Else                         sVersion = StrConv(sVerInfo, vbFromUnicode)                 End If                          ' Got version stuff - search for 'file version'.                 ' This looks like :- FileVersion ?.?.?.?                 nPos = InStr(1, sVersion, sSEARCH, 1)                                  ' If we found it.                 If 0 <> nPos Then                                          ' The version comes after the 'FileVersion'                      ' string so chop off everything until the first                      ' byte of the version from the front of the                     ' string.                     sVersion = Trim$(Mid$(sVersion, nPos + _                                           Len(sSEARCH)))                                          ' Clear any remaining leading NULLS.                     Do While Left$(sVersion, 1) = vbNullChar                         sVersion = Right$(sVersion, _                                           Len(sVersion) - 1)                     Loop                                          ' The version is terminated by a Null (Chr$(0)).                     NPos = InStr(sVersion, vbNullChar)                                          ' Found the end so pull off nPos bytes                      ' to get the version.                     If 0 <> nPos Then                         ' String version is ...                         sVer = Left$(sVersion, nPos - 1)                     End If                 End If                                  ' If we are left with some text, the                 ' Version Info was found.                 If sVer <> "" Then Exit For             Next n     End If     ' Set function return value to the string version in full.     GetOLEAUT32Version = sVersion End Function Private Function bPiEnumDateFormatsProc(ByVal lpstrFormat As Long) _     As Long ' The address to this function is passed to the API function ' EnumDateFormatsA that will then call it, passing a pointer ' to a string containing the requested system Date format.          ' Store the date format module wide, so that it can be     ' read by the originating VB function. As the value passed     ' to this function is a pointer to a string, something that VB     ' does not directly understand, we use another function to     ' retrieve the string that the pointer points to.     m_sDateFormat = sPiGetStringFromPointerANSI(lpstrFormat)          ' Return True, indicating that      ' EnumDateFormatsA can continue enumerating.     BpiEnumDateFormatsProc = True End Function Public Function GetSystemDateWindow() As Integer ' This routine calculates the extremes of the date window ' currently provided by OLEAUT32.  It does this by finding ' where the century assigned to the years 0 to 99 changes.     Dim nYear           As Integer     Dim nWindowedYear   As Integer     Dim nLastYear       As Integer          '   Setup the initial year to compare to.     NlastYear = Year(DateSerial(0, 1, 20))          ' Setup the return value to default to the year assigned to     ' "00". If this routine does not detect a shift in the century     ' applied to the values 0 _ 99, the window must start at     ' the century.     GetSystemDateWindow = nLastYear     ' Go through each year in a single century 0 - 99. Look for     ' a change in the century assigned to these years. This will     ' be the pivot date, the bottom date in the date window.     For nYear = 0 To 99         nWindowedYear = Year(DateSerial(nYear, 1, 20))              ' Compare the current year to the previous one; if the         ' century assignment has changed we have the Pivot year.         If (nWindowedYear \ 100) <> (nLastYear \ 100) Then             GetSystemDateWindow = nWindowedYear         End If                  NLastYear = nWindowedYear     Next nYear End Function Private Function sPiGetStringFromPointerANSI _                  (ByVal lPointer As Long) As String ' This function will return the text pointed to by the passed ' pointer. VB does not support pointers, which are often ' returned by API calls. This function might be used to retrieve ' a string passed to VB by an API call as a pointer.     Dim sBuffer     As String     Dim lSize       As Long          ' Get the length of the string pointed to.     lSize = Winlstrlen(lPointer)          ' Size the destination, so that it is large enough.     Sbuffer = String$(lSize + 1, vbNullChar)          ' Copy the contents of the memory pointed to     ' by the passed Long value into the Buffer.     WinCopyMemory sBuffer, lPointer, lSize          ' Return the contents of the buffer, up to     ' the first NULL (Ascii 0) which will have been     ' used by the API to indicate the end of the string.     sPiGetStringFromPointerANSI = _             Left$(sBuffer, InStr(sBuffer, vbNullChar)) End Function

The book's companion CD contains an ActiveX EXE project named DateInfo that uses this module to provide this information as properties of a CDateInfo class, once you have included SystemDateInfo in your application's references. Additionally, because the project is an EXE it can be launched manually to provide this information visually. Figure 8-8 shows the DateInfo application.

Figure 8-8 The DateInfo application when launched from the desktop