[VBnet Locale] EnumSystemLocales: Enumerate Installed and Supported System Locales

	Visual Basic Locale/Regionalization Routines EnumSystemLocales: Enumerate Installed and Supported System Locales

Posted:	Tuesday November 9, 1999
Updated:	Monday December 26, 2011

Applies to:	VB5, VB6
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	EnumSystemLocales: Enumerate Installed and Supported System Locales GetLocaleInfo: Regional Locale Country Settings GetLocaleInfo: System Calendar Information

Prerequisites

None.

In addition to locale information pertaining to the current system setting, the EnumSystemLocales API provides the means to enumerate via callbacks all supported or installed national language support for a given system. Armed with the country LCID's returned by the call, an application can retrieves strings representing times, dates, and other information that are correctly formatted for the given language and location of the world. National language support also includes support for keyboard layouts and language-specific fonts.

The single value returned from the callback - lpLocaleString - is a pointer to a string buffer containing a null-terminated country code represented in hex format, for example 00000409. Of this string, the last 4 characters represent the hexadecimal country code - &H0409, which translates to 1033 decimal, or English (United States). Note that lpLocaleString should be an LPWSTR for the Unicode (W) version of EnumSystemLocales, and an LPSTR for the ANSI (A) version of EnumSystemLocales.

This demo shows retrieving the string, extracting and converting the country code representation, and calling the GetUserLocaleInfo API to retrieve the code page language in both standard and abbreviated formats.

BAS Module Code

Place the following code into the general declarations area of a bas module:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Const LOCALE_SLANGUAGE       As Long = &H2  'localized name of language
Public Const LOCALE_SABBREVLANGNAME As Long = &H3  'abbreviated language name
Public Const LCID_INSTALLED         As Long = &H1  'installed locale ids
Public Const LCID_SUPPORTED         As Long = &H2  'supported locale ids
Public Const LCID_ALTERNATE_SORTS   As Long = &H4  'alternate sort locale ids

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 EnumSystemLocales Lib "kernel32" _
  Alias "EnumSystemLocalesA" _
  (ByVal lpLocaleEnumProc As Long, _
   ByVal dwFlags As Long) As Long


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

   Dim sReturn As String
   Dim nSize As Long

  'call the function passing the Locale type
  'variable to retrieve the required size of
  'the string buffer needed
   nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
    
  'if successful..
   If nSize Then
    
     'pad a buffer with spaces
      sReturn = Space$(nSize)
       
     'and call again passing the buffer
      nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
     
     'if successful (nSize > 0)
      If nSize Then
      
        'nSize holds the size of the string
        'including the terminating null
         GetUserLocaleInfo = Left$(sReturn, nSize - 1)
      
      End If
   
   End If
    
End Function


Public Function EnumSystemLocalesProc(lpLocaleString As Long) As Long

  'application-defined callback function for EnumSystemLocales

   Dim pos As Integer
   Dim dwLocaleDec As Long
   Dim dwLocaleHex As String
   Dim sLocaleName As String
   Dim sLocaleAbbrev As String
     
  'pad a string to hold the format
   dwLocaleHex = Space$(32)
   
  'copy the string pointed to by the return value
   CopyMemory ByVal dwLocaleHex, lpLocaleString, ByVal Len(dwLocaleHex)
   
  'locate the terminating null
   pos = InStr(dwLocaleHex, Chr$(0))
   
   If pos Then
     'strip the null
      dwLocaleHex = Left$(dwLocaleHex, pos - 1)
      
     'we need the last 4 chrs - this
     'is the locale ID in hex
      dwLocaleHex = (Right$(dwLocaleHex, 4))
      
     'convert the string to a long
      dwLocaleDec = CLng("&H" & dwLocaleHex)
      
     'get the language and abbreviation for that locale
      sLocaleName = GetUserLocaleInfo(dwLocaleDec, LOCALE_SLANGUAGE)
      sLocaleAbbrev = GetUserLocaleInfo(dwLocaleDec, LOCALE_SABBREVLANGNAME)
   End If
   
  'add the data to the list
   Form1.List1.AddItem "   " & dwLocaleHex & vbTab & _
                               dwLocaleDec & vbTab & _
                               sLocaleAbbrev & vbTab & _
                               sLocaleName
   
  'and return 1 to continue enumeration
   EnumSystemLocalesProc = 1
   
End Function

Form Code

Create a form containing a text box (Text1), a command button (Command1) and a listbox (List1). Label as desired, and add the following code to the form:

Option Explicit

Private Sub Command1_Click()

   Dim LCID As Long
   
  'get the user's current default ID
   LCID = GetSystemDefaultLCID()
   
  'show the current localized name of language
   Text1.Text = GetUserLocaleInfo(LCID, LOCALE_SLANGUAGE) & vbTab & _
                GetUserLocaleInfo(LCID, LOCALE_SABBREVLANGNAME)
   
  
  'add a list caption, and enumerate the
  'installed system locales
   List1.AddItem "Installed Locales:"
   List1.AddItem "   hex" & vbTab & "dec" & vbTab & "abv" & vbTab & "language"
   Call EnumSystemLocales(AddressOf EnumSystemLocalesProc, LCID_INSTALLED)
   
   
  'add a list caption, and enumerate the
  'supported system locales
   List1.AddItem ""
   List1.AddItem "Supported Locales:"
   List1.AddItem "   hex" & vbTab & "dec" & vbTab & "abv" & vbTab & "language"
   Call EnumSystemLocales(AddressOf EnumSystemLocalesProc, LCID_SUPPORTED)
   
End Sub

Comments

Save the program and run. The values displayed will correspond to the Codepage (in hex and decimal), as well as the code page name in full and abbreviated form.

While the GetSystemDefaultLCID function retrieves the system default locale identifier, this is often inappropriate or insufficient in a networked environment or under an operating system where multiple locales have been installed. For example, it is possible for a network admin rolling out a standard image to have the user's default locale set to one differing from the base OS installation, and thus the system default locale.

In this situation Windows' provides an alternate API you can use to obtain the LCID for the current user ... GetUserDefaultLCID. Defined identically to GetSystemDefaultLCID, GetUserDefaultLCID function retrieves the user default–locale identifier and is therefore the most appropriate API to use when it is the user's locale you are interested in, rather than that of the system.

PayPal Link