frmadial.frm

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

VERSION 5.00
Begin VB.Form frmAsyncDial 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "异步拨号"
   ClientHeight    =   1755
   ClientLeft      =   1785
   ClientTop       =   3795
   ClientWidth     =   5325
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1755
   ScaleWidth      =   5325
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Enabled         =   0   'False
      Height          =   495
      Left            =   3240
      TabIndex        =   3
      Top             =   1080
      Width           =   1935
   End
   Begin VB.Timer tmrGetConnStatus 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   2520
      Top             =   1200
   End
   Begin VB.TextBox txtCallStatus 
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   5055
   End
   Begin VB.CommandButton cmdHangUp 
      Caption         =   "挂断"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   1935
   End
   Begin VB.Label lblCallStatus 
      Caption         =   "状态"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   735
   End
End
Attribute VB_Name = "frmAsyncDial"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private hRasConn As Long

Private Sub cmdClose_Click()

   Unload frmAsyncDial

End Sub

Private Sub cmdHangUp_Click()
   
    Dim lngRetCode As Long
   
   '挂断连接，调用函数RasHangUp
   lngRetCode = RasHangUp(hRasConn)
   '卸载窗体
   Unload frmAsyncDial

End Sub

Private Sub Form_Activate()

   '改变鼠标形状
   Screen.MousePointer = vbArrowHourglass
   '是关闭按钮无效
   cmdClose.Enabled = False
   '设置文本框属性
   txtCallStatus.FontBold = False
   txtCallStatus.ForeColor = 0 'black
  
   '获得正在连接的句柄，注意是通过窗体的Tag属性传递的
   hRasConn = "&H" & frmAsyncDial.Tag
   '设置时钟控件可用
   tmrGetConnStatus.Enabled = True

End Sub

Private Sub Form_Load()

   '设定窗体位置
   frmAsyncDial.Top = ((Screen.Height / 2) - (frmAsyncDial.Height / 2))
   frmAsyncDial.Left = ((Screen.Width / 2) - (frmAsyncDial.Width / 2))
   
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
   '停止时钟
   tmrGetConnStatus.Enabled = False
   '改变鼠标形状为默认
   Screen.MousePointer = vbDefault
   
End Sub

Private Sub tmrGetConnStatus_Timer()
'该时钟控件处理函数实现的是获得异步拨号时的各种状态
  Dim lngRetCode As Long
  Dim lngRASConnState As Long
  Dim lngRASError As Long
    
   If lngWindowVersion = 2 Then
      '如果使用的是NT系统
      Dim lpRASCONNSTATUS As RASCONNSTATUS
      lpRASCONNSTATUS.dwSize = 64
      '调用RAS API来获得各种状态
      lngRetCode = RasGetConnectStatus(hRasConn, lpRASCONNSTATUS)
      If lngRetCode Then
         '如果返回值不等于0，表示有错误
         lngRASErrorNumber = lngRetCode
         '改变字体颜色
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         '挂断连接
         lngRetCode = RasHangUp(hRasConn)
         '允许用户退出窗体
         cmdClose.Enabled = True
         '中止时钟控件
         tmrGetConnStatus.Enabled = False
         lngRASError = 10000
      Else
         '如果成功
         '通过结构体获得状态
         lngRASConnState = lpRASCONNSTATUS.rasconnstate
         lngRASError = lpRASCONNSTATUS.dwError
      End If
   Else
      '使用的是95/98系统
      Dim lpRASCONNSTATUS95 As RASCONNSTATUS95
      lpRASCONNSTATUS95.dwSize = 160
      lngRetCode = RasGetConnectStatus(hRasConn, lpRASCONNSTATUS95)
      If lngRetCode Then
         '返回值不为0，获得错误码
         lngRASErrorNumber = lngRetCode
         '设置文本颜色
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         lngRetCode = RasHangUp(hRasConn)
         '是关闭按钮有效
         cmdClose.Enabled = True
         '使时钟控件无效
         tmrGetConnStatus.Enabled = False
         lngRASError = 10000
      Else
         '如果成功，则获得状态
         lngRASConnState = lpRASCONNSTATUS95.rasconnstate
         lngRASError = lpRASCONNSTATUS95.dwError
      End If
   End If
   
   '如果有错误，则显示错误，否则显示正确的连接状态
   Select Case lngRASError
      Case SUCCESS, PENDING
         'Update connection
         Select Case lngRASConnState
            Case RASCS_OpenPort
               txtCallStatus = "Attempting To Open Port..."
            Case RASCS_PortOpened
               txtCallStatus = "Port Successfully Opened"
            Case RASCS_ConnectDevice
               txtCallStatus = "Attempting to Connect Device..."
            Case RASCS_DeviceConnected
               txtCallStatus = "Device Opened"
            Case RASCS_AllDevicesConnected
               txtCallStatus = "All Devices Connected"
            Case RASCS_Authenticate
               txtCallStatus = "Authenticating..."
            Case RASCS_AuthNotify
               txtCallStatus = "Athentication Notification"
            Case RASCS_AuthRetry
               txtCallStatus = "Retrying Authentication..."
            Case RASCS_AuthCallback
               txtCallStatus = "Authentication Callback"
            Case RASCS_AuthChangePassword
               txtCallStatus = "Change Password"
            Case RASCS_AuthProject
               txtCallStatus = "Authenticating Project.."
            Case RASCS_AuthLinkSpeed
               txtCallStatus = "Authenticating Link Speed.."
            Case RASCS_AuthAck
               txtCallStatus = "Athentication Acknowlegement"
            Case RASCS_ReAuthenticate
               txtCallStatus = "ReAuthentication..."
            Case RASCS_Authenticated
               txtCallStatus = "Authenticated"
            Case RASCS_PrepareForCallback
               txtCallStatus = "Prepare For Callback"
            Case RASCS_WaitForModemReset
               txtCallStatus = "Waiting For Modem Rest..."
            Case RASCS_WaitForCallback
               txtCallStatus = "Waiting For Callback..."
            Case RASCS_Projected
               txtCallStatus = "Network Completely Configured"
            Case RASCS_StartAuthentication    'Windows 95 only
               txtCallStatus = "Attempting to Open Port"
            Case RASCS_CallbackComplete         'Windows 95 only
               txtCallStatus = "Callback Completed"
            Case RASCS_LogonNetwork            'Windows 95 only
               txtCallStatus = "Logging On To Network"
            Case RASCS_Interactive
               txtCallStatus = "Interactive"
            Case RASCS_RetryAuthentication
               txtCallStatus = "Retry Authentication"
            Case RASCS_CallbackSetByCaller
               txtCallStatus = "CallBack Set By Caller"
            Case RASCS_PasswordExpired
               txtCallStatus = "Password Expired"
            Case RASCS_Connected
               txtCallStatus = "Connected"
               cmdClose.Enabled = True
            Case RASCS_Disconnected
               txtCallStatus = "Disconnected"
            Case Else
               txtCallStatus = "Unknown State"
         End Select
      Case 10000
         '如果为1000表示获取状态的函数失败
      Case Else
         '获得错误代码
         lngRASErrorNumber = lngRASError
         '设置文本框属性
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         '挂断连接
         lngRetCode = RasHangUp(hRasConn)
         '使得关闭按钮有效
         cmdClose.Enabled = True
         '中止时钟
         tmrGetConnStatus.Enabled = False
   End Select
   
End Sub