Returning the Current Date Formats in Windows NT

The example shows how to use the Windows API to return the current long and short date formats on Windows NT 4.0 machines. Unfortunately, Windows 95 exposes only the Locale ID in the registry unless individual elements have been changed individually, and there are a thousand and one API constants and function calls required to retrieve the settings. Such deep API work is really outside the scope of this book.

Example

Option Explicit

'declare the API Functions and constants required Private Const HKEY_CURRENT_USER = &H80000001 Private Const KEY_ACCESS = &H3F

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, _ ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) _ As Long

Declare Function RegQueryValueExNULL _

206 Chapter 7- The Language Reference

Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, _ ByVal lpData As Long, lpcbData As Long) As Long Declare Function RegQueryValueExString _

Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, _ ByVal lpData As String, lpcbData As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long

Public Function CurrentDateFormat(sType As String) _ As String

CurrentDateFormat = _

QueryDateFormat("Control Panel\International", "s" & sType & "Date")

End Function

Private Function QueryDateFormat(sKeyName As String, sValueName As String) As String

On Error GoTo QueryDateFormat_Err

Dim lReturn As Long 'API Call return value

Dim lhKey As Long Dim sValueSetting As String Dim lCCh As Long

Dim lType As Long

Dim lValue As Long

'handle of opened key 'date format setting

'open the registry key lReturn = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, _

0, KEY_ACCESS, lhKey) 'get the legnth of the setting lReturn = RegQueryValueExNULL(lhKey, sValueName, _

Err.Raise 40000, App.Title, _

"Can't get registry key value"

Else

'pad a string to the legnth of the setting sValueSetting = String(lCCh, 0) 'query the setting lReturn = RegQueryValueExString(lhKey, sValueName,

0&, lType, sValueSetting, lCCh) If lReturn = 0 Then

QueryDateFormat = Left$(sValueSetting, lCCh) Else

QueryDateFormat = "" End If

s

30

<B

<B

<B

a

<B

DateValue Function 207

End If

'close the registry key RegCloseKey (lhKey)

Exit Function

QueryDateFormat_Err:

MsgBox Err.Description End Function

...which can be accessed simply from the client like this... Option Explicit

Private Sub Command1_Click()

MsgBox CurrentDateFormat("Long") End Sub

Private Sub Command2_Click()

MsgBox CurrentDateFormat("Short") End Sub

See Also

CDate Function, DateSerial Function, IsDate Function

0 0

Post a comment