vb调用控制面板的拨号连接可以吗？

[chuying]

可以直接编写语句调用拨号连接，并且使之在“连接”状态？
比如单击command_click()按钮,就开始进行拨号连接

[nik_Amis]

'This program let you dial to your dial-up connections using whether
'the stored user name and password or the ones you specifies
'(It use RasDial for dialing)

'You need a form with a list,2 textbox and a command button

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)

Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber

Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Byte
End Type

Private Type RASENTRYNAME95
'set dwsize to 264
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type

Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long

Private Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
Dim rp As RASDIALPARAMS, h As Long, resp As Long
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain 'Domain stored for the connection
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
Dial = (resp = 0)
End Function

Private Function ChangeToStringUni(Bytes() As Byte) As String
'Changes an byte array to a Visual Basic unicode string
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function

Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Changes a Visual Basic unicode string to an byte array
'Returns True if it truncates str
Dim lenBs As Long 'length of the byte array
Dim lenStr As Long 'length of the string
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs 'Queda truncado
ChangeBytes = True
End If
End Function

Private Sub Command1_Click()
Dial List1.Text, Text1, Text2
End Sub


Private Sub List1_Click()
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes List1.Text, rdp.szEntryName
'Get User name and password for the connection
t = RasGetEntryDialParams(List1.Text, rdp, 0)
If t = 0 Then
Text1 = ChangeToStringUni(rdp.szUserName)
Text2 = ChangeToStringUni(rdp.szPassword)
End If
End Sub

Private Sub Form_Load()
'example created by Daniel Kaufmann ([e-mail])
'load the connections
Text2.PasswordChar = "*"
Command1.Caption = "Dial"
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95

r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
List1_Click
End If
End Sub

[nik_Amis]

Const RAS_MAXENTRYNAME = 256
Const RAS_MAXDEVICETYPE = 16
Const RAS_MAXDEVICENAME = 128
Const RAS_RASCONNSIZE = 412
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
'This program will close your Internet-connection, so to test this, you will have to open an Internet-connection.
Dim i As Long, lpRasConn(255) As RasConn, lpcb As Long
Dim lpcConnections As Long, hRasConn As Long
'Set the structure's size
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
'Enumerate all the available connections
returncode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)

If returncode = 0 Then
For i = 0 To lpcConnections - 1
hRasConn = lpRasConn(i).hRasConn
'Hang up
returncode = RasHangUp(ByVal hRasConn)
Next i
End If
End Sub

[feixuehenshui]

学习都学不完阿 ◎！◎

[chuying]

我按上面的方法做了。可是没有任何反映，

[zmcpu]

随着因特网的迅猛发展，现在编程常需要在程序中直接联网来处理一些事项，如在线注册和在线帮助，这就要求我们要在程序中建立某些连接。很多软件在不知用户是否联网的情况下不管三七二十一就启动浏览器查找网址，费了九牛二虎之力只能查出一错误页来（当然不可能有什么好的结果）。如果我们在程序编写时能自动判断用户是否已经联网，如已经联网则打开联接，如没有则启动默认的拨号连接，这样是不是让人觉得你的软件更胜人一处呢？判断是否已联网很多地方都有介绍，这里我们只介绍如何启动默认的拨号连接。
　 在介绍之前让我们首先看看如何打开拨号网络。由于拨号网络不是一个可执行文件，所以不能用 “Shell 可执行文件”的方式来打开。要启动拨号网络，需借助 Explorer ，方法如下：

　 Shell "Explorer ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\" & _
　　　　 "::{992CFFA0-F557-101A-88EC-00DD010CCC48}", vbNormalFocus

　 但若是要启动拨号网络中的某一个连接，则需借助rundll.exe 及 rnaui.dll 来启动，方法如下（假定连接名称为163）：

　 Shell "rundll rnaui.dll,RnaDial 163", vbNormalFocus

　 说明：在以上叙述中，“,RnaDial 163”这部分不要插入额外的空格，大小写也不要任意更改。

　 上面仅仅假定了连接名称，但实际编程中我们是不知道其名称的，如何取得默认的连接名称并启动它呢？这里我们可利用注册表来达到目的。完整程序如下：

　 在窗体上放置一个命令按钮（名称为 cmdCallConnect)，下面为代码部份：

Option Explicit

'有关注册的API声明
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias _
　 "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
　 ByVal ulOptions As Long, ByVal samDesired As Long, _
　 phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias _
　 "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
　 ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As _
　 String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" _
　 (ByVal hKey As Long) As Long
'常数
Const HKEY_CURRENT_USER = &H80000001
Const ERROR_SUCCESS = 0&

Private Sub cmdCallConnect_Click()
　 '启动默认拨号连接
　 Shell "rundll rnaui.dll,RnaDial " + GetConnect, vbNormalFocus
End Sub

Public Function GetConnect() As String
　 Dim hKey As Long
　 Dim SubKey As String
　 hKey = HKEY_CURRENT_USER　 '主键
　 SubKey = "RemoteAccess"　　 '子键
　 '取得默认连接名
　 GetConnect = GetRegValue(hKey, SubKey, "Default")
End Function

Public Function GetRegValue(hKey As Long, lpszSubKey As String, _
szKey As String) As Variant

　 On Error GoTo ErrorRoutineErr:

　 Dim phkResult As Long
　 Dim lResult As Long
　 Dim szBuffer As String
　 Dim lBuffSize As Long

　 '创建缓冲区
　 szBuffer = Space(255)
　 lBuffSize = Len(szBuffer)

　 '打开注册键
　 RegOpenKeyEx hKey, lpszSubKey, 0, 1, phkResult

　 '查询结果
　 lResult = RegQueryValueEx(phkResult, szKey, 0, 0, szBuffer, lBuffSize)

　 '关闭注册键
　 RegCloseKey phkResult

　 '返回结果
　 If lResult = ERROR_SUCCESS Then
　　 GetRegValue = Left(szBuffer, lBuffSize - 1)
　 Else
　　 GetRegValue = ""
　 End If
　 Exit Function

ErrorRoutineErr:
　 GetRegValue = ""
End Function

[chenyu5188]

UP

[chuying]

这句话，提示错误文件没有找到。。。
Shell "rundll rnaui.dll,RnaDial 4684956 " + GetConnect, vbNormalFocus