Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0206: Verfügbare Ländereinstellungen auslesen

VB 5/6-Tipp 0206: Verfügbare Ländereinstellungen auslesen

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), EnumSystemLocalesA (EnumSystemLocales), GetLocaleInfoA (GetLocaleInfo)

Download: Download des Beispielprojektes [2,92 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Optionsfeld-Steuerelement "Option1" (Index von 0 bis 2)
Option Explicit

Private Sub Form_Load()
  Option1(0).Value = True
End Sub

Private Sub Option1_Click(Index As Integer)
  Call EnumLocales(Index, List1)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Private Declare Function EnumSystemLocales Lib "kernel32" _
        Alias "EnumSystemLocalesA" (ByVal lpLocaleEnumProc _
        As Long, ByVal dwFlags As Long) As Long

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

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
   
Const LCID_INSTALLED = &H1
Const LCID_SUPPORTED = &H2
Const LCID_ALTERNATE_SORTS = &H4

Const LOCALE_SNATIVELANGNAME = &H4
Const LOCALE_SNATIVECTRYNAME = &H8

Dim LCID() As Long

Public Sub EnumLocales(Mode%, LB As ListBox)
  Dim x%, aa$, Flag&
    
    Select Case Mode
      Case 0:    Flag = LCID_INSTALLED
      Case 1:    Flag = LCID_SUPPORTED
      Case 2:    Flag = LCID_ALTERNATE_SORTS
      Case Else: Flag = 0
    End Select
    
    If Flag Then
      ReDim LCID(0 To 0)
      LB.Clear
      
      Call EnumSystemLocales(AddressOf LocaleEnumProc, Flag)
      For x = 0 To UBound(LCID) - 1
        aa = CStr(LCID(x)) & " "
        aa = aa & GetEntry(LCID(x), _
                           LOCALE_SNATIVECTRYNAME) & " ["
        aa = aa & GetEntry(LCID(x), _
                           LOCALE_SNATIVELANGNAME) & "]"
        LB.AddItem aa
      Next x
    Else
      MsgBox ("Diese Option wird nicht unterstützt!")
    End If
End Sub

Private Function LocaleEnumProc(LICD_Pointer&) As Long
  Dim Buffer$
  
    Buffer = Space$(255)
    Call CopyMemory(ByVal Buffer, LICD_Pointer, Len(Buffer))
    Buffer = "&H" & Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
    LCID(UBound(LCID)) = CLng(Buffer)
    ReDim Preserve LCID(0 To UBound(LCID) + 1)
    LocaleEnumProc = 1&
End Function

Private Function GetEntry(LCID&, ID&) As String
  Dim Result&, Buffer$, Length&

    Length = GetLocaleInfo(LCID, ID, Buffer, 0) - 1
    If Length > 0 Then
      Buffer = Space(Length + 1)
      Result = GetLocaleInfo(LCID, ID, Buffer, Length)
      GetEntry = Left$(Buffer, Length)
    End If
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.