I've got the Country Code List RIGHT HERE!!!!
Realy nice that answer but it not what I ment.
So I have made my own system. It needs a lot af finetuning but the main key is there.
This code wil make an Array filled with the Number of a county and the name of the country. The only thing to do is put it under a combo or listbox.
Here's the code.
Option Explicit
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_DYN_DATA = &H80000006
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_USERS = &H80000003
Private Const REG_BINARY = 3 ' Free form binary
Private Const REG_SZ = 1 ' Unicode nul terminated string
Private Const ERROR_SUCCESS = 0&
Private Const strSubKey As String = "Software\Microsoft\Windows\CurrentVersion\Telephony\Country List"
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Sub Form_Load()
Dim strArray() As String
Dim SubKeys As Variant
Dim KeyLoop As Integer
Dim Data As String
SubKeys = GetAllKeys(HKEY_LOCAL_MACHINE, strSubKey)
If VarType(SubKeys) = vbArray + vbString Then
ReDim strArray(UBound(SubKeys), 1)
For KeyLoop = 0 To UBound(SubKeys)
strArray(KeyLoop, 0) = SubKeys(KeyLoop)
strArray(KeyLoop, 1) = Read_Reg_Value(strSubKey & "\" & SubKeys(KeyLoop), "Name")
Next
End If
ComboBox1.List = strArray
End Sub
Public Function GetAllKeys(hKey As Long, _
strPath As String) As Variant
Dim lRegResult As Long
Dim lCounter As Long
Dim hCurKey As Long
Dim strNames() As String
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
lCounter = 0
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
Do
'initialise buffers (longest possible length=255)
lDataBufferSize = 255
strBuffer = String(lDataBufferSize, " ")
lRegResult = RegEnumKey(hCurKey, _
lCounter, strBuffer, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
'tidy up string and save it
ReDim Preserve strNames(lCounter) As String
intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1)
Else
strNames(UBound(strNames)) = strBuffer
End If
lCounter = lCounter + 1
Else
Exit Do
End If
Loop
GetAllKeys = strNames
End Function
Public Function Read_Reg_Value(strPath As String, strValue As String, Optional Default As String) As String
Dim lValueType As Long
Dim lResult As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
Dim hCurKey As Long
If Not IsEmpty(Default) Then
Read_Reg_Value = Default
Else
Read_Reg_Value = ""
End If
lRegResult = RegOpenKey(HKEY_LOCAL_MACHINE, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lRegResult = 0 Then
strBuffer = String(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
Read_Reg_Value = Left$(strBuffer, intZeroPos - 1)
Else
Read_Reg_Value = strBuffer
End If
End If
Else
MsgBox "A problem has occured"
End If
lRegResult = RegCloseKey(hCurKey)
End Function
Put it in your form and test it. It worked fin with my program.
