标题:[分享]用VB实现ADSL拨号和挂断(转)
只看楼主
leilei88
Rank: 2
来 自:青岛
等 级:论坛游民
帖 子:217
专家分:27
注 册:2008-3-30
结帖率:100%
 问题点数:0 回复次数:4 
[分享]用VB实现ADSL拨号和挂断(转)
1、第一个问题还要添上连接名(就是拨号连接的名字)
我这里有一个现成的代码,挺长的,能上网、断网、查看网络状态、查看连接数目,如果其它的不需要的话,自己看函数的名字,删了即可
把一下代码粘贴到模块中,在窗体某控件的时间中写:
程序代码:
Public Type RASCONN95
    dwSize As Long
    hRasConn As Long
    szEntryName(256) As Byte
    szDeviceType(16) As Byte
    szDeviceName(128) As Byte
End Type

Public Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(16) As Byte
    szDeviceName(128) As Byte
End Type

Public Type RASDIALPARAMS95
    dwSize As Long
    szEntryName(256) As Byte
    szPhoneNumber(128) As Byte
    szCallbackNumber(128) As Byte
    szUserName(256) As Byte
    szPassword(256) As Byte
    szDomain(15) As Byte
End Type

Public Declare Function RasGetConnectStatus Lib "RasApi32.DLL" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) 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, lpvNotifier 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 RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long

Public Function AddConnection(strNewEntryName As String, strNewPhoneNumber As String, strNewCallbackNumber As String, strNewUsername As String, strNewPassword As String, strNewDomain As String) As Long
    Const APINULL = 0&
    Dim lngRetCode As Long
    Dim lngRetLstrcpy As Long
    Dim lngRetHangUp As Long
    Dim lprasdialparams As RASDIALPARAMS95
    On Error GoTo 10
    lprasdialparams.dwSize = 1052
    lngRetLstrcpy = lstrcpy(lprasdialparams.szEntryName(0), strNewEntryName)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szPhoneNumber(0), strNewPhoneNumber)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szCallbackNumber(0), strNewCallbackNumber)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szUserName(0), strNewUsername)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szPassword(0), strNewPassword)
    lngRetLstrcpy = lstrcpy(lprasdialparams.szDomain(0), strNewDomain)
    Screen.MousePointer = vbHourglass
    hRasConn = 0
    lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, APINULL, ByVal APINULL, hRasConn)
    Screen.MousePointer = vbDefault
    If lngRetCode Then
        lngRetHangUp = RasHangUp(hRasConn)
    End If
10
    AddConnection = lngRetCode
End Function

Public Function GetConnections() As Long
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Long
    
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
    GetConnections = lpcConnections
End Function

Public Function HangUpAll() As Boolean
    Dim lngRetCode As Long
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim intArraySize As Long
    Dim intLooper As Long
    
    ReDim lprasconn95(intArraySize) As RASCONN95
    lprasconn95(0).dwSize = 412
    lpcb = 256 * lprasconn95(0).dwSize
    lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
    
    If lngRetCode = 0 Then
        If lpcConnections > 0 Then
            For intLooper = 0 To lpcConnections - 1
                RasHangUp lprasconn95(intLooper).hRasConn
            Next intLooper
        Else
            HangUpAll = False
            Exit Function
        End If
    End If
    HangUpAll = True
End Function
Public Function IsConnected() As Boolean
    Dim TRasCon(255) As RASCONN95
    Dim lg As Long
    Dim lpcon As Long
    Dim RetVal As Long
    Dim Tstatus As RASCONNSTATUS95
    TRasCon(0).dwSize = 412
    lg = 256 * TRasCon(0).dwSize
    RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
    Tstatus.dwSize = 160
    RetVal = RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus)
    IsConnected = IIf(Tstatus.RasConnState = &H2000, True, False)
End Function


链接的时候在控件事件里写:
Dim recAdConn&
recAdConn = AddConnection("宽带连接", "", "", "登录账号", "登录密码", "")


2、查看当前IP
没有现成的代码,网上应该有的是吧!自己查一查
http://www.baidu.com/s?wd=VB+%B2%E9%BF%B4%B5%B1%C7%B0IP&cl=3

3、断网:第一个问题中已经说了,调用:
在控件事件中写
HangUpAll
完事

[[it] 本帖最后由 leilei88 于 2009-7-18 13:26 编辑 [/it]]
收到的鲜花
  • ak47my2009-07-18 10:34 送鲜花  41朵   附言:我很赞同
搜索更多相关主题的帖子: 分享 拨号 ADSL 
2009-07-18 09:46
bczgvip
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:66
帖 子:1310
专家分:5312
注 册:2009-2-26
得分:0 
可以的话,做个例子出来?
2009-07-18 12:39
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:0 
我的一个程序, 自动拨号投票机的 关键代码

Private Sub Timer2_Timer()
Dim fjIP() As String
Dim fjop() As String
Dim ipjs As Long

计时 = 计时 + 1

If 计时 > 服务器超时时间 Then
        日志 "服务器超时", 2
    Winsock2.Close
    If 是否在线 Then
        Call 断线
    End If
    计时 = 0
End If
If Winsock2.State = 8 Or Winsock1.State = 9 Then
        日志 "服务器意外错误", 2
    If 是否在线 Then
        Call 断线
    End If
   
    Winsock2.Close
    计时 = 0
End If

    If Winsock2.State = 0 Then
    If Not 停止 Then
        If 是否在线 Then
            日志 "开始拨号"
            Call 拨号
        End If
        Winsock2.Connect
    Else
        Call 投票禁(True)
        Command4.Visible = False
        Timer2.Enabled = False
        计时 = 0
    End If

    End If
    Text6.Text = vbCrLf & Winsock2.State & vbTab & Winsock2.RemoteHost & vbTab & 计时
End Sub

Private Function 是否在线() As Boolean
    Dim ret As Long
   
    ret = Get_PPP_Status("CDMA1X")
   
    If ret > 0 Then
        是否在线 = True
    Else
        是否在线 = False
    End If
End Function

Private Sub 断线()
    Dim ret As Boolean
   
    ret = Disconnect_PPP_Connection(Combo1.Text)
    If ret = True Then
        日志 "断开连接成功", 2
    Else
        日志 "断开连接失败", 2
    End If
End Sub

Private Sub 拨号()
If Len(Combo1.Text) > 0 Then
    Dim ret As Boolean
    ret = Dial_PPP_Connection(Combo1.Text)
    If ret = True Then
        '拨号成功
        日志 Combo1.Text & " 拨号成功"
    Else
        日志 Combo1.Text & " 拨号失败"
        '拨号失败
    End If
Else
    Call 日志("没有发现拨号连接", 3)
End If

End Sub

'--------------以下三个函数,也是网上收集的 ,本来是模块里的,详细代码我就不贴了.-------
Public Function Dial_PPP_Connection(ByVal lpszEntryName As String) As Boolean
    Dim lprasdialparams As RASDIALPARAMS
    Dim lpRasDialExtensions As RASDIALEXTENSIONS
    Dim lpfPassword As Long
   
    Dial_PPP_Connection = False
   
    If Is_PPP_Connecting(ByVal lpszEntryName) = False Then
        With lpRasDialExtensions
            .dwSize = 16
            .dwfOptions = RDEOPT_PausedStates
            .hwndParent = vbNull
        End With
        
        With lprasdialparams
            .dwSize = 1052
            lstrcpy .szEntryName(0), ByVal lpszEntryName
        End With
        
        hRasConn = 0
        RASDialErrorCode = 0
        If RasGetEntryDialParams(vbNullString, lprasdialparams, lpfPassword) = 0 Then
            'If RasDial(lpRasDialExtensions, vbNullString, lprasdialparams, 1&, AddressOf RasDialFunc, hRasConn) = 0 Then
            If RasDial(lpRasDialExtensions, vbNullString, lprasdialparams, 0, 0, hRasConn) = 0 Then
                Dial_PPP_Connection = True
            End If
        End If
    End If
End Function

Public Function Get_PPP_Status(ByVal lpszEntryName As String) As Long
    Dim lprasconnstatus As RASCONNSTATUS
   
    If Is_PPP_Connecting(ByVal lpszEntryName) = True Then
        lprasconnstatus.dwSize = LenB(lprasconnstatus)
        If RasGetConnectStatus(ByVal hRasConn, lprasconnstatus) = 0 Then
            Get_PPP_Status = lprasconnstatus.rasconnstate
        End If
    Else
        Get_PPP_Status = RASCS_Disconnected
    End If
End Function


Public Function Disconnect_PPP_Connection(ByVal lpszEntryName As String) As Boolean
    Dim temp As Long
   
    Disconnect_PPP_Connection = False
   
    Is_PPP_Connecting ByVal lpszEntryName
   
    If hRasConn <> 0 Then
        If RasHangUp(hRasConn) = 0 Then
            temp = GetTickCount()
            Do Until GetTickCount - temp >= 2000
                DoEvents
            Loop
            hRasConn = 0
            Disconnect_PPP_Connection = True
        End If
    End If
End Function

授人于鱼,不如授人于渔
早已停用QQ了
2009-07-18 13:53
rogersgb
Rank: 1
等 级:新手上路
帖 子:73
专家分:0
注 册:2016-2-3
得分:0 
回复 楼主 leilei88
拨号连接过程代码有吗
2016-02-23 13:20
rogersgb
Rank: 1
等 级:新手上路
帖 子:73
专家分:0
注 册:2016-2-3
得分:0 
回复 3楼 风吹过b
上面拨号过程如何调用请您出手指教
2016-02-24 17:58



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-279737-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.088604 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved