Type RASDIALPARAMS
dwSize As Long
szEntryName As String * RAS_MaxEntryName '* 'Direct Cable Connection Host Logon
szPhoneNumber As String * RAS_MaxPhoneNumber '+ 1) As Byte
szCallbackNumber As String * RAS_MaxCallbackNumber '+ 1) As Byte
szUserName As String * UNLEN '+ 1) As Byte
szPassword As String * PWLEN '+ 1) As Byte
szDomain As String * DNLEN '+ 1) As Byte
dwRe1 As Long
dwRe2 As Long
End Type
Public Declare Function RasDial Lib "rasapi32" Alias "RasDialA" (lpRasDialExtensions As Any, _
lpszPhonebook As Any, lprasdialparams As RASDIALPARAMS, ByVal dwNotifierType As Long, _
ByVal lpvNotifier As Long, lphRasConn As Long) As Long
Public Declare Function RasGetErrorString Lib "rasapi32" Alias "RasGetErrorStringA" ( _
ByVal uErrorValue As Long, ByVal lpszErrorString As String, ByVal cBufSize As Long) As Long
Const constrRas = "RasConn"
Private mhConn As Long
Public Sub Dial(EntryName As String, PhoneNumber As String)
If mhConn Then
Err.Raise 855, constrRas, "连接未断开"
Else
Dim rp As RASDIALPARAMS
With rp
.dwSize = RASDIALPARAMSLEN
.szEntryName = EntryName & vbNullChar
.szPhoneNumber = PhoneNumber & vbNullChar
.szCallbackNumber = vbNullChar
.szUserName = vbNullChar
.szPassword = vbNullChar
.szDomain = "*" & vbNullChar
End With
RasErr RasDial(ByVal 0, ByVal 0, rp, -1, hWND, mhConn)
End If
End Sub
Private Sub RasErr(ByVal Number As Long)
If Number Then Err.Raise Number, constrRas, GetErrString(Number)
End Sub
Private Function GetErrString(ByVal Number As Long) As String
Dim s As String
s = String(256, 0)
If RasGetErrorString(Number, s, 255) Then
s = "未知错误。"
Else
s = TrimNull(s)
End If
GetErrString = s
End Function
Private Function TrimNull(StrNull As String) As String
Dim l As Long
l = InStr(StrNull, vbNullChar)
If l > 0 Then
TrimNull = Left$(StrNull, l - 1)
Else
TrimNull = StrNull
End If
End Function
Public Declare Function RnaDial Lib "rnaui.dll" (ByVal hWnd As Long, ByVal hInst As Long, ByVal lpszEntry As String, ByVal lFlag As Long) As Long
Public Declare Function RnaWizard Lib "rnaui.dll" (ByVal hWnd As Long, ByVal hInst As Long, ByVal lpszEntry As String, ByVal lFlag As Long) As Long
Form1:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5745
ClientLeft = 1110
ClientTop = 1530
ClientWidth = 6420
LinkTopic = "Form1"
ScaleHeight = 5745
ScaleWidth = 6420
Begin VB.TextBox Text1
Height = 525
Left = 1680
TabIndex = 4
Text = "我的连接"
Top = 600
Width = 2235
End
Begin VB.OptionButton Option2
Caption = "&No face form"
Height = 435
Left = 2790
TabIndex = 3
Top = 3630
Width = 2265
End
Begin VB.OptionButton Option1
Caption = "&Has face form"
Height = 345
Left = 690
TabIndex = 2
Top = 3690
Value = -1 'True
Width = 1725
End
Begin VB.CommandButton Command2
Caption = "Rna&Wizard"
Height = 825
Left = 1980
TabIndex = 1
Top = 4320
Width = 2295
End
Begin VB.CommandButton Command1
Caption = "Rna&Dial"
Height = 615
Left = 1830
TabIndex = 0
Top = 1410
Width = 2235
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private lhWnd As Long
Private lhInst As Long
Private Sub Command1_Click()
On Error GoTo ErrorHandle
Dim l As Long
l = RnaDial(lhWnd, lhInst, Text1, 1)
If l Then
MsgBox "错误: " & l, vbCritical
End If
Exit Sub
ErrorHandle:
MsgBox Err.Description, vbCritical
End Sub
Private Sub Command2_Click()
On Error GoTo ErrorHandle
Dim s As String
If Option1 Then
s = "/0"
Else
s = "/1"
End If
Dim l As Long
l = RnaWizard(lhWnd, lhInst, s, 1)
If l Then
MsgBox "错误: " & l, vbCritical
End If
Exit Sub
ErrorHandle:
MsgBox Err.Description, vbCritical
End Sub
Private Sub Form_Load()
On Error Resume Next
lhWnd = hWnd
lhInst = App.hInstance
End Sub
在程序中打开 Internet 拨号连接窗口 98-6-19
Private Sub StartConnection()
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & "_连接的名称_", 1)
DoEvents
SendKeys "{enter}", True
DoEvents
End Sub