raseng.cls

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "RASEngine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'该类是本程序地主类
'通过这个类调用其他的几个类

'*************************************************************************************************************************

'定义结构体，获得系统信息
Private lpOSInfo As OSVERSIONINFO
'定义变量来保存系统的版本
Private sngOSVersion As Single
'保存拨号的创建的对象，也就是如果有多个拨号连接，则保存连接个数
Private hRASDLLInstance As Long

Private Sub Class_Initialize()
    
   '在类初始化的时候获得系统版本
   Dim lngErrNum As Long
   Dim lngbugfix As Long
    
   Set lpRASError = New RASError
   lngbugfix = lpRASError.ErrorNumber
   Set lpPhoneEntries = New PhoneEntries
   lngbugfix = lpPhoneEntries.Count
   Set lpConnections = New Connections
   lngbugfix = lpConnections.Count
   '初始化RAS
   lngErrNum = fcnLoadandCheckRAS()
   If lngErrNum Then
      '如果不为0，表示错误
      Err.Raise vbObjectError + 1911, "RAS.RASEngine", "RAS Could Not Be Initialized. WIN32 Error: " & Str$(lngErrNum)
   Else
      '否则表示已经将该RAS载入
      '设置结构体字段值
      lpOSInfo.dwOSVersionInfoSize = 148
      If (GetVersionEx(lpOSInfo)) Then
         '获得系统版本，并保存在一个全局变量中
         lngWindowVersion = lpOSInfo.dwPlatformId
         '合并两个字段来表示系统版本名
         sngOSVersion = CSng(lpOSInfo.dwMajorVersion) + CSng(Val("." & Str$(lpOSInfo.dwMinorVersion)))
      Else
         lngErrNum = GetLastError()
         '错误处理
         Err.Raise vbObjectError + 1912, "RAS.RASEngine", "GetVersionEx Failed With WIN32 Error: " & Str$(lngErrNum)
      End If
   End If
       
End Sub





Public Property Get OSVersion() As Single

   '获得系统版本
   OSVersion = sngOSVersion

End Property



Public Property Get OSBuildNumber() As Long
   
   OSBuildNumber = lpOSInfo.dwBuildNumber

End Property


Public Property Get OSType() As Long
   
   'WIN32s = 0
   'WIN 95 = 1
   'WIN NT = 2
   OSType = lpOSInfo.dwPlatformId

End Property



Public Function RASError() As RASError
   
   'set up a new pointer to Error object
   Set RASError = lpRASError
   
End Function



Public Function Connections(Optional ByVal Index As Variant) As Object

   If IsMissing(Index) Then
      'set pointer to my Connections collection object
      Set Connections = lpConnections
   Else
      'set pointer to the Connection Object
      Set Connections = arrConnection(Index)
   End If
 
End Function



Public Function PhoneEntries(Optional ByVal Index As Variant) As Object
   
   If IsMissing(Index) Then
      '如果省略index，获得电话簿集
      Set PhoneEntries = lpPhoneEntries
   Else
      '获得某一个电话簿
      Set PhoneEntries = arrPEntry(Index)
   End If
   
End Function

Private Function fcnLoadandCheckRAS() As Long

   '载入动态连接库
   hRASDLLInstance = LoadLibrary("RASAPI32.DLL")
   If hRASDLLInstance Then
      fcnLoadandCheckRAS = 0
   Else
      fcnLoadandCheckRAS = GetLastError()
   End If
    
End Function

Private Function fcnUnloadRAS() As Long

   Dim lngRetCode As Long
    
   '释放RAS动态库
   lngRetCode = FreeLibrary(hRASDLLInstance)
   If lngRetCode Then
      fcnUnloadRAS = 0
   Else
      fcnUnloadRAS = GetLastError()
   End If
    
End Function

Private Sub Class_Terminate()
'类终止事件
   Dim lngErrNum As Long
   Dim intLooper As Long
   
   '终止所有的活动连接
   On Error Resume Next
   For intLooper = 0 To lpConnections.Count - 1
      lpConnections.RemoveConnection (intLooper)
   Next intLooper
   On Error GoTo 0
   
   '释放类资源
   Set lpPhoneEntries = Nothing
   Set lpConnections = Nothing
   Set lpRASError = Nothing
   lngErrNum = fcnUnloadRAS()
   If lngErrNum Then Err.Raise vbObjectError + 1913, "RAS.RASEngine", "RAS was not properly uninitialized. WIN32 Error: " & Str$(lngErrNum)
   
End Sub