挂断ADSL Option Explicit Private Const RAS_MAXENTRYNAME = 256 Private Const RAS_MAXDEVICETYPE = 16 Private Const RAS_MAXDEVICENAME = 128 Private Const RAS_RASCONNSIZE = 412Private Type RasEntryName dwSize As Long szEntryName(RAS_MAXENTRYNAME) As Byte End Type Private Type RasConn dwSize As Long hRasConn As Long szEntryName(RAS_MAXENTRYNAME) As Byte szDeviceType(RAS_MAXDEVICETYPE) As Byte szDeviceName(RAS_MAXDEVICENAME) As Byte End TypePrivate Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As LongSub HangUp() Dim i As Long Dim lpRasConn(255) As RasConn Dim lpcb As Long Dim lpcConnections As Long Dim hRasConn As Long
If RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) = 0 Then For i = 0 To lpcConnections - 1 If InStr(1, StrConv(lpRasConn(i).szDeviceName, vbUnicode), "iVasion PoET Adapter") > 0 Then hRasConn = lpRasConn(i).hRasConn ReturnCode = RasHangUp(ByVal hRasConn) End If Next i End If End SubPrivate Sub Command1_Click() Call HangUp End Sub
拨号上网 'This program let you dial to your dial-up connections using whether 'the stored user name and password or the ones you specifies '(It use RasDial for dialing)'You need a form with a list,2 textbox and a command buttonOption Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long) Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)Const RAS95_MaxEntryName = 256 Const RAS_MaxPhoneNumber = 128 Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumberConst UNLEN = 256 Const PWLEN = 256 Const DNLEN = 12 Private Type RASDIALPARAMS dwSize As Long ' 1052 szEntryName(RAS95_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 TypePrivate Type RASENTRYNAME95 'set dwsize to 264 dwSize As Long szEntryName(RAS95_MaxEntryName) As Byte End TypePrivate Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As LongPrivate Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean Dim rp As RASDIALPARAMS, h As Long, resp As Long rp.dwSize = Len(rp) + 6 ChangeBytes Connection, rp.szEntryName ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection ChangeBytes UserName, rp.szUserName ChangeBytes Password, rp.szPassword ChangeBytes "*", rp.szDomain 'Domain stored for the connection 'Dial resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc Dial = (resp = 0) End FunctionPrivate Function ChangeToStringUni(Bytes() As Byte) As String 'Changes an byte array to a Visual Basic unicode string Dim temp As String temp = StrConv(Bytes, vbUnicode) ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1) End FunctionPrivate Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean 'Changes a Visual Basic unicode string to an byte array 'Returns True if it truncates str Dim lenBs As Long 'length of the byte array Dim lenStr As Long 'length of the string lenBs = UBound(Bytes) - LBound(Bytes) lenStr = LenB(StrConv(str, vbFromUnicode)) If lenBs > lenStr Then CopyMemory Bytes(0), str, lenStr ZeroMemory Bytes(lenStr), lenBs - lenStr ElseIf lenBs = lenStr Then CopyMemory Bytes(0), str, lenStr Else CopyMemory Bytes(0), str, lenBs 'Queda truncado ChangeBytes = True End If End FunctionPrivate Sub Command1_Click() Dial List1.Text, Text1, Text2 End Sub Private Sub List1_Click() Dim rdp As RASDIALPARAMS, t As Long rdp.dwSize = Len(rdp) + 6 ChangeBytes List1.Text, rdp.szEntryName 'Get User name and password for the connection t = RasGetEntryDialParams(List1.Text, rdp, 0) If t = 0 Then Text1 = ChangeToStringUni(rdp.szUserName) Text2 = ChangeToStringUni(rdp.szPassword) End If End SubPrivate Sub Form_Load() 'example created by Daniel Kaufmann ([email protected]) 'load the connections Text2.PasswordChar = "*" Command1.Caption = "Dial" Dim s As Long, l As Long, ln As Long, a$ ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264 s = 256 * r(0).dwSize l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln) For l = 0 To ln - 1 a$ = StrConv(r(l).szEntryName(), vbUnicode) List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1) Next If List1.ListCount > 0 Then List1.ListIndex = 0 List1_Click End If End Sub
不用拨号的话,直接断开重拨需要对ADSL设备进行设置,我看还不如断开ADSL猫的电源,然后重新插上
Option Explicit
Private Const RAS_MAXENTRYNAME = 256
Private Const RAS_MAXDEVICETYPE = 16
Private Const RAS_MAXDEVICENAME = 128
Private Const RAS_RASCONNSIZE = 412Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePrivate Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As LongSub HangUp() Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
If RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) = 0 Then
For i = 0 To lpcConnections - 1
If InStr(1, StrConv(lpRasConn(i).szDeviceName, vbUnicode), "iVasion PoET Adapter") > 0 Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End SubPrivate Sub Command1_Click()
Call HangUp
End Sub
'This program let you dial to your dial-up connections using whether
'the stored user name and password or the ones you specifies
'(It use RasDial for dialing)'You need a form with a list,2 textbox and a command buttonOption Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumberConst UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long ' 1052
szEntryName(RAS95_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 TypePrivate Type RASENTRYNAME95
'set dwsize to 264
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End TypePrivate Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As LongPrivate Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
Dim rp As RASDIALPARAMS, h As Long, resp As Long
rp.dwSize = Len(rp) + 6
ChangeBytes Connection, rp.szEntryName
ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
ChangeBytes UserName, rp.szUserName
ChangeBytes Password, rp.szPassword
ChangeBytes "*", rp.szDomain 'Domain stored for the connection
'Dial
resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
Dial = (resp = 0)
End FunctionPrivate Function ChangeToStringUni(Bytes() As Byte) As String
'Changes an byte array to a Visual Basic unicode string
Dim temp As String
temp = StrConv(Bytes, vbUnicode)
ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End FunctionPrivate Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Changes a Visual Basic unicode string to an byte array
'Returns True if it truncates str
Dim lenBs As Long 'length of the byte array
Dim lenStr As Long 'length of the string
lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs 'Queda truncado
ChangeBytes = True
End If
End FunctionPrivate Sub Command1_Click()
Dial List1.Text, Text1, Text2
End Sub
Private Sub List1_Click()
Dim rdp As RASDIALPARAMS, t As Long
rdp.dwSize = Len(rdp) + 6
ChangeBytes List1.Text, rdp.szEntryName
'Get User name and password for the connection
t = RasGetEntryDialParams(List1.Text, rdp, 0)
If t = 0 Then
Text1 = ChangeToStringUni(rdp.szUserName)
Text2 = ChangeToStringUni(rdp.szPassword)
End If
End SubPrivate Sub Form_Load()
'example created by Daniel Kaufmann ([email protected])
'load the connections
Text2.PasswordChar = "*"
Command1.Caption = "Dial"
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
List1_Click
End If
End Sub