rasmain.frm

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

End Sub

Private Sub cmdRemoveConnection_Click()

   Dim boolSuccess As Boolean

   '删除被选中的连接
   Select Case trvConnections.SelectedItem.Image
      Case 2, 3
         On Error GoTo errhand
         objRASEng.Connections.RemoveConnection CInt(Right$(trvConnections.SelectedItem.Key, Len(trvConnections.SelectedItem.Key) - 4))
         '为了能够使计算机能够响应关闭连接的时间，调用DoEvents
         DoEvents
         boolSuccess = fcnRefreshConnectionTree()
         On Error GoTo 0
      Case Else
         '不作处理
   End Select
   Exit Sub
   
errhand:
   Call fcnErrorHandler
   Exit Sub

End Sub

Private Sub cmdUpdateEntry_Click()

   trvPhonebook.StartLabelEdit
   
End Sub



Private Function fcnRefreshPhonebookTree() As Boolean
'刷新视图的函数
   Dim intEntryLooper As Integer
   Dim strTemp As String
   
   fcnRefreshPhonebookTree = False
   '首先删除所有的树节点
     trvPhonebook.Nodes.Clear
   '建立起始结点
     trvPhonebook.Nodes.Add , , "PHTopNode", "电话簿", 1, 1
   '首先按照字符顺序A、B、C....Z等顺序建立字节点，为了方便用户寻找不同的电话簿，电话簿如果名字以
   'A开头，则可以在树视图A的下面查看
   For intEntryLooper = 65 To 90
   '循环建立
      trvPhonebook.Nodes.Add "PHTopNode", tvwChild, Chr$(intEntryLooper), Chr$(intEntryLooper), 2, 3
   Next intEntryLooper
   '增加其他电话簿，如果名字不是以字符开头，则列在该项下面
   trvPhonebook.Nodes.Add "PHTopNode", tvwChild, "NumericNode", "其他电话簿", 2, 3
   '填充整个视图，首先遍历计算机中所有的电话簿，并在相关的字节点下建立相关子节点
   For intEntryLooper = 0 To objRASEng.PhoneEntries.Count - 1
   '循环得到每一个电话簿
         '所有电话簿的信息都是从PhoneEntries类中得到的
         With objRASEng.PhoneEntries(CVar(intEntryLooper))
            '得到电话簿的名称
            strTemp = .EntryName
            If Asc(UCase$(Left$(strTemp, 1))) >= 65 And Asc(UCase$(Left$(strTemp, 1))) <= 90 Then
            '分析电话簿的名称首字符，以便加入相关的字节点中
            '把每个电话簿的相关信息如电话号码、用户名、用户密码等加入
               trvPhonebook.Nodes.Add UCase$(Left$(strTemp, 1)), tvwChild, "key" & intEntryLooper, strTemp, 2, 3
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "phn" & intEntryLooper, "Phone Number", 7, 8
               trvPhonebook.Nodes.Add "phn" & intEntryLooper, tvwChild, "phonen" & intEntryLooper, .PhoneNumber, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "cbn" & intEntryLooper, "Callback Number", 7, 8
               trvPhonebook.Nodes.Add "cbn" & intEntryLooper, tvwChild, "callba" & intEntryLooper, .CallbackNumber, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "usn" & intEntryLooper, "User Name", 7, 8
               trvPhonebook.Nodes.Add "usn" & intEntryLooper, tvwChild, "userna" & intEntryLooper, .UserName, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "pwd" & intEntryLooper, "Password", 7, 8
               trvPhonebook.Nodes.Add "pwd" & intEntryLooper, tvwChild, "passwo" & intEntryLooper, .Password, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "dmn" & intEntryLooper, "Domain", 7, 8
               trvPhonebook.Nodes.Add "dmn" & intEntryLooper, tvwChild, "domain" & intEntryLooper, .Domain, 4, 4
            Else '如果是以数字或者其他字符开始
               trvPhonebook.Nodes.Add "NumericNode", tvwChild, "key" & intEntryLooper, strTemp, 2, 3
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "phn" & intEntryLooper, "Phone Number", 7, 8
               trvPhonebook.Nodes.Add "phn" & intEntryLooper, tvwChild, "phonen" & intEntryLooper, .PhoneNumber, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "cbn" & intEntryLooper, "Callback Number", 7, 8
               trvPhonebook.Nodes.Add "cbn" & intEntryLooper, tvwChild, "callba" & intEntryLooper, .CallbackNumber, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "usn" & intEntryLooper, "User Name", 7, 8
               trvPhonebook.Nodes.Add "usn" & intEntryLooper, tvwChild, "userna" & intEntryLooper, .UserName, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "pwd" & intEntryLooper, "Password", 7, 8
               trvPhonebook.Nodes.Add "pwd" & intEntryLooper, tvwChild, "passwo" & intEntryLooper, .Password, 4, 4
               
               trvPhonebook.Nodes.Add "key" & intEntryLooper, tvwChild, "dmn" & intEntryLooper, "Domain", 7, 8
               trvPhonebook.Nodes.Add "dmn" & intEntryLooper, tvwChild, "domain" & intEntryLooper, .Domain, 4, 4
            End If
         End With
   Next intEntryLooper
   trvPhonebook.Nodes(2).EnsureVisible
   cmdEditEntry.Enabled = False
   cmdDialNumber.Enabled = False
   cmdUpdateEntry.Enabled = False
   fcnRefreshPhonebookTree = True

End Function



Private Sub Form_Load()

   Dim boolSuccess As Boolean

   On Error GoTo errhand
      frmRASMAIN.MousePointer = 11
      '程序启动的时候，创建一个主类RASEngine
      Set objRASEng = New RASEngine
      '将视图控件和图象列表控件相关
      trvPhonebook.ImageList = imgTreeIcons
      trvConnections.ImageList = imgTreeIcons
      '刷新视图
      boolSuccess = fcnRefreshPhonebookTree()
      boolSuccess = fcnRefreshConnectionTree()
      frmRASMAIN.MousePointer = 0
   On Error GoTo 0
   Exit Sub
 
errhand:
   Call fcnErrorHandler
   Unload frmmain
   Resume Next
   
End Sub

Private Sub trvConnections_NodeClick(ByVal Node As Node)

   '根据选中的节点来使得删除按钮是否有效
    Select Case Node.Image
      Case 2, 3
         cmdRemoveConnection.Enabled = True
      Case Else
         cmdRemoveConnection.Enabled = False
    End Select

End Sub

Private Sub trvPhonebook_AfterLabelEdit(Cancel As Integer, NewString As String)
'如果直接在树形视图中修改属性，则需要将新的属性提交
Dim boolSuccess As Boolean
   Dim intTempIndex As Integer

   On Error GoTo errhand
      Select Case Left$(trvPhonebook.SelectedItem.Key, 6)
         Case "callba"
            intTempIndex = CInt(Val(Right$(trvPhonebook.SelectedItem.Key, Len(trvPhonebook.SelectedItem.Key) - 6)))
            objRASEng.PhoneEntries(CVar(intTempIndex)).CallbackNumber = NewString
            trvPhonebook.SelectedItem.Text = objRASEng.PhoneEntries(CVar(intTempIndex)).CallbackNumber
         Case "phonen"
            intTempIndex = CInt(Val(Right$(trvPhonebook.SelectedItem.Key, Len(trvPhonebook.SelectedItem.Key) - 6)))
            objRASEng.PhoneEntries(CVar(intTempIndex)).PhoneNumber = NewString
            trvPhonebook.SelectedItem.Text = objRASEng.PhoneEntries(CVar(intTempIndex)).PhoneNumber
         Case "userna"
            intTempIndex = CInt(Val(Right$(trvPhonebook.SelectedItem.Key, Len(trvPhonebook.SelectedItem.Key) - 6)))
            objRASEng.PhoneEntries(CVar(intTempIndex)).UserName = NewString
            trvPhonebook.SelectedItem.Text = objRASEng.PhoneEntries(CVar(intTempIndex)).UserName
         Case "passwo"
            intTempIndex = CInt(Val(Right$(trvPhonebook.SelectedItem.Key, Len(trvPhonebook.SelectedItem.Key) - 6)))
            objRASEng.PhoneEntries(CVar(intTempIndex)).Password = NewString
            trvPhonebook.SelectedItem.Text = objRASEng.PhoneEntries(CVar(intTempIndex)).Password
         Case "domain"
            intTempIndex = CInt(Val(Right$(trvPhonebook.SelectedItem.Key, Len(trvPhonebook.SelectedItem.Key) - 6)))
            objRASEng.PhoneEntries(CVar(intTempIndex)).Domain = NewString
            trvPhonebook.SelectedItem.Text = objRASEng.PhoneEntries(CVar(intTempIndex)).Domain
         Case Else
            Cancel = True
      End Select
   On Error GoTo 0
   Exit Sub
   
errhand:
   Call fcnErrorHandler
   Cancel = True
   Resume Next

End Sub

Private Sub trvPhonebook_NodeClick(ByVal Node As Node)

   '根据不同的节点级别来设置是否能够更改
   Select Case Node.Image
      Case 2, 3
         '如果节点关键字前三位为key，则设置按钮的相关属性
         If Left$(Node.Key, 3) = "key" Then
            cmdEditEntry.Enabled = True
            cmdDialNumber.Enabled = True
            cmdUpdateEntry.Enabled = False
         Else
            cmdEditEntry.Enabled = False
            cmdDialNumber.Enabled = False
            cmdUpdateEntry.Enabled = False
         End If
      Case 4
         '改变属性，属于下一级节点
         cmdEditEntry.Enabled = False
         cmdDialNumber.Enabled = False
         cmdUpdateEntry.Enabled = True
      Case Else
         cmdEditEntry.Enabled = False
         cmdDialNumber.Enabled = False
         cmdUpdateEntry.Enabled = False
    End Select
    
    
End Sub

Private Function fcnRefreshConnectionTree() As Boolean
'刷新连接树视图
   Dim intConnLooper As Integer
   
   fcnRefreshConnectionTree = False
   '首先删除树视图所有节点
   trvConnections.Nodes.Clear
   '设置顶节点
   trvConnections.Nodes.Add , , "CTopNode", "我的连接", 5, 5
   '显示所有的连接
   For intConnLooper = 0 To objRASEng.Connections.Count - 1
         With objRASEng.Connections(CVar(intEntryLooper))
            '建立连接节点
            trvConnections.Nodes.Add "CTopNode", tvwChild, "conn" & intConnLooper, "Connection " & intConnLooper, 2, 3
            '设定节点的名称和值
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "entry" & intConnLooper, "Entry Name", 7, 8
            trvConnections.Nodes.Add "entry" & intConnLooper, tvwChild, "entryval" & intConnLooper, .EntryName, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "hconn" & intConnLooper, "Connection Handle", 7, 8
            trvConnections.Nodes.Add "hconn" & intConnLooper, tvwChild, "hconnval" & intConnLooper, Str$(.hRasConn), 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "devnm" & intConnLooper, "Device Name", 7, 8
            trvConnections.Nodes.Add "devnm" & intConnLooper, tvwChild, "devnmval" & intConnLooper, .DeviceName, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "devtp" & intConnLooper, "Device Type", 7, 8
            trvConnections.Nodes.Add "devtp" & intConnLooper, tvwChild, "devtpval" & intConnLooper, .DeviceType, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "state" & intConnLooper, "Connection State", 7, 8
            trvConnections.Nodes.Add "state" & intConnLooper, tvwChild, "stateval" & intConnLooper, Str$(.State), 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "wksnm" & intConnLooper, "Workstation Name", 7, 8
            trvConnections.Nodes.Add "wksnm" & intConnLooper, tvwChild, "wksnmval" & intConnLooper, .WorkstationName, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "IPadd" & intConnLooper, "IP Addess", 7, 8
            trvConnections.Nodes.Add "IPadd" & intConnLooper, tvwChild, "IPaddval" & intConnLooper, .IPAddress, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "IPXad" & intConnLooper, "IPX Address", 7, 8
            trvConnections.Nodes.Add "IPXad" & intConnLooper, tvwChild, "IPXadval" & intConnLooper, .IPXAddress, 6, 6
            trvConnections.Nodes.Add "conn" & intConnLooper, tvwChild, "hlana" & intConnLooper, "LANA", 7, 8
            trvConnections.Nodes.Add "hlana" & intConnLooper, tvwChild, "hlanaval" & intConnLooper, Str(CInt(.LANA)), 6, 6
         End With
   Next intConnLooper
   trvConnections.Nodes(1).EnsureVisible
   If trvConnections.Nodes(1).Children Then
      trvConnections.Nodes(2).EnsureVisible
   End If
   fcnRefreshConnectionTree = True
   cmdRemoveConnection.Enabled = False

End Function

Public Sub fcnErrorHandler()
'错误处理
   Select Case Err.Number
      'RAS error
      Case vbObjectError + 600 To vbObjectError + 750
         MsgBox objRASEng.RASError.Description, vbCritical, "Error: " & objRASEng.RASError.ErrorNumber
         objRASEng.RASError.Clear
      'RAS WIN32 error
      Case vbObjectError + 120
         MsgBox objRASEng.RASError.Description, vbCritical, "Error: " & objRASEng.RASError.ErrorNumber
         objRASEng.RASError.Clear
      'RAS Initialize error
      Case vbObjectError + 1911
         MsgBox "Ras is not Properly Configured on this machine", vbCritical, "Error: 1911"
      'RAS could not get version
      Case vbObjectError + 1912
         MsgBox "Could not determine Windows version on this machine", vbCritical, "Error: 1912"
      'Failed to decrement instance count on RAS DLL
      Case vbObjectError + 1913
         MsgBox "RAS was not properly deinitialized", vbCritical, "Error: 1913"
      Case vbObjectError + 6
         MsgBox objRASEng.RASError.Description & vbCrLf & "Often The Result Of An Invalid Connection Handle" & vbCrLf & "Refresh Connections And Try Again If Necessary", vbCritical, "Error: " & objRASEng.RASError.ErrorNumber
         objRASEng.RASError.Clear
      'VB or unexpected errors
      Case Else
         MsgBox Err.Description, vbCritical, "Error: " & Err.Number
   End Select

End Sub