Получение списка всех интернет-соединений. Добавьте на форму CommandButton и ListBox. Вставьте следующий код, запустите программу на выполнение. В ListBox'е вы получите имена всех интернет-соединений. При нажатии на CommandButton на форме будет напечатано имя интернет-соединения по умолчанию. Const REG_NONE = 0& Const REG_SZ = 1& Const REG_EXPAND_SZ = 2& Const REG_BINARY = 3& Const REG_DWORD = 4& Const REG_DWORD_LITTLE_ENDIAN = 4& Const REG_DWORD_BIG_ENDIAN = 5& Const REG_LINK = 6& Const REG_MULTI_SZ = 7& Const REG_RESOURCE_LIST = 8& Const REG_FULL_RESOURCE_DESCRIPTOR = 9& Const REG_RESOURCE_REQUIREMENTS_LIST = 10& Public rgeEntry$ Public rgeDataType& Public rgeValue$ Public rgeMainKey& Public rgeSubKey$ Const KEY_QUERY_VALUE = &H1& Const KEY_SET_VALUE = &H2& Const KEY_CREATE_SUB_KEY = &H4& Const KEY_ENUMERATE_SUB_KEYS = &H8& Const KEY_NOTIFY = &H10& Const KEY_CREATE_LINK = &H20& Const READ_CONTROL = &H20000 Const WRITE_DAC = &H40000 Const WRITE_OWNER = &H80000 Const SYNCHRONIZE = &H100000 Const STANDARD_RIGHTS_REQUIRED = &HF0000 Const STANDARD_RIGHTS_READ = READ_CONTROL Const STANDARD_RIGHTS_WRITE = READ_CONTROL Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Const KEY_EXECUTE = KEY_READ Private Type FILETIME lLowDateTime As Long lHighDateTime As Long End Type Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_USERS = &H80000003 Const HKEY_PERFORMANCE_DATA = &H80000004 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_DYN_DATA = &H80000006 Private Declare Function RegOpenKeyEx& Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&) Private Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&) Private Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&) Private Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME) Private Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME) Public Function GetRegValue(keyroot As Variant, subkey As Variant, valname As String) Const KEY_ALL_ACCESS As Long = &HF0063 Const ERROR_SUCCESS As Long = 0 Const REG_SZ As Long = 1 Dim hsubkey As Long, dwType As Long, sz As Long Dim R As Long R = RegOpenKeyEx(keyroot, subkey, 0, KEY_ALL_ACCESS, hsubkey) sz = 256 v$ = String$(sz, 0) R = RegQueryValueEx(hsubkey, valname, 0, dwType, ByVal v$, sz) If R = ERROR_SUCCESS And dwType = REG_SZ Then retval = Left$(v$, sz) GetRegValue = retval Else retval = "--Not String--" End If R = RegCloseKey(hsubkey) End Function Public Sub rgeClear() rgeMainKey = 0 rgeSubKey = "" rgeValue = "" rgeDataType = 0 rgeEntry = "" End Sub Function RegEnumKeys&(bFullEnumeration As Boolean) Dim sRoot$, sRoot2$ Dim lRtn& Dim hKey& Dim strucLastWriteTime As FILETIME Dim sSubKeyName$ Dim sClassString$ Dim lLenSubKey& Dim lLenClass& Dim lKeyIndx& Dim lRet& Dim hKey2& Dim sSubKey2$ Dim sNewKey$ Dim sClassName$ Dim lClassLen& Dim lSubKeys& Dim lMaxSubKey& Dim sMaxSubKey$ Dim lMaxClass& Dim sMaxClass$ Dim lValues& Dim lMaxValueName& Dim lMaxValueData& Dim lSecurityDesc& lRtn = RegOpenKeyEx(rgeMainKey, rgeSubKey, 0&, KEY_READ, hKey) sClassName = Space$(255) lClassLen = CLng(Len(sClassName)) lRet = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, _ lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime) sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) lKeyIndx = 0& Do While lRtn = ERROR_SUCCESS ReTryKeyEnumeration: sSubKeyName = sMaxSubKey lLenSubKey = lMaxSubKey sClassString = sMaxClass lLenClass = lMaxClass lRtn = RegEnumKeyEx(hKey, lKeyIndx, sSubKeyName, lLenSubKey, 0&, sClassString, _ lLenClass, strucLastWriteTime) If InStr(sSubKeyName, Chr$(0)) > 1 Then sSubKeyName = Left$(sSubKeyName, InStr(sSubKeyName, Chr$(0)) - 1) End If If lRtn = ERROR_SUCCESS Then Form1.List1.AddItem sSubKeyName lNewKey = lNewKey + 1 sNewKey = "A" & Format$(lNewKey, "000000") If bFullEnumeration = True Then sSubKey2 = sSubKeyName If rgeSubKey <> "" Then sSubKey2 = Trim(rgeSubKey) & "\" & sSubKeyName End If lRet = RegOpenKeyEx(rgeMainKey, sSubKey2, 0&, KEY_READ, hKey2) Else Exit Do End If lKeyIndx = lKeyIndx + 1 ElseIf lRtn = ERROR_MORE_DATA Then lMaxSubKey = lMaxSubKey + 5 lMaxClass = lMaxClass + 5 sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) GoTo ReTryKeyEnumeration ElseIf lRtn = ERROR_NO_MORE_ITEMS Then lRtn = ERROR_SUCCESS Exit Do Exit Do End If Loop RegEnumKeys = lRtn lRtn = RegCloseKey(hKey) End Function Private Sub Form_Load() rgeMainKey = HKEY_CURRENT_USER rgeSubKey$ = "RemoteAccess\Profile" RegEnumKeys True End Sub Private Sub Command1_Click() Print GetRegValue(HKEY_CURRENT_USER, "RemoteAccess", "Default") End Sub