entries.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 = "PhoneEntries"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'***********************************************************************************************************************************************************************************************************
'电话簿地个数
Private intPCount As Integer

Public Property Get Count() As Integer
'获得电话簿的个数
   Dim lngRetCode

   '通过函数fcnRASEnumEntries获得电话簿的个数
   lngRetCode = fcnRASEnumEntries()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "Connections.Count Failure", "RAS Failure"
   Else
      Count = intPCount
   End If

End Property

Private Function fcnRASEnumEntries() As Long
 
   Dim lngRetCode As Long
   Dim lpszreserved As String
   Dim lpszPhonebook As String
   Dim lpcb As Long
   Dim lpcEntries As Long
   Dim intArraySize As Integer
   Dim intLooper As Long
   
   lpszreserved = vbNullString
   lpszPhonebook = vbNullString
   '定义最大256个电话簿，如果有必要可以增加
   intArraySize = 255
   If lngWindowVersion = 2 Then
      'NT系统
      '定义结构体数组
      ReDim lprasentryname(intArraySize) As RASENTRYNAME
      lprasentryname(0).dwSize = 28
      lpcb = 256 * lprasentryname(0).dwSize
      lngRetCode = RasEnumEntries(lpszreserved, lpszPhonebook, lprasentryname(0), lpcb, lpcEntries)
   Else
      '95/98操作系统 (lngWindowVersion =1)
      ReDim lprasentryname95(intArraySize) As RASENTRYNAME95
      lprasentryname95(0).dwSize = 264
      lpcb = 256 * lprasentryname95(0).dwSize
      lngRetCode = RasEnumEntries(lpszreserved, lpszPhonebook, lprasentryname95(0), lpcb, lpcEntries)
   End If
   Select Case lngRetCode
      Case SUCCESS
         If lpcEntries > 0 Then
            '定义数组大小位获得电话簿的个数
            ReDim arrPEntry(lpcEntries - 1) As PhoneEntry
            If lngWindowVersion = 2 Then
                'NT操作系统
               For intLooper = 0 To UBound(arrPEntry())
                  Set arrPEntry(intLooper) = New PhoneEntry
                  '允许直接在树视图里面修改属性
                  boolAllowUpdate = True
                  arrPEntry(intLooper).EntryName = fcnTrimNulls(StrConv(lprasentryname(intLooper).szEntryName, vbUnicode))
                  arrPEntry(intLooper).Index = intLooper
                  boolAllowUpdate = False
               Next intLooper
            Else
               '95/98操作系统
               For intLooper = 0 To UBound(arrPEntry())
                  Set arrPEntry(intLooper) = New PhoneEntry
                  '允许修改属性
                  boolAllowUpdate = True
                  arrPEntry(intLooper).EntryName = fcnTrimNulls(StrConv(lprasentryname95(intLooper).szEntryName, vbUnicode))
                  arrPEntry(intLooper).Index = intLooper
                  boolAllowUpdate = False
               Next intLooper
            End If
         End If
         intPCount = CInt(lpcEntries)
         fcnRASEnumEntries = 0
      Case ERROR_BUFFER_TOO_SMALL
         '如果缓冲区太小，扩大缓冲区
         If lngWindowVersion = 2 Then
            'running NT
            intArraySize = lpcb / lprasentryname(0).dwSize
         Else
            'running 95
            intArraySize = lpcb / lprasentryname95(0).dwSize
         End If
      Case Else
         lngRASErrorNumber = lngRetCode
         strRASDescription = lpRASError.fcnRASErrorString()
         fcnRASEnumEntries = lngRetCode
   End Select
  
End Function

Private Sub Class_Initialize()
   
   Dim lngSuccess As Long
   '类初始化的时候获得所有的电话簿
   lngSuccess = fcnRASEnumEntries()
   
End Sub

Public Sub AddEntry()

   Dim lngRetCode As Long
   
   '通过RasCreatePhonebookEntry函数增加电话簿
   lngRetCode = RasCreatePhonebookEntry(APINULL, "")
      If lngRetCode Then
         lngRASErrorNumber = lngRetCode
         strRASDescription = lpRASError.fcnRASErrorString()
         Err.Raise vbObjectError + lngRetCode, "PhoneEntries AddEntry Failed", "RAS Failure"
      Else
         '如果成功，则重新刷新电话簿树视图
         lngRetCode = fcnRASEnumEntries()
         If lngRetCode Then Err.Raise vbObjectError + lngRetCode, "PhoneEntries AddEntry Failed", "RAS Failure"
      End If

End Sub