首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

RasDial命令 实现个ADSL偶尔拨号失败有关问题请问,进入有vb代码贴出,

2013-04-12 
RasDial命令实现个ADSL偶尔拨号失败问题请教,进入有vb代码贴出,急第一次调用拨号基本上都能拨上号,ip也能

RasDial命令 实现个ADSL偶尔拨号失败问题请教,进入有vb代码贴出,急
第一次调用拨号基本上都能拨上号,ip也能换,为什么拨多了2次就很容易失败
我想实现个抓取工具,结果抓取多了,就想重新拨号换ip
结果呢,会出现拨不上号的现象,有时拨上了ip也没换,不知道是什么原因?
请大家出出主意,谢谢,关键代码帖个大家看看。
temp = AddConnection("宽带连接", "", "", "123123123@gd.13", "DFSDFD", "") 'ADSL

Public Function AddConnection(strNewEntryName As String, strNewPhoneNumber As String, strNewCallbackNumber As String, strNewUsername As String, strNewPassword As String, strNewDomain As String) As Integer

Dim lngRetCode As Long
Dim lngRetLstrcpy As Long
Dim lngRetHangUp As Long
Dim lprasdialparams As RASDIALPARAMS95

If GetConnections() > 0 Then
    AddConnection = lngRetCode: Exit Function '·à?1?à??á??ó ±£3?ò???á??ó
End If

lprasdialparams.dwSize = 1052 '?úWINDOWS95/98?D±?D???dwSizeéè?a1052
'à?ó?lstrcpyoˉêy??×?·?′???±′μ?BYTEêy×é
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)
'?ò??ê1ó?í?2?í¨D?
Screen.MousePointer = vbHourglass
hRasConn = 0 '
lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, APINULL, ByVal APINULL, hRasConn)
Screen.MousePointer = vbDefault
'2aê?óD??óD′í?ó
If lngRetCode Then
    lngRetHangUp = RasHangUp(hRasConn)
End If
AddConnection = lngRetCode
End Function
[解决办法]
用过这种,但没遇到你说的情况。与你的ADSL设备质量有关?
[解决办法]

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


试试这一套代码看看

热点排行