Binaryworld - How to retrive and change system's short/long date format ... [ VB -> Date-Time ]

This article will demonstrate how to retrive system's local name and short/long date format. It will also show you how to change current short/long date format of the system.

To implement Copy/Paste Demo

- Create a standard exe project
- Add a module
- Place 3 labels on the form1 (to diaplay local name, short date format and long date format)
- Place 2 command buttons on the form1 (to change short/long date format)
- Place 2 list box on the form1 (to display all short/long date formats available)

Place the following code in the form1 declaration

Form1.frm

Click here to copy the following block

Private Sub Command1_Click()
  Call ChangeSystemShortDateFormat
End Sub

Private Sub Command2_Click()
  ChangeSystemLongDateFormat
End Sub

'//////////////////////////////////
'All Steps are in different sub to show more clear example
'//////////////////////////////////
Private Sub Form_Load()
  Call ShowLocal  'Current local name
  Call ShowCurrentDateFormats  'Current short/long dateformats of the system
  Call FillShortAndLongDateFormats  'Enum all available Short/Long date formats
End Sub

'//////////////////////////////////
'show localized name of language
'//////////////////////////////////
Sub ShowLocal()
  Dim LCID As Long
  LCID = GetSystemDefaultLCID()

  Label1 = GetUserLocaleInfo(LCID, LOCALE_SLANGUAGE)
End Sub

'//////////////////////////////////
'show localized name of language
'//////////////////////////////////
Sub ShowCurrentDateFormats()
  Dim LCID As Long
  LCID = GetSystemDefaultLCID()

  'Show the user's short date format string
  Label2 = GetUserLocaleInfo(LCID, LOCALE_SSHORTDATE)

  'Show the user's Long date format string
  Label3 = GetUserLocaleInfo(LCID, LOCALE_SLONGDATE)
End Sub

'//////////////////////////////////
'Enum all short/long date formats
'//////////////////////////////////
Sub FillShortAndLongDateFormats()
  Dim LCID As Long
  LCID = GetSystemDefaultLCID()
  List1.Clear
  List2.Clear
  'enumerate available short date formats
  Set targetCtl = Me.List1
  Call EnumDateFormats(AddressOf EnumCalendarDateProc, LCID, DATE_SHORTDATE)

  'enumerate available long date formats
  Set targetCtl = Me.List2
  Call EnumDateFormats(AddressOf EnumCalendarDateProc, LCID, DATE_LONGDATE)
End Sub

'//////////////////////////////////
'Change system long date format
'//////////////////////////////////
Sub ChangeSystemLongDateFormat()
  Dim LCID As Long
  Dim sNewFormat As String

  LCID = GetSystemDefaultLCID()

  If List2.ListIndex < 0 Then Exit Sub
  sNewFormat = List2.List(List2.ListIndex)

  If Len(sNewFormat) > 0 Then
    'set the new long date format
    Call SetLocaleInfo(LCID, LOCALE_SLONGDATE, sNewFormat)

    'send a system notification message that a change was made
    Call PostMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, ByVal 0&)

    'Refresh information
    Call ShowLocal
    Call ShowCurrentDateFormats
    Call FillShortAndLongDateFormats
  End If
End Sub

'//////////////////////////////////
'Change system short date format
'//////////////////////////////////
Sub ChangeSystemShortDateFormat()
  Dim LCID As Long
  Dim sNewFormat As String

  LCID = GetSystemDefaultLCID()

  If List1.ListIndex < 0 Then Exit Sub
  sNewFormat = List1.List(List1.ListIndex)

  If Len(sNewFormat) > 0 Then
    'set the new long date format
    Call SetLocaleInfo(LCID, LOCALE_SSHORTDATE, sNewFormat)

    'send a system notification message that a change was made
    Call PostMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, ByVal 0&)

    'Refresh information
    Call ShowLocal
    Call ShowCurrentDateFormats
    Call FillShortAndLongDateFormats
  End If
End Sub

Place the following code in the module1

Module1.bas

Click here to copy the following block

Option Explicit

Public targetCtl

'Dim targetCtl As ComboBox
'Dim targetCtl As ListBox

Public Const LOCALE_SLANGUAGE As Long = &H2  'localized name of language
Public Const LOCALE_SSHORTDATE As Long = &H1F  'short date format string
Public Const LOCALE_SLONGDATE As Long = &H20  'long date format string
Public Const DATE_LONGDATE As Long = &H2
Public Const DATE_SHORTDATE As Long = &H1
Public Const HWND_BROADCAST As Long = &HFFFF&
Public Const WM_SETTINGCHANGE As Long = &H1A

Public Declare Function PostMessage Lib "user32" _
    Alias "PostMessageA" _
    (ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long

Public Declare Function EnumDateFormats Lib "kernel32" _
    Alias "EnumDateFormatsA" _
    (ByVal lpDateFmtEnumProc As Long, _
    ByVal Locale As Long, _
    ByVal dwFlags As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

Public Declare Function GetLocaleInfo Lib "kernel32" _
    Alias "GetLocaleInfoA" _
    (ByVal Locale As Long, _
    ByVal LCType As Long, _
    ByVal lpLCData As String, _
    ByVal cchData As Long) As Long

Public Declare Function SetLocaleInfo Lib "kernel32" _
    Alias "SetLocaleInfoA" _
    (ByVal Locale As Long, _
    ByVal LCType As Long, _
    ByVal lpLCData As String) As Long

Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, _
                 ByVal dwLCType As Long) As String
  Dim sReturn As String
  Dim r As Long

  'call the function passing the Locale type
  'variable to retrieve the required size of
  'the string buffer needed
  r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))

  'if successful..
  If r Then
    'pad the buffer with spaces
    sReturn = Space$(r)
    'and call again passing the buffer
    r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
    'if successful (r > 0)
    If r Then
      'r holds the size of the string
      'including the terminating null
      GetUserLocaleInfo = Left$(sReturn, r - 1)
    End If
  End If
End Function

Public Function EnumCalendarDateProc(DateFormatString As Long) As Long
'application-defined callback function for EnumDateFormats
'populates combo assigned to global var targetCtl
  targetCtl.AddItem StringFromPointer(DateFormatString)

  'return 1 to continue enumeration
  EnumCalendarDateProc = 1
End Function

Private Function StringFromPointer(lpString As Long) As String
  Dim pos As Long
  Dim buffer As String

  'pad a string to hold the data
  buffer = Space$(128)

  'copy the string pointed to by the return value
  CopyMemory ByVal buffer, lpString, ByVal Len(buffer)

  'remove the trailing null and trim
  pos = InStr(buffer, Chr$(0))

  If pos Then
    StringFromPointer = Left$(buffer, pos - 1)
  End If
End Function