frmrs232.frm

用VB编写的RS232测试软件

    recData.temp = T1
    recData.pre = P1.Caption
    recData.flow = flow1
    recData.heat = heat
    recData.aflow = aflow1
    recData.aheat = fheat
    Put #1, i, recData
End Sub

Sub Fun_communication()             'RS-232串口通讯
    Dim Dummy As Integer
    Dim i As Integer
    'MSComm1.CommPort = 2     ' Use COM2.
    '9600 baud, no parity, 8 data, and 1 stop bit.
    MSComm1.Settings = "9600,n,8,1"
    ' Tell the control to read entire buffer when Input is used.
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True       ' Open the port.
    MSComm1.InBufferCount = 0
    'MSComm1.Output = Chr$(&HFF)       '
    Delay10
    'MSComm1.Output = Chr$(&H00)
    Delay10
    'MSComm1.Output = Chr$(&H33)          '子站地址
    Delay10
    MSComm1.Output = Chr$(&H21)
    Delay10
    'MSComm1.Output = Chr$(&HA)
    Delay10
    'MSComm1.Output = Chr$(&HF5)
    'Delay10
' Wait for data to come back to the serial port.
    i = 0
    Do
        Dummy = DoEvents()
        i = i + 1
    Loop Until MSComm1.InBufferCount >= 71 Or i > 32000
    ' Read the "OK" response data in the serial port.
    If i > 32000 Then
        Label1.Caption = "time over"
    Else
        Label1.Caption = Chr$(&H21)
    End If
    
    inst = MSComm1.Input
    MSComm1.PortOpen = False      ' Close the serial port.
    'If Mid(inst, 1, 1) <> Chr$(&HE7) Then GoTo j1:
    'If Mid(inst, 2, 1) <> Chr$(&HE7) Then GoTo j1:
    'If Mid(inst, 3, 1) <> Chr$(&H1) Then GoTo j1:
    'If Mid(inst, 4, 1) <> Chr$(&HFE) Then GoTo j1:
    'If Mid(inst, 5, 1) <> Chr$(&HA) Then GoTo j1:
    'If Mid(inst, 6, 1) <> Chr$(&HF5) Then GoTo j1:
    ins(48) = inst 'Right(inst, Len(inst) - 6)
    X = Now
    xdate = Date
    'RecDT.Caption = Str(Year(X)) + "年" + Str(Month(X)) + "月" + Str(Day(X)) + "日" + Str(Hour(X)) + ":" + Str(Minute(X))
    'Panel3D3.Caption = Mid(ins(48), 1, 3) + "年" + Mid(ins(48), 4, 2) + "月" + Mid(ins(48), 6, 2) + "日" + Mid(ins(48), 8, 2) + ":"
    'Panel3D3.Caption = Mid(ins(48), 1, 2)
'------------------------------------------------------
    T1 = Mid(ins(48), 2, 5)      'DW232_2 接收数据串有()
    P1 = Mid(ins(48), 7, 5)
    flow1 = Mid(ins(48), 12, 5)
    heat = Mid(ins(48), 17, 5)
    aflow1 = Mid(ins(48), 22, 5)
    fheat = Mid(ins(48), 27, 5)
    'Label1.Caption = Mid(ins(48), 32, 5)
    Label2.Caption = Mid(ins(48), 37, 5)
    Label3.Caption = Mid(ins(48), 42, 5)
    Label4.Caption = Mid(ins(48), 47, 8)
    Label5.Caption = Mid(ins(48), 55, 8)
    
    'T1 = Mid(ins(48), 2, 5)      'DW232_1 接收数据串有()
    'P1 = Mid(ins(48), 7, 5)
    'flow1 = Mid(ins(48), 12, 5)
    'heat = Mid(ins(48), 17, 5)
    'aflow1 = Mid(ins(48), 22, 8)
    'fheat = Mid(ins(48), 30, 8)
    
    'T1 = Mid(ins(48), 10, 5)      '接收数据串有()
    'P1 = Mid(ins(48), 15, 5)
    'flow1 = Mid(ins(48), 20, 5)
    'heat = Mid(ins(48), 25, 5)
    'aflow1 = Mid(ins(48), 30, 8)
    'fheat = Mid(ins(48), 38, 5)
    'Fun_record
j1: 'MSComm1.PortOpen = False      ' Close the serial port.
End Sub

Sub Fun_record()            '向文件中添加记录函数
    Openfile
    Fun_Append              '添加一个记录
    Close #1
End Sub

Sub Openfile()
    Dim bytes As Integer
    Open "gs232.dat" For Random As #1 Len = 45
    bytes = LOF(1)
    LastNum = bytes / 45
End Sub

Private Sub Command1_Click()
    MSComm1.CommPort = 1     ' Use COM1.
End Sub

Private Sub Command2_Click()
    MSComm1.CommPort = 2     ' Use COM2.
End Sub

Private Sub Command3_Click()
    MSComm1.CommPort = 3     ' Use COM3.
End Sub

Private Sub Command4_Click()
    Call Fun_communication
End Sub



Private Sub Form_Load()         '程序初始化
   ' Load Form_R
  '  T1 = 0
  '  P1 = 0
  '  flow1 = 0
  '  heat = 0
  '  aflow1 = 0
  '  fheat = 0
  '  curnum = 1
  '  Call Fun_init               '初始化
  '  mnuSetClock.Enabled = False '使设定时钟菜单无效
End Sub

Private Sub mnuGo_Click()
    Timer1.Enabled = True
End Sub

Private Sub mnuQuit_Click()
    Unload Me
    'Form2.Hide
    Form1.Show
End Sub

Private Sub mnuSetClock_Click()       '菜单项“设定时钟”事件函数
    Dim Default, Msg, Newdate, NewTime  ' Declare variables.
    Msg = "请输入新日期："
    Default = Date  ' Current date.
    Newdate = InputBox(Msg, "", Default)    ' Get user input.
    If Len(Newdate) > 0 Then    ' Check if valid.
        Date = Newdate  ' Set date.
        Msg = "当前系统日期设置为 "
        Msg = Msg & Format(DateValue(Newdate), "dddd, mmmm d, yyyy")
    Else
        Msg = "You did not enter a valid date."
    End If
    MsgBox Msg  ' Display message.
    Msg = "请输入新时间："
    NewTime = InputBox(Msg, "", Time)   ' Get user input.
    If Len(NewTime) > 0 Then    ' Check if valid.
        Time = NewTime  ' Set time.
        Msg = "当前系统时间设置为 "
        Msg = Msg & Time & "."  ' Put time in message.
    Else
        Msg = "You did not enter a valid time."
    End If
    MsgBox Msg                  ' Display message.
    'mnuSetClock.Enabled = False    '使设定时钟菜单无效
End Sub

Private Sub mnuUser_Click()     '菜单项“用户登记”事件函数
    Form2.Show          '显示口令表格
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       Call Communication_test
    End If
End Sub

Private Sub Timer1_Timer()
    Dim cminute As String
    date1.Caption = Now                 '显示当前日期时间
    NowTime = Time$                     '取当前时间
    sec = Mid$(NowTime, 7, 2)           '取当前秒
    cminute = Minute(NowTime)           '取当前分
    
        Fun_communication               '通讯
    
End Sub

Public Sub Communication_test()            'RS-232串口通讯
    Dim Dummy As Integer
    Dim i As Integer
    MSComm1.CommPort = 1    ' Use COM1.
    ' 2400 baud, no parity, 8 data, and 1 stop bit.
    MSComm1.Settings = "9600,n,8,1"
    ' Tell the control to read entire buffer when Input is used.
    MSComm1.InputLen = 0
    MSComm1.PortOpen = True       ' Open the port.
    MSComm1.InBufferCount = 0
    MSComm1.Output = Chr$(&H23)       '
    Delay10
    MSComm1.Output = Chr$(&H30)
    Delay10
    MSComm1.Output = Chr$(&H31)          '子站地址
    Delay10
    MSComm1.Output = Chr$(&H30)
    Delay10
    'MSComm1.Output = Chr$(&HA)
    Delay10
    'MSComm1.Output = Chr$(&HF5)
    Delay10
' Wait for data to come back to the serial port.
    'MSComm1.CommPort = 1     ' Use COM1.
    'MSComm1.PortOpen = True       ' Open the port.
    i = 0
    Do
        Dummy = DoEvents()
        i = i + 1
    Loop Until MSComm1.InBufferCount >= 39 Or i > 32000
    ' Read the "OK" response data in the serial port.
    inst = MSComm1.Input
    MSComm1.PortOpen = False      ' Close the serial port.
    'If Mid(inst, 1, 1) <> Chr$(&HE7) Then GoTo j1:
    'If Mid(inst, 2, 1) <> Chr$(&HE7) Then GoTo j1:
    'If Mid(inst, 3, 1) <> Chr$(&H1) Then GoTo j1:
    'If Mid(inst, 4, 1) <> Chr$(&HFE) Then GoTo j1:
    'If Mid(inst, 5, 1) <> Chr$(&HA) Then GoTo j1:
    'If Mid(inst, 6, 1) <> Chr$(&HF5) Then GoTo j1:
    ins(48) = inst 'Right(inst, Len(inst) - 6)
    X = Now
    xdate = Date
    'RecDT.Caption = Str(Year(X)) + "年" + Str(Month(X)) + "月" + Str(Day(X)) + "日" + Str(Hour(X)) + ":" + Str(Minute(X))
    'Panel3D3.Caption = Mid(ins(48), 1, 3) + "年" + Mid(ins(48), 4, 2) + "月" + Mid(ins(48), 6, 2) + "日" + Mid(ins(48), 8, 2) + ":"
    'Panel3D3.Caption = Mid(ins(48), 1, 2)
'------------------------------------------------------
    T1 = Mid(ins(48), 2, 5)      'DW232_2 接收数据串有()
    P1 = Mid(ins(48), 7, 5)
    flow1 = Mid(ins(48), 12, 5)
    heat = Mid(ins(48), 17, 5)
    aflow1 = Mid(ins(48), 22, 5)
    fheat = Mid(ins(48), 27, 5)
    Label1.Caption = Mid(ins(48), 32, 5)
    Label2.Caption = Mid(ins(48), 37, 5)
    Label3.Caption = Mid(ins(48), 42, 5)
    Label4.Caption = Mid(ins(48), 47, 8)
    Label5.Caption = Mid(ins(48), 55, 8)
    
    'T1 = Mid(ins(48), 2, 5)      'DW232_1 接收数据串有()
    'P1 = Mid(ins(48), 7, 5)
    'flow1 = Mid(ins(48), 12, 5)
    'heat = Mid(ins(48), 17, 5)
    'aflow1 = Mid(ins(48), 22, 8)
    'fheat = Mid(ins(48), 30, 8)
    
    'T1 = Mid(ins(48), 10, 5)      '接收数据串有()
    'P1 = Mid(ins(48), 15, 5)
    'flow1 = Mid(ins(48), 20, 5)
    'heat = Mid(ins(48), 25, 5)
    'aflow1 = Mid(ins(48), 30, 8)
    'fheat = Mid(ins(48), 38, 5)
    'Fun_record
j1: 'MSComm1.PortOpen = False      ' Close the serial port.
End Sub