هل يوجد كود لمعرفة لغة النظام والبلد

الأخ الفاضل ...

جرب أستخدام الكود التالى (منقول):

Option Explicit

Public Enum eInternational
    eiCountryID
    eiCountryName
    eiCurrDigits
    eiCurrencyID
    eiCurrencySymbol
    eiDateID
    eiDateSeperator
    eiDigits
    eiLZero
    eiMeasure
    eiNegCurr
    eiTimeSeperator
    eiTLZero
    eiLocale
    eiAM
    eiPM
    eiDecimal
    eiLanguage
    eiList
    eiLongDate
    eiShortDate
    eiThousand
    eiTimeID
    eiTimeFormat
    eiTimePrefix
    eiMonDecimalSep
    eiMonThousandSep
    eiNegNumber
    eiNativeDigits
    eiNumShape
    eiCalendarType
    eiFirstDayOfWeek
    eiFirstWeekOfYear
    eiGrouping
    eiMonGrouping
    eiPositiveSign
    eiNegativeSign
End Enum


Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Function RegionSetting(eSetting As eInternational, Optional sDefault As String = "") As String
    Const REG_SZ = 1, HKEY_CURRENT_USER = &H80000001, REG_BINARY = 3, ERROR_SUCCESS As Long = 0
    Dim sSetting As String, sValueName As String
    Dim lValueType As Long, sBuffer As String, lDataBufSize As Long, iValue As Long, lhKey As Long

    Select Case eSetting
    Case eiCountryID
        sSetting = "iCountry"
    Case eiCurrDigits
        sSetting = "iCurrDigits"
    Case eiCurrencyID
        sSetting = "iCurrency"
    Case eiDateID
        sSetting = "iDate"
    Case eiDigits
        sSetting = "iDigits"
    Case eiLZero
        sSetting = "iLZero"
    Case eiMeasure
        sSetting = "iMeasure"
    Case eiNegCurr
        sSetting = "iNegCurr"
    Case eiTimeID
        sSetting = "iTime"
    Case eiTLZero
        sSetting = "iTLZero"
    Case eiLocale
        sSetting = "Locale"
    Case eiAM
        sSetting = "s1159"
    Case eiPM
        sSetting = "s2359"
    Case eiCountryName
        sSetting = "sCountry"
    Case eiCurrencySymbol
        sSetting = "sCurrency"
    Case eiDateSeperator
        sSetting = "sDate"
    Case eiDecimal
        sSetting = "sDecimal"
    Case eiLanguage
        sSetting = "sLanguage"
    Case eiList
        sSetting = "sList"
    Case eiLongDate
        sSetting = "sLongDate"
    Case eiShortDate
        sSetting = "sShortDate"
    Case eiThousand
        sSetting = "sThousand"
    Case eiTimeSeperator
        sSetting = "sTime"
    Case eiTimeFormat
        sSetting = "sTimeFormat"
    Case eiTimePrefix
        sSetting = "iTimePrefix"
    Case eiMonDecimalSep
        sSetting = "sMonDecimalSep"
    Case eiMonThousandSep
        sSetting = "sMonThousandSep"
    Case eiNegNumber
        sSetting = "iNegNumber"
    Case eiNativeDigits
        sSetting = "sNativeDigits"
    Case eiNumShape
        sSetting = "NumShape"
    Case eiCalendarType
        sSetting = "iCalendarType"
    Case eiFirstDayOfWeek
        sSetting = "iFirstDayOfWeek"
    Case eiFirstWeekOfYear
        sSetting = "iFirstWeekOfYear"
    Case eiGrouping
        sSetting = "sGrouping"
    Case eiMonGrouping
        sSetting = "sMonGrouping"
    Case eiPositiveSign
        sSetting = "sPositiveSign"
    Case eiNegativeSign
        sSetting = "sNegativeSign"
    Case Else
        Debug.Print "Invalid Setting"
        Debug.Assert False
    End Select

    'Retreive information from registry
    sValueName = "Control Panel\International"
    RegOpenKey HKEY_CURRENT_USER, sValueName, lhKey

    'Determine the value type
    If RegQueryValueEx(lhKey, sSetting, 0, lValueType, ByVal 0, lDataBufSize) = ERROR_SUCCESS Then
        If lValueType = REG_SZ Then
            'Create a buffer to hold the value
            sBuffer = String(lDataBufSize, 0)
            'Get the value
            If RegQueryValueEx(lhKey, sSetting, 0, 0, ByVal sBuffer, lDataBufSize) = ERROR_SUCCESS Then
                'Return the key value
                RegionSetting = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
            Else
                'Return the default value
                RegionSetting = sDefault
            End If

        ElseIf lValueType = REG_BINARY Then
            If RegQueryValueEx(lhKey, sValueName, 0, 0, iValue, lDataBufSize) = ERROR_SUCCESS Then
                'Return the key value
                RegionSetting = iValue
            Else
                'Return the default value
                RegionSetting = sDefault
            End If
        End If
    Else
        'Return the default value
        RegionSetting = sDefault
    End If
    'Close the key
    RegCloseKey lhKey
End Function

Private Sub Form_Load()
    MsgBox RegionSetting(eiCountryName)
    MsgBox RegionSetting(eiLanguage)
End Sub

شكراً

ألف شكر لكم أخواني على سرعة المساعدة

الكود للفائدة

Const LOCALE_USER_DEFAULT = &H400
Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country
Const LOCALE_SENGLANGUAGE = &H1001  ' English name of language
Const LOCALE_SNATIVELANGNAME = &H4  ' native name of language
Const LOCALE_SNATIVECTRYNAME = &H8  ' native name of country
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 Sub Form_Load()
	'KPD-Team 2001
	'URL: http://www.allapi.net/
	'E-Mail: KPDTeam@Allapi.net
	MsgBox "You live in " & GetInfo(LOCALE_SENGCOUNTRY) & " (" & GetInfo(LOCALE_SNATIVECTRYNAME) & ")," & vbCrLf & "and you speak " & GetInfo(LOCALE_SENGLANGUAGE) & " (" & GetInfo(LOCALE_SNATIVELANGNAME) & ").", vbInformation
End Sub
Public Function GetInfo(ByVal lInfo As Long) As String
	Dim Buffer As String, Ret As String
	Buffer = String$(256, 0)
	Ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
	If Ret > 0 Then
		GetInfo = Left$(Buffer, Ret - 1)
	Else
		GetInfo = ""
	End If
End Function