frmadial.frm

地方税务局税控开票系统

VERSION 5.00
Begin VB.Form frmAsyncDial 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "网络连接"
   ClientHeight    =   1665
   ClientLeft      =   1785
   ClientTop       =   3795
   ClientWidth     =   5325
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   8.25
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmADial.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1665
   ScaleWidth      =   5325
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdClose 
      Caption         =   "退出(&E)"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   1080
      Width           =   1245
   End
   Begin VB.Timer tmrGetConnStatus 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   720
      Top             =   990
   End
   Begin VB.TextBox txtCallStatus 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   5055
   End
   Begin VB.CommandButton cmdHangUp 
      Caption         =   "挂断(&H)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2580
      TabIndex        =   0
      Top             =   1080
      Width           =   1185
   End
   Begin VB.Label lblCallStatus 
      Caption         =   "连接状态"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   885
   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
   
   'Hang up the connection
   lngRetCode = RasHangUp(hRasConn)
   glDialConn = 0
   'Unload form
   Unload frmAsyncDial

End Sub

Private Sub Form_Activate()

   'display the hourglass/pointer icon
   Screen.MousePointer = vbArrowHourglass
   'Disable Close button
   cmdClose.Enabled = False
   'set black and regular (we may have had error to set it red and bold)
   txtCallStatus.FontBold = False
   txtCallStatus.ForeColor = 0 'black
   'Here is the other half of the kludge. I get the hRasConn from the Tag that
   'I set before I loaded the form.
   hRasConn = "&H" & frmAsyncDial.Tag
   'set the async timer going
   tmrGetConnStatus.Enabled = True

End Sub

Private Sub Form_Load()

   'set the dialog to the center of the screen
   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)
   
   'stop the async timer
   tmrGetConnStatus.Enabled = False
   'set mousepointer back
   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
      'using NT
      Dim lpRASCONNSTATUS As RASCONNSTATUS
      lpRASCONNSTATUS.dwSize = 64
      lngRetCode = RasGetConnectStatus(hRasConn, lpRASCONNSTATUS)
      If lngRetCode Then
         'Get and display error
         lngRASErrorNumber = lngRetCode
         'set text to bold red
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
'         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         lngRetCode = RasHangUp(hRasConn)
         'allow user to close
         cmdClose.Enabled = True
         'disable timer
         tmrGetConnStatus.Enabled = False
         lngRASError = 10000
      Else
         'success
         lngRASConnState = lpRASCONNSTATUS.rasconnstate
         lngRASError = lpRASCONNSTATUS.dwError
      End If
   Else
      'using 95
      Dim lpRASCONNSTATUS95 As RASCONNSTATUS95
      lpRASCONNSTATUS95.dwSize = 160
      lngRetCode = RasGetConnectStatus(hRasConn, lpRASCONNSTATUS95)
      If lngRetCode Then
         'Get and display error
         lngRASErrorNumber = lngRetCode
         'set text to bold red
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
'         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         lngRetCode = RasHangUp(hRasConn)
         'allow user to close
         cmdClose.Enabled = True
         'disable timer
         tmrGetConnStatus.Enabled = False
         lngRASError = 10000
      Else
         'success
         lngRASConnState = lpRASCONNSTATUS95.rasconnstate
         lngRASError = lpRASCONNSTATUS95.dwError
      End If
   End If
   
   'If Error then raise it else update the textbox with the appropriate info
   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
               Unload frmAsyncDial
            Case RASCS_Disconnected
               txtCallStatus = "Disconnected"
            Case Else
               txtCallStatus = "Unknown State"
               
         End Select
      Case 10000
         'do nothing because RasGetConnectStatus failed
         glDialConn = 0
         Unload frmAsyncDial
      Case Else
         'We have an error
         lngRASErrorNumber = lngRASError
         'set text to bold red
         txtCallStatus.FontBold = True
         txtCallStatus.ForeColor = RGB(255, 0, 0)
''         txtCallStatus.Text = lpRASError.fcnRASErrorString()
         'Hang up the connection
         lngRetCode = RasHangUp(hRasConn)
         'allow user to close
         cmdClose.Enabled = True
         'disable timer
         tmrGetConnStatus.Enabled = False
         glDialConn = 0
         Unload frmAsyncDial
   End Select
   
End Sub