[VBnet Locale] GetGeoInfo: Determine Geographic Country Info by GeoID

	Visual Basic Locale/Regionalization Routines GetGeoInfo: Determine Geographic Country Info by GeoID

Posted:	Sunday August 15, 2004
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	Windows ME, Windows XP, Windows Server 2003
Author:	VBnet - Randy Birch

Related:	GetGeoInfo: Obtaining Country List by Enumerating GeoIDs GetGeoInfo: Determine Geographic Country Info by GeoID EnumSystemLocales: Enumerate Installed and Supported System Locales GetLocaleInfo: Regional Locale Country Settings

Prerequisites

Windows ME, Windows XP or Windows Server 2003.

If you're running Windows ME, XP or Windows Server 2003 you have available an API that will return info about a specific geographical area. This page shows how to enumerate the available GeoIDs on a system and retrieve the specific information or each GeoID.

Although the routines are presented individually to more easily incorporate a specific wrapper in your app, they could easily be combined if the type of information requested was passed as a parameter to the function.

Because this demo implements an enumeration routine a BAS module is required.

BAS Module Code

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'UDT not required in working code. Its
'purpose here is to hold the GeoClas value
'determined in the form load event, and
'to receive the list index of the matching
'enumerated GeoID in order to set the list
'selection on start-up to that of the current user
Private Type GeoInfo
   gClass As Long
   gIndex As Long
End Type

Public geo As GeoInfo


Public Function EnumGeoInfoProc(ByVal geoid As Long) As Long

  'add the data to the list
   With Form1.List1
   
     'if the GeoID returned from the Enum
     'matches the GeoID determined at Load
     'for the user, append a string to that
     'combo item and record the list index
     'of that item
      If geoid <> geo.gClass Then
         .AddItem geoid
         .ItemData(.NewIndex) = geoid
      Else
         .AddItem geoid & " (user)"
         .ItemData(.NewIndex) = geoid
         geo.gIndex = .NewIndex  'save the index
      End If
      
   End With
   
  'and return 1 to continue enumeration
   EnumGeoInfoProc = 1
   
End Function

Form Code

Create a form one text box (Text1) and set its index property to 0 - the Load event will create the text boxes. Space is left for labels but those are not created as part of this demo. Add a listbox (List1) along with the following code:

Option Explicit

'SYSGEOTYPE
Private Const GEO_NATION As Long = &H1
Private Const GEO_LATITUDE As Long = &H2
Private Const GEO_LONGITUDE As Long = &H3
Private Const GEO_ISO2 As Long = &H4
Private Const GEO_ISO3 As Long = &H5
Private Const GEO_RFC1766 = &H6
Private Const GEO_LCID As Long = &H7
Private Const GEO_FRIENDLYNAME As Long = &H8
Private Const GEO_OFFICIALNAME As Long = &H9
Private Const GEO_TIMEZONES As Long = &HA
Private Const GEO_OFFICIALLANGUAGES As Long = &HB
 
'SYSGEOCLASS
Private Const GEOCLASS_NATION As Long = 16 'only valid GeoClass value at present
Private Const GEOCLASS_REGION As Long = 14 'defined but not yet supported by Windows

Private Const GEOID_NOT_AVAILABLE As Long = -1

Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

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

Private Declare Function GetUserGeoID Lib "kernel32" _
  (ByVal geoclass As Long) As Long

Private Declare Function GetGeoInfo Lib "kernel32" _
   Alias "GetGeoInfoA" _
  (ByVal geoid As Long, _
   ByVal GeoType As Long, _
   lpGeoData As Any, _
   ByVal cchData As Long, _
   ByVal langid As Long) As Long

Private Declare Function EnumSystemGeoID Lib "kernel32" _
  (ByVal geoclass As Long, _
   ByVal ParentGeoId As Long, _
   ByVal lpGeoEnumProc As Long) As Long
   
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long



Private Sub Form_Load()

   Dim cnt As Long
   
  'set up some controls
   For cnt = 0 To 8

      If cnt > 0 Then Load Text1(cnt)

      With Text1(cnt)
         .Left = 3800
         .Top = 350 + (360 * (cnt))
         .Width = 3880
         .Text = ""
         .Visible = True
      End With

   Next
   
  'get the geoclass for the current
  'user and assign to UDT member for
  'use in EnumGeoInfoProc
   geo.gClass = GetUserGeoID(GEOCLASS_NATION)
   
   Call EnumSystemGeoID(GEOCLASS_NATION, 0&, AddressOf EnumGeoInfoProc)
   
   With List1
      .Top = 160
      .Left = 3200
      .Width = 3880
      
      .Top = 160
      .Left = 120
      .Width = 1080
            
     'set listindex to the combo item
     'representing the current user GeoID
      .ListIndex = geo.gIndex
      .TopIndex = geo.gIndex
   End With
   
End Sub


Private Sub List1_Click()

   If List1.ListIndex > -1 Then
   
      Call GetGeoInformation(List1.ItemData(List1.ListIndex))
      
   End If
   
End Sub


Private Sub GetGeoInformation(geoclass As Long)

   Dim LCID As Long

   If geoclass <> GEOID_NOT_AVAILABLE Then

      LCID = GetUserDefaultLCID()

     'GEO_NATION
     'GEOID of a nation. This value is stored in a long integer
      Text1(0).Text = GetGeoNation(geoclass, LCID)

     'GEO_LATITUDE
     'The latitude of the GEOID. This value is stored in a floating point number.
      Text1(1).Text = GetGeoLatitude(geoclass, LCID)

     'GEO_LONGITUDE
     'The longitude of the GEOID. This value is stored in a floating point number.
      Text1(2).Text = GetGeoLongitude(geoclass, LCID)

     'GEO_ISO2
     'The ISO 2-letter country/region code. This value is stored in a string.
      Text1(3).Text = GetGeoISO2(geoclass, LCID)
   
     'GEO_ISO3
     'The ISO 3-letter country/region code. This value is stored in a string.
      Text1(4).Text = GetGeoISO3(geoclass, LCID)

     'GEO_RFC1766
     'An RFC1766-style string derived from the locale and GEOID (for nations only).
      Text1(5).Text = GetGeoISO3(geoclass, LCID)

     'GEO_LCID
     'A locale ID (LCID) derived from the language and the GeoID (for nations only).
      Text1(6).Text = GetGeoLanguageID(geoclass, LCID)

     'GEO_FRIENDLYNAME
     'The friendly name of the nation. Example: Germany. This value is stored in a string.
      Text1(7).Text = GetGeoFriendlyName(geoclass, LCID)

     'GEO_OFFICIALNAME
     'The official name of the nation. Example: Federal Republic of Germany. This value is stored in a string.
      Text1(8).Text = GetGeoOfficialName(geoclass, LCID)

   End If  'geoclass
   
End Sub


Private Function GetGeoFriendlyName(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_FRIENDLYNAME, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_FRIENDLYNAME, ByVal lpGeoData, cchData, LCID)
      GetGeoFriendlyName = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoOfficialName(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
  'call once with an empty string; the return 
  'value indicates the size of the buffer required 
   nRequired = GetGeoInfo(geoclass, GEO_OFFICIALNAME, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_OFFICIALNAME, ByVal lpGeoData, cchData, LCID)
      GetGeoOfficialName = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoNation(geoclass As Long, LCID As Long) As String
   
   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_NATION, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_NATION, ByVal lpGeoData, cchData, LCID)
      GetGeoNation = TrimNull(lpGeoData)
      
   End If

End Function


Private Function GetGeoLatitude(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_LATITUDE, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_LATITUDE, ByVal lpGeoData, cchData, LCID)
      GetGeoLatitude = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoLanguageID(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_LCID, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_LCID, ByVal lpGeoData, cchData, LCID)
      GetGeoLanguageID = Val(TrimNull(lpGeoData))
      
   End If
   
End Function


Private Function GetGeoLongitude(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_LONGITUDE, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_LONGITUDE, ByVal lpGeoData, cchData, LCID)
      GetGeoLongitude = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoISO2(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_ISO2, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_ISO2, ByVal lpGeoData, cchData, LCID)
      GetGeoISO2 = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoISO3(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_ISO3, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_ISO3, ByVal lpGeoData, cchData, LCID)
      GetGeoISO3 = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function GetGeoRFC1766(geoclass As Long, LCID As Long) As String

   Dim lpGeoData As String
   Dim cchData As Long
   Dim nRequired As Long
   
   lpGeoData = ""
   cchData = 0
   
   nRequired = GetGeoInfo(geoclass, GEO_RFC1766, ByVal lpGeoData, cchData, LCID)
   
   If (nRequired > 0) Then
      
      lpGeoData = Space$(nRequired)
      cchData = nRequired
        
      Call GetGeoInfo(geoclass, GEO_RFC1766, ByVal lpGeoData, cchData, LCID)
      GetGeoRFC1766 = TrimNull(lpGeoData)
      
   End If
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function

Comments

PayPal Link