程式自动呼叫拨号网络(RAS API)

领测软件测试网

　　 
　　程式自动呼叫拨号网络(RAS API)

作者: cww　

在RAS API的呼叫上，有许多方要注意，以下便加以说明

在C中宣告成
#Define RAS_MaxEntryName  256;
Struct RASENTRYNAME
{

    DWORD dwSize;
    CHAR  szEntryName[ RAS_MaxEntryName + 1 ];
};

VB 宣告成
Public Const RAS_MaxEntryName = 256

Private Type RASENTRYNAME
  dwSize As Long
  szEntryName(RAS_MaxEntryName) As Byte
End Type

　　c 中 Char aa[16] 代表长度是16，可放 15个byte所以对应於vb便是 aa(15) as Byte
如此才是长度16 ( 0--15)。故VB的宣告中不能再用szEntryName(RAS_MaxEntryName+1)

　　但是Lenb(RASENTRYNAME)的长度却是 261 (4+257)，的确，这是vb的问题，而c 的SizeOf传回的是4的倍数(32位元嘛)故值为264，所以我们计算某个Structure的长度时，要再多一些运算。

以下的Fuction只适用於32位元的win95/ NT，

注释：以下在Form中

Private hConn as Long
Private Sub Command1_Click()
  hConn = Dialup("我的连线", "user", "passwd")
  if hConn = 0 Then
     Debug.Print "连线失败"
  end if
End Sub

Private Sub Command2_Click()
  Call HangUp(hConn)
End Sub

注释：以下在.bas中
Option Explicit
  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 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 RasGetErrorString Lib "rasapi32" _
    Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As String, _
    ByVal cSize As Long) As Long
  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 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)

  注释：自动拨号(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

  注释：取消拨号
  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

  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
  

文章来源于领测软件测试网 https://www.ltesting.net/