| Microsoft Year 2000 Readiness Disclosure
& Resource Center |
|
|
|
| Developing Year 2000 Compliant
Applications in Microsoft Visual Basic |
|
9. Find Out More about Your DateÆs
Background
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 Control Panel. Both of these dependencies
can alter the way applications interpret and report dates.
Unfortunately, retrieving this information in
Visual Basic can be a tricky. Listing 8-7 is a module that
provides functions to get this information from the system. It
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 startup
routines. If the OLEAUT32.dllÆs version number is not one you
expect, you can abort the startup and display a message to the user
about contacting the Help desk.
Note This application is on the
companion file tmsy2k.zip in the Chap08\Date Environment folder.
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
Listing 8-7 The Date Information
module
This
handbookÆs companion .zip file 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 it is an .exe the module can be launched manually to provide
this information visually. Figure 8 shows the DateInfo application.
Figure 8 The DateInfo application when
launched from the desktop.
|
|
|
