VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - RAS API上的其他Function
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10934, 日期:2001-09-17
 RAS API上的其他Function


作者: cww 

取得目前连接信息
    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值


注释:Below is in rasapi.bas
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 lpPhoneBook As String, _
  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
    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 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 PhonePath 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, 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, 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 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, 0, AddressOf RasDialFunc, hRasConn)

注释:若第二、三个叁数都是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(hRasConn)
End If
End Function





Public Sub RasDialFunc(ByVal unMsg As Long, _
                       ByVal ConnState As Long, _
                       ByVal dwError As Long)
If ConnState = &H2000 Then
   注释: Connect Complete
End If

Debug.Print unMsg, ConnState
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 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