Open the Dial-up dialog box

[vzcharlie]

I am making an application that makes shortcuts to the Control Panel and its applications, so user is able to click a button and open whatever they need. But I do not know how to launch the Dial-up dialog box in VB. Does anyone know how to do this?

[John G Duffy]

Here is something I ran across. May need a little editing since it is from a html file.

Connecting to Internet
You have always wanted to display a connection dialog when you use the MSINET.OCX control in your apps, now you can get a list of the connections and also the default connection and display the Window's own Dial-Up-Connection dialog.

BAS CODE

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
FORM CODE

Create a form with:

1. Four Command Button controls named as "Command1", "Command2" ....
set properties as follows:
Command1: Caption = "Fill"
Command2: Caption = "Fill"
Command3: Caption = "Show Dialog"
Command4: Caption = "&Close": Cancel = true
2. A ListBox control named as "List1"
3. A TextBox control named as "Text1"

Paste the following code in the Form's General Declaration area:

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 Command3_Click()
Shell "rundll32.exe rnaui.dll,RnaDial " + Text1.Text
End Sub

private Sub Command4_Click()
Unload me
End Sub

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

All connection names are extracted from Registry. And double-clicking on one will launch that dialer (if that dialer is auto-configured, i.e automatic dialling, the dialog won't be shown!)

Download sample project

Whiz Kid's Visual Basic Gallery




John G