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