Connect To The Internet

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 Command Buttons, 1 Text Box and 1 List Box to your form.
'Press the first button to get the default internet connection name.
'Press the second button to fill the List Box with all internet connections.
'double click on one of the internet connections in the List Box to connect to the internet.
'Insert the following code to your module :

Const REG_NONE = 0&
Public Const REG_SZ = 1&
Const REG_EXPAND_SZ = 2&
Const REG_BINARY = 3&
Public 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

Type FILETIME
lLowDateTime As Long
lHighDateTime As Long
End Type

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Declare Function RegOpenKeyEx& Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&)
Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&)
Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, _
ByVal lpDataBuff$, nSize&)
Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey&, ByVal dwIndex&, ByVal lpname$, lpcbName&, ByVal _
lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME)

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

'Insert the following code to your form:

Private Sub Command1_Click()
Text1.Text = GetRegValue(HKEY_CURRENT_USER, "RemoteAccess", "Default")
End Sub

Private Sub Command2_Click()
rgeMainKey = HKEY_CURRENT_USER
rgeSubKey$ = "RemoteAccess\Profile"
RegEnumKeys True
End Sub

Private Sub List1_DblClick()
Shell "rundll32.exe rnaui.dll,RnaDial " + List1.List(List1.ListIndex)
End Sub

Go Back