| |
Получение списка всех интернет-соединений |
|
| |
Добавьте на форму 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
|
|
| |
|
|
|
|