selftest.frm

在VB中实现通讯的例子

VERSION 2.00
Begin Form Selftest 
   AutoRedraw      =   -1  'True
   Caption         =   "Self Test"
   ClientHeight    =   4020
   ClientLeft      =   1770
   ClientTop       =   1935
   ClientWidth     =   7365
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "Courier New"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4710
   Left            =   1710
   LinkTopic       =   "Form1"
   ScaleHeight     =   4020
   ScaleWidth      =   7365
   Top             =   1305
   Width           =   7485
   Begin Menu menuInstruct 
      Caption         =   "Instructions"
   End
   Begin Menu menuSettings 
      Caption         =   "Settings"
      Begin Menu menu1stPort 
         Caption         =   "1st Port"
         Begin Menu menu1stCOM1 
            Caption         =   "COM1"
         End
         Begin Menu menu1stCOM2 
            Caption         =   "COM2"
         End
         Begin Menu menu1stCOM3 
            Caption         =   "COM3"
         End
         Begin Menu menu1stCOM4 
            Caption         =   "COM4"
         End
      End
      Begin Menu menu2ndPort 
         Caption         =   "2nd Port"
         Begin Menu menu2ndCOM1 
            Caption         =   "COM1"
         End
         Begin Menu menu2ndCOM2 
            Caption         =   "COM2"
         End
         Begin Menu menu2ndCOM3 
            Caption         =   "COM3"
         End
         Begin Menu menu2ndCOM4 
            Caption         =   "COM4"
         End
      End
   End
   Begin Menu menuTest 
      Caption         =   "Test"
   End
   Begin Menu menuExit 
      Caption         =   "Exit"
   End
End
' SELFTEST.BAS

Option Explicit

Sub Form_Load ()
Dim X As String
   The1stPort = COM1
   The2ndPort = COM2
   menu1stCOM1.Checked = True
   menu2ndCOM2.Checked = True
   TestString = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
   Call ShowCaption
End Sub

Sub Instruct_Click ()
End Sub

Sub menu1stCOM1_Click ()
    The1stPort = COM1
    Call Uncheck1stComPorts
    menu1stCOM1.Checked = True
    Call ShowCaption
End Sub

Sub menu1stCOM2_Click ()
    The1stPort = COM2
    Call Uncheck1stComPorts
    menu1stCOM2.Checked = True
    Call ShowCaption
End Sub

Sub menu1stCOM3_Click ()
    The1stPort = COM3
    Call Uncheck1stComPorts
    menu1stCOM3.Checked = True
    Call ShowCaption
End Sub

Sub menu1stCOM4_Click ()
    The1stPort = COM4
    Call Uncheck1stComPorts
    menu1stCOM4.Checked = True
    Call ShowCaption
End Sub

Sub menu2ndCOM1_Click ()
    The2ndPort = COM1
    Call Uncheck2ndComPorts
    menu2ndCOM1.Checked = True
    Call ShowCaption
End Sub

Sub menu2ndCOM2_Click ()
    The2ndPort = COM2
    Call Uncheck2ndComPorts
    menu2ndCOM2.Checked = True
    Call ShowCaption
End Sub

Sub menu2ndCOM3_Click ()
    The2ndPort = COM3
    Call Uncheck2ndComPorts
    menu2ndCOM3.Checked = True
    Call ShowCaption
End Sub

Sub menu2ndCOM4_Click ()
    The2ndPort = COM4
    Call Uncheck2ndComPorts
    menu2ndCOM4.Checked = True
    Call ShowCaption
End Sub

Sub menuDebug_Click ()
Dim Code As Integer
Call ShutDown
End Sub

Sub menuExit_Click ()
  End
End Sub

Sub menuInstruct_Click ()
SELFTEST.Cls
SELFTEST.Print "SELFTEST can operate in one of two ways:"
SELFTEST.Print
SELFTEST.Print "1] A single port with a loopback adapter on the end."
SELFTEST.Print "   The adapter should have TD & RD tied together."
SELFTEST.Print
SELFTEST.Print "2] Two serial ports on the same computer."
SELFTEST.Print "   Connect the two ports together using a Null Modem Cable."
SELFTEST.Print
End Sub

Sub menuTest_Click ()
   Dim I, N As Integer
   Dim Code As Integer
   Dim Count As Integer
   Dim TimeMark As Long
   Dim TestLength As Integer
   'begin test run
   SELFTEST.Cls
   RunNumber = RunNumber + 1
   SELFTEST.Print "TESTING: COM"; 1 + The1stPort; " ==> COM"; 1 + The2ndPort
   SELFTEST.Print "Run #"; RunNumber
   'check ports
   If (The1stPort = COM1) And (The2ndPort = COM3) Then
     SELFTEST.Print "COM1 and COM3 share the same IRQ"
     Exit Sub
   End If
   If (The1stPort = COM2) And (The2ndPort = COM4) Then
     SELFTEST.Print "COM2 and COM4 share the same IRQ"
     Exit Sub
   End If
   'turn on 1st port
   Code = GoOnline(The1stPort)
   If Code = 0 Then
     Call ShutDown
     Exit Sub
   End If
   'turn on 2nd port
   If The1stPort <> The2ndPort Then
     Code = GoOnline(The2ndPort)
     If Code = 0 Then
       Call ShutDown
       Exit Sub
     End If
   End If
   'test !
   SELFTEST.Print
   SELFTEST.Print "Test string = "; TestString
   Call ShowConfig
   SELFTEST.Print "[Test string will be sent 16 times]"
   TestLength = Len(TestString)
   SELFTEST.Print "  Sending: ";
   For N = 1 To 16
     SELFTEST.Print Right$(Str$(N), 3);
     For I = 1 To TestLength
       Code = SioPutc(The1stPort, Asc(Mid$(TestString, I, 1)))
       If Code < 0 Then
         Call SayError(SELFTEST, Code)
         Call ShutDown
         Exit Sub
       End If
     Next I
   Next N
   SELFTEST.Print
   SELFTEST.Print "Receiving: ";
   TimeMark = Timer + 4
   For N = 1 To 16
     SELFTEST.Print Right$(Str$(N), 3);
     For I = 1 To TestLength
       Do
         'try for incoming char
         Code = SioGetc(The2ndPort)
         If Code >= 0 Then
           Exit Do
         End If
         'no incoming
         If (Timer >= TimeMark) Or (Code <> WSC_NO_DATA) Then
           SELFTEST.Print
           If Code = WSC_NO_DATA Then
             SELFTEST.Print "[Timeout waiting for incoming data]"
           Else
             Call SayError(SELFTEST, Code)
           End If
           'shut down now
           Call ShutDown
           Exit Sub
         End If
       Loop
       'test incoming char
       If Chr$(Code) <> Mid$(TestString, I, 1) Then
         SELFTEST.Print
         SELFTEST.Print "ERROR: Received "; Chr$(Code);
         SELFTEST.Print ", but expected "; Mid$(TestString, I, 1);
         SELFTEST.Print " for character #"; I
         Call ShutDown
         Exit Sub
       End If
     Next I
   Next N
   SELFTEST.Print
   'clear buffers
   Code = SioRxClear(The1stPort)
   Code = SioTxClear(The1stPort)

   If The1stPort <> The2ndPort Then
     Code = SioRxClear(The2ndPort)
     Code = SioTxClear(The2ndPort)
   End If
   'done
   Call ShutDown
   SELFTEST.Print "*** Test complete"
End Sub

Sub Uncheck1stComPorts ()
'uncheck all COM ports
menu1stCOM1.Checked = False
menu1stCOM2.Checked = False
menu1stCOM3.Checked = False
menu1stCOM4.Checked = False
End Sub

Sub Uncheck2ndComPorts ()
'uncheck all COM ports
menu2ndCOM1.Checked = False
menu2ndCOM2.Checked = False
menu2ndCOM3.Checked = False
menu2ndCOM4.Checked = False
End Sub