Public Const RASCS_Connected = &H2000
Public Const RASCS_Disconnected = &H2001Public Const RAS_NOTIFY_HWND = &HFFFFFFFFPublic Const UNLEN = 256
Public Const DNLEN = 15
Public Const PWLEN = 256Public Const RAS_MaxPhoneNumber = 128
Public Const RAS_MAXENTRYNAME = 256
Public Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Public Const RAS_MAXDEVICETYPE = 16
Public Const RAS_MAXDEVICENAME = 128Public Const ERROR_INVALID_HANDLE = 6
Public Const HKEY_DYN_DATA = &H80000006Public Enum RASCONNSTATE
RASCS_OpenPort = 0
RASCS_PortOpened = 1
RASCS_ConnectDevice = 2
RASCS_DeviceConnected = 3
RASCS_AllDevicesConnected = 4
RASCS_Authenticate = 5
RASCS_AuthNotify = 6
RASCS_AuthRetry = 7
RASCS_AuthCallback = 8
RASCS_AuthChangePassword = 9
RASCS_AuthProject = 10
RASCS_AuthLinkSpeed = 11
RASCS_AuthAck = 12
RASCS_ReAuthenticate = 13
RASCS_Authenticated = 14
RASCS_PrepareForCallback = 15
RASCS_WaitForModemReset = 16
RASCS_WaitForCallback = 17
RASCS_Projected = 18
RASCS_StartAuthentication = 19
RASCS_CallbackComplete = 20
RASCS_LogonNetwork = 21
RASCS_SubEntryConnected = 22
RASCS_SubEntryDisconnected = 23
RASCS_Interactive = &H1000
RASCS_RetryAuthentication = &H1001
RASCS_CallbackSetByCaller = &H1002
RASCS_PasswordExpired = &H1003
RASCS_InvokeEapUI = &H1004
End Enum'******************************
' RAS Functions - Structures
'******************************Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End TypePublic Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASCONNSTATUS
dwSize As Long
RASCONNSTATE As Long
dwError As Long
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASDIALPARAMS
dwSize As Long
szEntryName(RAS_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'****************************
' RAS Functions - Declares
'****************************
Public Declare Function RasGetErrorString Lib "rasapi32.dll" Alias "RasGetErrorStringA" (ByVal uErrorValue As Long, ByVal lpszErrorString As String, ByVal cBufSize As Long) As Long
Public Declare Function RasGetConnectStatus Lib "rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lpRasDialParams As Any, ByVal dwNotifierType As Long, ByVal hwndNotifier As Long, lphRasConn As Long) As Long
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Public Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, lpRasDialParams As Any, blnPasswordRetrieved As Long) As Long
Public Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal lpStrNull As String, ByVal lpszPhonebook As String, lprasentryname As RasEntryName, lpcb As Long, lpCEntries As Long) As Long
Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long'Public Function RasGetConnectionSpeed() As Long
' On Error GoTo ErrorHandler
' If IsConnected = False Then GoSub ErrorHandler
'RasGetConnectionSpeed = ReadLong(HKEY_DYN_DATA, "PerfStats\StatData", "Dial-Up Adapter\ConnectSpeed", 0)
' Exit Function
'ErrorHandler:
' RasGetConnectionSpeed = 0
'End FunctionPublic Sub RasDisconnect(Optional hRas As Long = -1)
Dim rasConInfo(64) As RasConn, lResult As Long
Dim lConnections As Long, lSize As Long, i As Integer
Dim iCalled As Integer
On Error Resume Next 'make sure it hangs up
rasConInfo(0).dwSize = LenB(rasConInfo(0))
lSize = rasConInfo(0).dwSize * 64
lResult = RasEnumConnections(rasConInfo(0), lSize, lConnections)
If lResult <> 0 Then
lngRASErrorNumber = lResult
'frmdial.status.Caption = GetDunError
Else
If lConnections > 0 Then
For i = 0 To lConnections - 1
If hRas = -1 Or hRas = rasConInfo(i).hRasConn Then
iCalled = 0
Do
DoEvents
'Inc iCalled
lResult = RasHangUp(rasConInfo(i).hRasConn)
Loop Until lResult = ERROR_INVALID_HANDLE Or iCalled = 1000
End If
Next
End If
'Setting hRasConn to 0 - no active connections
hRasConn = 0
End If
'If hRas <> -1 Then hRas = 0
End Sub
Public Function Dialer(ByVal strEntry As String, username As String, userpass As String, hm As String, formt As Form) As Boolean
On Error Resume Next
'dial th given number
Dim rasParams As RASDIALPARAMS, lResult As Long, hRas As Long
lResult = RasGetDialParams(strEntry, rasParams)
'Take care of alternate phone numbers
lstrcpy rasParams.szUserName(0), username
lstrcpy rasParams.szPassword(0), userpass
'If tp = 1 Then
lstrcpy rasParams.szPhoneNumber(0), hm
'Else
'lstrcpy rasParams.szPhoneNumber(0), "P" & frmdial.Combo2.Text
'End If
Select Case lResult
Case SUCCESS
If RasDial(ByVal 0&, vbNullString, rasParams, RAS_NOTIFY_HWND, formt.hwnd, hRas) Then
Else
'frmdial.status.Caption = "Unable To Contact the Modem... Please Check The Connections..."
Dialer = True
hRasConn = hRas
End If
Case Else
lngRASErrorNumber = lResult
End Select
End FunctionPublic Function RasGetDialParams(strEntryName As String, rdp As RASDIALPARAMS, Optional blnPassword As Long) As Long
On Error Resume Next
'get the dial parameters
Dim bPassword As Long
rdp.dwSize = LenB(rdp)
lstrcpy rdp.szEntryName(0), strEntryName
RasGetDialParams = RasGetEntryDialParams(vbNullString, rdp, bPassword)
blnPassword = bPassword
End FunctionPublic Sub RasLoadEntries(Combo As ComboBox)
On Error Resume Next
'load data for dialing properties
Dim lResult As Long, lConns As Long, lSize As Long
Dim i As Integer, bexists As Integer
ReDim rasentry(64) As RasEntryName
rasentry(0).dwSize = LenB(rasentry(0))
lSize = rasentry(0).dwSize * 64
lResult = RasEnumEntries(0&, 0&, rasentry(0), lSize, lConns)
Combo.Clear
For i = 0 To lConns - 1
Combo.AddItem ClearNulls(StrConv(rasentry(i).szEntryName, vbUnicode))
Next
Combo.ListIndex = 0
'Check to see if there is at least one entry
'bexists = frmdial.Combo1.ListCount <> 0End Sub
Public Function RasGetConnectedEntry() As String
On Error Resume Next
'get the state of the connection, no. of connections
Dim TRasCon(255) As RasConn, lg As Long, lpcon As Long
Dim Tstatus As RASCONNSTATUS
On Error Resume Next
TRasCon(0).dwSize = LenB(TRasCon(0))
lg = 256 * TRasCon(0).dwSize
Call RasEnumConnections(TRasCon(0), lg, lpcon)
Tstatus.dwSize = 160
Call RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus)
If Tstatus.RASCONNSTATE <> RASCS_Disconnected And Tstatus.RASCONNSTATE <> 0 Then
RasGetConnectedEntry = ClearNulls(StrConv(TRasCon(0).szEntryName, vbUnicode))
Else
RasGetConnectedEntry = ""
End If
End Function
Public Function GetDunError() As String
On Error Resume Next
'get any DUN errors.
Dim lngRetCode As Long, iNullPos As Long
Dim strRASErrorString As String
strRASErrorString = Space$(256)
'lngRASErrorNumber is the RAS error number in class decl
Select Case lngRASErrorNumber
Case Is >= 600
lngRetCode = RasGetErrorString(lngRASErrorNumber, strRASErrorString, 256&)
If lngRetCode Then
'We should never see this
GetDunError = "Error: Unable to retrieve error message."
Else
'Return string
GetDunError = ClearNulls(strRASErrorString)
If GetDunError = "Unknown error." Then
' An unknown error has occured
GetDunError = GetDunError + Str(lngRASErrorNumber)
' See if is a common error
Select Case lngRASErrorNumber
Case 635
GetDunError = "Incorrect password. Server connection canceled."
End Select
End If
End If
Case Else
GetDunError = "Unexpected Error. Error code" + Str(lngRASErrorNumber) + "."
End Select
iNullPos = InStr(GetDunError, Chr(0))
If iNullPos > 1 Then GetDunError = Left$(GetDunError, iNullPos - 1)
End FunctionPublic Function StarDialer(TForm As Form, Optional ByVal WaitTime As Single = 60) As Boolean '//拨号函数
mf.mexit.Enabled = False
Dim oktb As Boolean
Dim bhcount As Integer '//拨号次数 10次
bhcount = 1
StarDialer = False
Do
DoEvents
If bhcount >= 11 Then
Exit Do
End If
With MyDialerData
If .DialerTel = "-" Then
oktb = Dialer(.DialerName, .DialerUser, .DialerPassword, "", TForm)
Else
oktb = Dialer(.DialerName, .DialerUser, .DialerPassword, .DialerTel, TForm)
End If
End With
If oktb = True Then
Wait WaitTime '等待60秒
If Connected_To_ISP() = True Then
StarDialer = True
Exit Do
Else
HangUp
End If
End If
bhcount = bhcount + 1
Loop
mf.mexit.Enabled = True
End Function
解决方案 »
- 请各位高手帮忙讲解一下
- GetDiskSN获取硬盘序列号
- 如何引用SSTAB控件里的控件?
- 您需要向其它开发组成员解释自己的代码吗?您需要快速的为软件定制帮助体制吗?您希望代码回到无意间疏忽毁掉之前或您希望放弃当前以修改的
- 急!急!VBA中用DOM对象生成XML文件的问题!
- 新人新猪肉,快来割啊。超级菜的问题
- 一个关于排列、组合的问题,请高手们帮忙,谢谢!!!送分50!!!
- 明天放假,今天高兴!放分!!!!!!!!!!
- 我是一个新手,谁能教我啊???????????????明儿我请你吃饭
- 怎样实现鼠标取词,就像是金山词霸那样!!
- 高手你在哪?
- 如何通过API的调用,来知道拨号网络中有多少个连接,并且知道每一个连接的名称!!
DialerName As String '// 我的连接
DialerTel As String '//96169
DialerUser As String '// 96169
DialerPassword As String '//96169
DialerOk As Boolean '//是否成功
End Type要这个结构1