发信人: raind()
整理人: cobe(2001-07-27 14:38:41), 站内信件
|
【 在 fuvid (炎热夏日) 的大作中提到: 】
: 哪位有RAS拔号的VB程序，能给我一份或者
: 能告知怎样调用API RASDIAL，本人将万分
: 感谢。
:
: .......
你运气不错，我刚好也在编一个包含拨号的程序，下面的函数是我费了很多心才
找到的：
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
Public Const RAS_RASCONNSIZE As Integer = 412
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 lpPhoneB
ook As String) As Long
Declare Function RasEditPhonebookEntry Lib "rasapi32" _
Alias "RasEditPhonebookEntryA" (ByVal hwnd As Long, ByVal lpPhoneBoo
k As String, _
ByVal lpEntryName As String) As Long
Declare Function RasGetErrorString Lib "rasapi32" _
Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr A
s 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
RASCS_AuthCallback
RASCS_AuthChangePassword
RASCS_AuthProject
RASCS_AuthLinkSpeed
RASCS_AuthAck
RASCS_ReAuthenticate
RASCS_Authenticated
RASCS_PrepareForCallback
RASCS_WaitForModemReset
RASCS_WaitForCallback
RASCS_Projected
RASCS_StartAuthentication '19
RASCS_CallbackComplete
RASCS_LogonNetwork '21
RASCS_Interactive = &H1000
RASCS_RetryAuthentication
RASCS_CallbackSetByCaller
RASCS_PasswordExpired
RASCS_Connected = &H2000
RASCS_Disconnected
End Enum
Public gstrISPName As String
Public ReturnCode As Long
Public Sub 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
ReturnCode = RasEnumConnections(lprasconn(0), lpcb, _
lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lprasconn(i).szEntryName)) _
= Trim(gstrISPName) Then
hRasConn = lprasconn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function
'取得目前连线资讯
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), Size, validConnection)
End If
If dl = 0 Then
GetAllConnections = validConnection
Else
GetAllConnections = -1
End If
End Function
'取得所有拨号网路Entry的资讯(不管有没有连线)
Public Function GetRasNameEntries(Entry() As RasEntryName, Optional Ph
onePath As String) As Long
Dim di As Long, lpcb As Long, lpentries As Long
Dim addit As Long
Dim i As Long
di& = RasEnumEntries(vbNullString, PhonePath, 0, 0, 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, PhonePath, Entry(0), lpcb, lpent
ries)
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 PhonePa
th As String)
Dim di As Long
di = RasEditPhonebookEntry(0, PhonePath, 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 UserN As Strin
g, _
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, 0, AddressOf RasDialFunc, hRas
Conn)
'若第二、三个叁数都是0则，RasDial会等连线成功或失败後才执行下一行指令
'di = RasDial(0, PhoneBook, RasDialPara, 0, 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, str5, Chr(0)) - 1), vbCritical
Call HangUp
End If
End Function
Public Sub RasDialFunc(ByVal unMsg As Long, _
ByVal ConnState As Long, _
ByVal dwError As Long)
If ConnState = &H2000 Then
MsgBox "拨号连接成功建立", vbInformation
End If
'Debug.Print unMsg, ConnState
End Sub
'取得连线状态
Public Function GetConnectStatus(ByVal hocnn 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
--
天变地变，唯有对计算机的情不变。
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.98.131.142]
|
|