GetLocaleInfoEx bombs out

[PhilOfWalton]

I have been using GetLocaleInfo for some time (mainly to get country names) and this works perfectly.

I read somewhere, this has been replaces by GetLocaleInfoEx.

I can't get this to work and it crashes Access.

Sorry the code is a bit long winded

Option Compare Database
Option Explicit
 
Public Const LOCALE_ALL = &H2                   ' 2 All information
Public Const LOCALE_SYSTEM_DEFAULT& = &H800
Public Const LOCALE_NAME_USER_DEFAULT = vbNullString
Public Const LOCALE_SNATIVELANGNAME As Long = &H4 ' native name of language
Public Const LOCALE_ICOUNTRY As Long = &H5
Public Const LOCALE_SCOUNTRY As Long = &H6
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7
Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 ' native name of country
Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 ' English name of language
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 ' English name of country
Public Const LOCALE_ILANGUAGE As Long = &H1
Public Const LOCALE_SLANGUAGE As Long = &H2
 
Const cMAXLEN = 255
Private 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
 
Private Declare Function GetLocaleInfoEx Lib "kernel32" (ByVal LocaleNmae As String, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
 
Public Function CountryName(Optional InfoRequired As Long) As String
 
    Dim lngLocale As Long
    Dim strLCData As String, lngData As Long
    Dim lngX As Long
    Dim Lngi As Long
 
    strLCData = String$(cMAXLEN, 0)
    lngData = cMAXLEN - 1
    If InfoRequired = 2 Or Nz(InfoRequired) = 0 Then
        For Lngi = 1 To 120
            lngX = GetLocaleInfo(LOCALE_USER_DEFAULT, Lngi, strLCData, lngData)
            If lngX <> 0 Then
                Debug.Print LOCALE_USER_DEFAULT & "   " & Lngi & "   " & Left$(strLCData, lngX - 1)
            End If
        Next Lngi
    Else
        lngX = GetLocaleInfo(LOCALE_USER_DEFAULT, InfoRequired, strLCData, lngData)
        If lngX <> 0 Then
            CountryName = Left$(strLCData, lngX - 1)
            'Debug.Print LOCALE_USER_DEFAULT & "   " & Left$(strLCData, lngX - 1)
        End If
    End If
 
End Function
 
Public Function Example()
 
    Dim lpLCData As String
    Dim bufferSize As Long
    Dim RetVal
    Dim lngX As Long
    Dim Lngi As Long
 
    For Lngi = 1 To 120
        'Get return buffer size.
        RetVal = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, lpLCData, 0)
        'GetLocaleInfoEx returns 0 on failure.
        If RetVal <> 0 Then
            'Use that value to size your buffer...
            lpLCData = String(RetVal, Chr$(0))
            '...and pass the appropriate buffer/size parameters.
            lngX = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, lpLCData, RetVal)
            If lngX <> 0 Then
                Debug.Print lpLCData
            Else
                Debug.Print GetLastError
            End If
        Else
            Debug.Print GetLastError
        End If
    Next Lngi
 
End Function
 

The CountryName example works, but the Example tries to print something, then Access crashes.

Grateful for any observations

Phil

[ADezii]

Try changing the manner in which your allocated your Buffer Size, I am referring to Code Line# 130.

Public Function Example()
10 Dim lpLCData As String
20 Dim bufferSize As Long
30 Dim RetVal
40 Dim lngX As Long
50 Dim Lngi As Long
60
70 For Lngi = 1 To 120
80  'Get return buffer size.
90   RetVal = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, lpLCData, 0)
100  'GetLocaleInfoEx returns 0 on failure.
120  If RetVal <> 0 Then
130    lpLCData = String$(cMAXLEN, 0)
140
150    '...and pass the appropriate buffer/size parameters.
160    lngX = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, lpLCData, RetVal)
170
180    If lngX <> 0 Then
190      Debug.Print lpLCData
200    Else
210      Debug.Print GetLastError
220    End If
230  Else
240    Debug.Print GetLastError
250  End If
260 Next Lngi
End Function

[PhilOfWalton]

Thanks as ever for that. At least it doesn't bomb out.

The difference now is the first version (CounrtyName) prints out all the fields normally, and in the new version (Example) there is a space between each letter. Obviously I can code this to remove the space, but the question is "is this the way the data is stored or is it a glitch in the way the data is displayed?"

Again thanks

Phil

[ADezii]

I would try experimenting with the Buffer Size, I allocated what I thought was the MAX.

[PhilOfWalton]

Thanks ADezii. That put me on the right track.

This is what works

Public Function CountryName(Optional InfoRequired As Long) As String
 
    Dim strLCData As String
    Dim BufferSize As Long
    Dim lngX As Long
    Dim Lngi As Long
    Dim LngStart As Long
    Dim LngEnd As Long
 
    If InfoRequired = LOCALE_ALL Or Nz(InfoRequired) = 0 Then
        LngStart = 1
        LngEnd = 120
    Else
        LngStart = InfoRequired
        LngEnd = InfoRequired
    End If
 
    For Lngi = LngStart To LngEnd
        'Get return buffer size.
        BufferSize = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, strLCData, 0)
        'GetLocaleInfoEx returns 0 on failure.
        If BufferSize <> 0 Then
            strLCData = String$(cMAXLEN, 0)
            '...and pass the appropriate buffer/size parameters.
            lngX = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, Lngi, strLCData, BufferSize)
            If lngX <> 0 Then
                ' There appear to be blanks (Chr$(0) betweeen each letter, so remove them
                strLCData = Replace(strLCData, Chr$(0), "")
                If LngStart = LngEnd Then                   ' single value required
                    'Debug.Print Left(strLCData, BufferSize)
                    CountryName = Left(strLCData, BufferSize)
                Else
                    Debug.Print Lngi; "   "; Left(strLCData, BufferSize)
                End If
            Else
                Debug.Print GetLastError
            End If
        Else
            Debug.Print GetLastError
        End If
    Next Lngi
 
End Function
 

Best wishes

Phil

[ADezii]

Glad you got it all working, Phil.