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

'类内部变量
Private strEntryName As String
Private strPhoneNumber As String
Private strCallbackNumber As String
Private strUserName As String
Private strPassword As String
Private strDomain As String
Private intIndex As Integer
'标志密码是否获得变量
Private lngGotPassword As Long

Public Property Get EntryName() As String
'获得电话簿名称
   EntryName = strEntryName

End Property

Public Property Let EntryName(strNewName As String)
'设置电话簿名称
   Dim lngRetCode As Long

   '如果允许修改
   If boolAllowUpdate Then
      strEntryName = strNewName
      lngRetCode = fcnRasGetEntryDialParams()
      If lngRetCode Then
         Err.Raise vbObjectError + lngRetCode, "EntryName Set Failed", "RAS Failure"
      End If
   Else
      lngRASErrorNumber = 1111
      strRASDescription = "Property Not Updateable"
      Err.Raise vbObjectError + 1111, "Property Not Updateable", "RAS Failure"
   End If

End Property

Public Function DialEntry(boolAsync As Boolean) As Connection

   '
   Set DialEntry = lpConnections.AddConnection(strEntryName, "", "", "", "", "", boolAsync)

End Function

Public Sub EditEntry()

   Dim lngRetCode As Long
   
   '编辑电话簿，注意在NT下会失败，但在95/98下面可以成功
   lngRetCode = RasEditPhonebookEntry(APINULL, vbNullString, strEntryName)
    If lngRetCode Then
      lngRASErrorNumber = lngRetCode
      strRASDescription = lpRASError.fcnRASErrorString()
      Err.Raise vbObjectError + lngRetCode, "EditEntry Method Failed", "RAS Failure"
    End If

End Sub

Private Function fcnRasGetEntryDialParams() As Long

   Dim lngRetCode As Long
   Dim lngRetlstrcpy As Long
   '在NT下会失败
   Dim lprasdialparams As RASDIALPARAMS95
   
   '设置结构体
   lprasdialparams.dwSize = 1052
   lngRetlstrcpy = lstrcpy(lprasdialparams.szEntryName(0), strEntryName)
   lngRetCode = RasGetEntryDialParams(vbNullString, lprasdialparams, lngGotPassword)
   Select Case lngRetCode
      Case SUCCESS
         '如果成功
         strUserName = fcnTrimNulls(StrConv(lprasdialparams.szUserName, vbUnicode))
         strPhoneNumber = fcnTrimNulls(StrConv(lprasdialparams.szPhoneNumber, vbUnicode))
         strCallbackNumber = fcnTrimNulls(StrConv(lprasdialparams.szCallbackNumber, vbUnicode))
         If lngGotPassword = 1 Then
            strPassword = fcnTrimNulls(StrConv(lprasdialparams.szPassword, vbUnicode))
         Else
            strPassword = "Password Not Available"
         End If
         strDomain = fcnTrimNulls(StrConv(lprasdialparams.szDomain, vbUnicode))
         fcnRasGetEntryDialParams = 0
      Case NOT_SUPPORTED
         '如果是NT系统，设置为 "Not Available"
         strUserName = "Not Available"
         strPhoneNumber = "Not Available"
         strCallbackNumber = "Not Available"
         strPassword = "Not Available"
         strDomain = "Not Available"
         'Not going to fail on NT because this is extraneous info
         fcnRasGetEntryDialParams = 0
      Case Else
         '其他情况
         strUserName = "Not Available"
         strPhoneNumber = "Not Available"
         strCallbackNumber = "Not Available"
         strPassword = "Not Available"
         strDomain = "Not Available"
         lngRASErrorNumber = lngRetCode
         lngRASErrorNumber = lngRetCode
         strRASDescription = lpRASError.fcnRASErrorString()
         fcnRasGetEntryDialParams = lngRetCode
   End Select
   
End Function

Private Function fcnRasSetEntryDialParams() As Long

   Dim lngRetCode As Long
   Dim lngRetlstrcpy As Long
   Dim lngAttemptOrder As Long
   'NT下会失败
   Dim lprasdialparams As RASDIALPARAMS95
    
   lprasdialparams.dwSize = 1052
   lngRetlstrcpy = lstrcpy(lprasdialparams.szEntryName(0), strEntryName)
   lngRetlstrcpy = lstrcpy(lprasdialparams.szUserName(0), strUserName)
   lngRetlstrcpy = lstrcpy(lprasdialparams.szDomain(0), strDomain)
   lngRetlstrcpy = lstrcpy(lprasdialparams.szPhoneNumber(0), strPhoneNumber)
   lngRetlstrcpy = lstrcpy(lprasdialparams.szCallbackNumber(0), strCallbackNumber)
   '获得密码
   If lngGotPassword = 1 Then
      lngRetlstrcpy = lstrcpy(lprasdialparams.szPassword(0), strPassword)
   Else
      lngRetlstrcpy = lstrcpy(lprasdialparams.szPassword(0), "")
   End If
   lngRetCode = RasSetEntryDialParams(vbNullString, lprasdialparams, 0&)
   Select Case lngRetCode
      Case SUCCESS
         strUserName = fcnTrimNulls(StrConv(lprasdialparams.szUserName, vbUnicode))
         strPhoneNumber = fcnTrimNulls(StrConv(lprasdialparams.szPhoneNumber, vbUnicode))
         strCallbackNumber = fcnTrimNulls(StrConv(lprasdialparams.szCallbackNumber, vbUnicode))
         If lngGotPassword Then
            strPassword = fcnTrimNulls(StrConv(lprasdialparams.szPassword, vbUnicode))
         Else
            strPassword = "Not Available"
         End If
         strDomain = fcnTrimNulls(StrConv(lprasdialparams.szDomain, vbUnicode))
         fcnRasSetEntryDialParams = 0
      Case NOT_SUPPORTED
         'NT系统会失败
         strUserName = "Not Available"
         strPhoneNumber = "Not Available"
         strCallbackNumber = "Not Available"
         strPassword = "Not Available"
         strDomain = "Not Available"
         lngRASErrorNumber = lngRetCode
         strRASDescription = lpRASError.fcnRASErrorString()
         fcnRasSetEntryDialParams = lngRetCode
      Case Else
         '设置为原来的值
         lngAttemptOrder = fcnRasGetEntryDialParams()
         lngRASErrorNumber = lngRetCode
         lngRASErrorNumber = lngRetCode
         strRASDescription = lpRASError.fcnRASErrorString()
         fcnRasSetEntryDialParams = lngRetCode
         
   End Select
    
End Function

Public Property Get PhoneNumber() As String

   PhoneNumber = strPhoneNumber

End Property

Public Property Let PhoneNumber(strNewNumber As String)

   Dim lngRetCode As Long
   
   strPhoneNumber = strNewNumber
   lngRetCode = fcnRasSetEntryDialParams()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "PhoneNumber Set Failed", "RAS Failure"
   End If
   
End Property

Public Property Get CallbackNumber() As String

   CallbackNumber = strCallbackNumber

End Property

Public Property Let CallbackNumber(strNewNumber As String)

   Dim lngRetCode As Long
   strCallbackNumber = strNewNumber
   lngRetCode = fcnRasSetEntryDialParams()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "CallbackNumber Set Failed", "RAS Failure"
   End If

End Property

Public Property Get UserName() As String

   UserName = strUserName

End Property

Public Property Let UserName(strNewUser As String)

   Dim lngRetCode As Long
   
   strUserName = strNewUser
   lngRetCode = fcnRasSetEntryDialParams()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "UserName Set Failed", "RAS Failure"
   End If

End Property

Public Property Get Password() As String

   Password = strPassword

End Property

Public Property Let Password(strNewPassword As String)

   Dim lngRetCode As Long
   
   strPassword = strNewPassword
   lngRetCode = fcnRasSetEntryDialParams()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "Password Set Failed", "RAS Failure"
   End If

End Property

Public Property Get Domain() As String

   Domain = strDomain

End Property

Public Property Let Domain(strNewDomain As String)

   Dim lngRetCode As Long
   
   strDomain = strNewDomain
   lngRetCode = fcnRasSetEntryDialParams()
   If lngRetCode Then
      Err.Raise vbObjectError + lngRetCode, "Domain Set Failed", "RAS Failure"
   End If

End Property

Public Property Get Index() As Integer

   Index = intIndex

End Property

Public Property Let Index(intNewIndex As Integer)

   If boolAllowUpdate Then
      intIndex = intNewIndex
   Else
      lngRASErrorNumber = 1111
      strRASDescription = "Property Not Updateable"
      Err.Raise vbObjectError + 1111, "Property Not Updateable", "RAS Failure"
   End If

End Property