VB中RASDIAL异步调用,还未验证
发布时间:2020-12-16 22:29:38 所属栏目:大数据 来源:网络整理
导读:'****************************************************************************** '取得目前连线信息 ' Function GetAllConnects(ConnEntry() As RASCONN) As Long '传回值: 总共连线数 '使用方式: ' Dim Conn() As RASCONN ' Dim icnt As Long ' icnt =
'******************************************************************************
'取得目前连线信息 ' Function GetAllConnects(ConnEntry() As RASCONN) As Long '传回值: 总共连线数 '使用方式: ' Dim Conn() As RASCONN ' Dim icnt As Long ' icnt = GetAllConnects(Conn()) '取得所有拨号网络Entry的资讯 (不管有没有连线) ' Function GetRasNameEntries(Entry() As RASENTRYNAME,_ Optional PhonePath As String) As Long '传回值: 总共Entry数 '使用方式: ' Dim Conn() As RASENTRYNAME ' Dim icnt As Long ' icnt = GetRasNameEntries(Conn()) '呼叫修改某一个连线Entry 的Window ' Sub EditEntry(ByVal EntryName As String,_ Optional ByVal PhonePath As String) '在拨号网络中新增一个Entry ' Sub CreateEntry(Optional ByVal PhonePath As String) '自动拨接 ' Function DialUp(ByVal EntryName As String,ByVal UserN As String,_ ByVal Pwd As String,Optional ByVal PhonePath As String) As Long '取消拨接 ' Function HangUp(ByVal hconn As Long) As Boolean ' hconn的值来自於 ' 1.DialUp()的传回值 ' 2.GetAllConnects() RASCONN结构叁数中的hRasConn值 '取得连线状态 ' Function GetConnectStatus(ByVal hocnn As Long) As Long ' hconn的值来自於 ' 1.DialUp()的传回值 ' 2.GetAllConnects() RASCONN结构叁数中的hRasConn值 '****************************************************************************** Option Explicit Public Const RAS_MaxEntryName = 256 Public Const RAS_MaxDeviceName = 128 Public Const RAS_MaxDeviceType = 16 Public Const RAS_MaxPhoneNumber = 128 Public Const RAS_MaxCallbackNumber = 128 Public Const UNLEN = 256 Public Const PWLEN = 256 Public Const DNLEN = 15 Public Const ERROR_INVALID_HANDLE = 6 Type RASCONN dwSize As Long '412 hRasConn As Long szEntryName(RAS_MaxEntryName) As Byte szDeviceType(RAS_MaxDeviceType) As Byte szDeviceName(RAS_MaxDeviceName) As Byte End Type Type RASENTRYNAME dwSize As Long '264 szEntryName(RAS_MaxEntryName) As Byte End Type Type RASDIALPARAMS dwSize As Long '1052 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 Type RASCONNSTATUS dwSize As Long '144 RasConnState As Long dwError As Long szDeviceType(RAS_MaxDeviceType) As Byte szDeviceName(RAS_MaxDeviceName) As Byte End Type Declare Function RasDial Lib "rasapi32 " _ Alias "RasDialA " (DialExt As Long,ByVal lpPhoneBook As String,_ RasDialParam As RASDIALPARAMS,ByVal NotifyType As Long,_ ByVal Notifter As Long,hRasConn As Long) As Long Declare Function RasCreatePhonebookEntry Lib "rasapi32 " _ Alias "RasCreatePhonebookEntryA " (ByVal hWnd As Long,ByVal lpPhoneBook As String) As Long Declare Function RasEditPhonebookEntry Lib "rasapi32 " _ Alias "RasEditPhonebookEntryA " (ByVal hWnd As Long,_ ByVal lpEntryName As String) As Long Declare Function RasGetErrorString Lib "rasapi32 " _ Alias "RasGetErrorStringA " (ByVal ErrValue As Long,ByVal lpErrStr As String,_ ByVal cSize As Long) As Long Declare Function RasEnumEntries& Lib "rasapi32 " _ Alias "RasEnumEntriesA " (ByVal res As String,ByVal lpszPhonebook As String,_ lpRasEntryBuffer As Any,lpcb As Long,lpcEntries As Long) Declare Function RasEnumConnections Lib "rasapi32 " Alias _ "RasEnumConnectionsA " (lprasconn As Any,_ lpcb As Long,lpConnect As Long) As Long Declare Function RasHangUp Lib "rasapi32 " Alias _ "RasHangUpA " (ByVal hRasConn As Long) As Long Declare Function RasGetConnectStatus Lib "rasapi32 " Alias _ "RasGetConnectStatusA " (ByVal hRasConn As Long,_ lprasconnstatus As RASCONNSTATUS) As Long Declare Function RasGetEntryDialParams Lib "rasapi32 " _ Alias "RasGetEntryDialParamsA " (ByVal lpszPhonebook As String,_ lpRasDialParams As RASDIALPARAMS,_ lpfPassword As Byte) As Long Declare Sub Sleep Lib "kernel32 " (ByVal dwMilliseconds As Long) 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_Interactive = &H1000 '4096 RASCS_RetryAuthentication '4097 RASCS_CallbackSetByCaller '4098 RASCS_PasswordExpired '4099 RASCS_Connected = &H2000 '8192 RASCS_Disconnected '8193 End Enum '取得目前连线资讯 Public Function GetAllConnections(Conn() As RASCONN) As Long Dim dl&,size&,validConnection&,counter% ReDim Conn(0) Conn(0).dwSize = 412 size = 412 dl& = RasEnumConnections(Conn(0),size,validConnection) If validConnection > 0 Then ReDim Conn(validConnection - 1) Conn(0).dwSize = 412 size = validConnection * 412 dl& = RasEnumConnections(Conn(0),validConnection) End If If dl = 0 Then GetAllConnections = validConnection Else GetAllConnections = -1 End If End Function '取得所有拨号网路Entry的资讯(不管有没有连线) Public Function GetRasNameEntries(Entry() As RASENTRYNAME,Optional PhonePath As String) As Long Dim di As Long,lpentries As Long Dim addit As Long Dim i As Long Dim len5 di& = RasEnumEntries(vbNullString,PhonePath,lpentries) If lpentries > 0 Then i = lpentries - 1 ReDim Entry(i) len5 = LenB(Entry(0)) addit = (4 - (len5 Mod 4)) Mod 4 Entry(0).dwSize = len5 + addit lpcb = Entry(0).dwSize * (i + 1) di& = RasEnumEntries(vbNullString,Entry(0),lpcb,lpentries) End If If di = 0 Then GetRasNameEntries = lpentries Else GetRasNameEntries = -1 End If End Function '呼叫修改某一个连线Entry 的Window Public Sub EditEntry(ByVal EntryName As String,Optional ByVal PhonePath As String) Dim di As Long di = RasEditPhonebookEntry(0,EntryName) End Sub '於拨号网路中新增一个Entry Public Sub CreateEntry(Optional ByVal PhonePath As String) Call RasCreatePhonebookEntry(0,PhonePath) End Sub '自动拨接(Win95 4,5 个叁数不传,或为vbNullString) Public Function DialUp(ByVal EntryName As String,_ ByVal Pwd As String,Optional ByVal PhoneBook As String,Optional sDomain As String) As Long Dim RasDialPara As RASDIALPARAMS Dim bya() As Byte,di As Long Dim len5 As Long,i As Long Dim hRasConn As Long len5 = LenB(RasDialPara) i = (4 - (len5 Mod 4)) Mod 4 RasDialPara.dwSize = len5 + i '1052 bya = StrConv(EntryName,vbFromUnicode) + ChrB(0) Call CopyByte(RasDialPara.szEntryName,bya) bya = StrConv(UserN,vbFromUnicode) + ChrB(0) Call CopyByte(RasDialPara.szUserName,bya) bya = StrConv(Pwd,vbFromUnicode) + ChrB(0) Call CopyByte(RasDialPara.szPassword,bya) bya = StrConv(sDomain,vbFromUnicode) + ChrB(0) Call CopyByte(RasDialPara.szDomain,bya) '若使用以下CallBack function的方式,则RasDial()不等连线成功或失败便结束。 di = RasDial(0,PhoneBook,RasDialPara,AddressOf RasDialFunc,hRasConn) '若第二、三个叁数都是0则,RasDial会等连线成功或失败後才执行下一行指令 'di = RasDial(0,hRasConn) If di = 0 Then DialUp = hRasConn Else DialUp = 0 Dim str5 As String str5 = String(255,Chr(0)) Call RasGetErrorString(di,str5,256) MsgBox Left(str5,InStr(1,Chr(0)) - 1),vbCritical Call HangUp(hRasConn) frmRasSet.frameMsg.Visible = False End If End Function Public Sub RasDialFunc(ByVal unMsg As Long,_ ByVal ConnState As Long,_ ByVal dwError As Long) Dim strMsg As String Select Case ConnState Case 0 strMsg = "正在打开... " Case 1 strMsg = "端口已经打开! " Case 2 strMsg = "正在连接设备... " Case 3 strMsg = "设备已经连接 " Case 4 strMsg = "所有设备已经连接 " Case 5 strMsg = "正在验证用户名及口令... " Case 6 strMsg = "验证通告... " Case 7 strMsg = "验证重试... " Case 8 strMsg = "验证回叫... " Case 9 strMsg = "验证回叫... " Case 10 strMsg = "验证项目... " Case 11 strMsg = "验证连接速度... " Case 12 strMsg = "验证请求... " Case 13 strMsg = "重新验证... " Case 14 strMsg = "验证完成! " Case 15 strMsg = "准备回叫... " Case 16 strMsg = "等待调制解调器复位 " Case 17 strMsg = "等待回叫... " Case 18 strMsg = "projected " Case 19 strMsg = "开始鉴定... " Case 20 strMsg = "回叫完成! " Case 21 strMsg = "正在登录网络... " Case 4096 strMsg = "连接已经成功! " Case 4097 strMsg = "重新鉴定... " Case 4098 strMsg = "设置回叫... " Case 4099 strMsg = "口令错误! " Case 8192 strMsg = "已经连接啦! " Case 8193 strMsg = "已经断开啦! " End Select frmRasSet.lstMsg.AddItem strMsg frmRasSet.lstMsg.ListIndex = frmRasSet.lstMsg.NewIndex If ConnState = RASCS_Connected Or ConnState = RASCS_Interactive Then 'frmRasSet.frameMsg.Visible = False Load frmRemote Unload frmRasSet frmRemote.Show End If If ConnState = RASCS_Disconnected Then MsgBox "拨号网络连接失败! " frmRasSet.frameMsg.Visible = False End If End Sub '取消拨接 Public Function HangUp(ByVal hconn As Long) As Boolean Dim st As Long,len5 As Long Dim i As Long,ConStatus As RASCONNSTATUS st = RasHangUp(hconn) len5 = LenB(ConStatus) i = (4 - (len5 Mod 4)) Mod 4 ConStatus.dwSize = len5 + i Do While True Call Sleep(0) i = RasGetConnectStatus(hconn,ConStatus) If i = ERROR_INVALID_HANDLE Then Exit Do End If Loop If st = 0 Then HangUp = True Else HangUp = False End If End Function '取得连线状态 Public Function GetConnectStatus(ByVal hconn As Long) As Long Dim i As Long,ConStatus As RASCONNSTATUS Dim len5 As Long len5 = LenB(ConStatus) i = (4 - (len5 Mod 4)) Mod 4 ConStatus.dwSize = len5 + i i = RasGetConnectStatus(hconn,ConStatus) If i = 0 Then GetConnectStatus = ConStatus.RasConnState Else GetConnectStatus = -1 End If End Function Private Sub CopyByte(dest() As Byte,sour() As Byte) Dim sourL As Long,sourU As Long Dim destL As Long,destU As Long,i As Long,J As Long sourL = LBound(sour) sourU = UBound(sour) destL = LBound(dest) destU = UBound(dest) J = 0 For i = sourL To sourU dest(destL + J) = sour(i) J = J + 1 If J > = (destU - destL) + 1 Then Exit For End If Next i End Sub (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |