VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1800
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2670
   LinkTopic       =   "Form1"
   ScaleHeight     =   1800
   ScaleWidth      =   2670
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   2100
      Top             =   780
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   120
      Top             =   900
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   0   'False
      InBufferSize    =   512
      BaudRate        =   1200
      InputMode       =   1
   End
   Begin VB.CommandButton Command1 
      Caption         =   "召測電壓"
      Height          =   375
      Left            =   660
      TabIndex        =   0
      Top             =   1110
      Width           =   1245
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      BeginProperty Font 
         Name            =   "宋體"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   270
      TabIndex        =   1
      Top             =   240
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'以召測電壓為例。地址1，串口設置1200，e,8,1
Dim t_flag As Integer
Dim t_type As String
'為了支持組態軟件，推出新modbus規約2。0（相對于1。0命令地址、寄存器個數、回送個數，有所不同，請注意）
'以召測電壓為例，請注意注釋標記1.0和2.0的區別。
Private Sub Command1_Click()
Dim crc As Long
Dim dbl As A_single
Dim byteAry As a_ByteAry
On Error GoTo errs
With MSComm1
ReDim fx(7)
.CommPort = 1
.SThreshold = 8
.RThreshold = 9  '2.0版（浮點數、長整形回送9個，整形回送7個，字節形回送6個）
                 '1.0版（浮點數回送9個)
.PortOpen = True
.Settings = "9600,n,8,1"    '2.0版（無校驗n）
                            '1.0版（偶校驗e)
fx(0) = 1
fx(1) = &H3
fx(2) = &H10      '2.0版(fx(2)=&h10,fx(3)=&h0)
fx(3) = &H0       '1.0版(fx(2)=&h0,fx(3)=&h0)
fx(4) = &H0       '2.0版(fx(5)=2)
fx(5) = &H2       '1.0版(fx(5)=1)
    tmp = .Input  '清空端口
    shuju = 0     '清空數據
    'CRC校驗
    crc = &HFFFF&
    For TmpI = 0 To 5
        crc = CrcResult(CLng(fx(TmpI)), &HA001&, crc)
    Next
    fx(6) = CByte(crc And &HFF&)
    fx(7) = CByte(Fix(crc / 256) And &HFF&)
    t_flag = 0 '通訊狀態標志置零
    t_type = "召測電壓"
    .Output = fx '發送數據
    Timer1.Enabled = True
    Do
        If t_flag <> 0 Then
             Label1.Caption = "v"
            If t_flag = 1 Then
                 shu = fresult
                 Label1.Caption = fresult + Label1.Caption
            ElseIf t_flag = 3 Then
                 errt = errt + t_type + "通訊超時!" + Chr(10) + Chr(13)
            End If
        Exit Do
        End If
        DoEvents
    Loop
.PortOpen = False
End With
If errt <> "" Then
MsgBox errt, , "通訊錯誤"
Else
MsgBox "召測數據成功!"
End If
Exit Sub
errs:
MsgBox Err.Description
Timer1.Enabled = False
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub

Private Sub MSComm2_OnComm()

End Sub


Private Sub MSComm1_OnComm()
Dim read_count As Integer
Dim crc As Long
Select Case MSComm1.CommEvent
       Case comEvReceive
            read_count = MSComm1.InBufferCount
            shuju = MSComm1.Input
        'CRC校驗
        crc = &HFFFF&
        Timer1.Enabled = False
        For TmpI = 0 To read_count - 3
            crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
        Next
        If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
          t_flag = 1 '成功標志
        Else
          t_flag = 2
          errt = errt & t_type & "CRC校驗錯!" + Chr(10) + Chr(13)
        End If
        Case comEvSend
        Case comEventRxParity
        Timer1.Enabled = False
        t_flag = 2
        errt = errt & t_type & "奇偶校驗錯!" + Chr(10) + Chr(13)
End Select
End Sub

Private Sub Timer1_Timer()
Dim read_count As Integer
Dim crc As Long
read_count = MSComm1.InBufferCount
If read_count = 5 Then
    t_flag = 2
    shuju = MSComm1.Input
     'CRC校驗
    crc = &HFFFF&
    Timer1.Enabled = False
    For TmpI = 0 To read_count - 3
    crc = CrcResult(CLng(shuju(TmpI)), &HA001&, crc)
    Next
    If shuju(TmpI) = CByte(crc And &HFF&) And shuju(TmpI + 1) = CByte(Fix(crc / 256) And &HFF&) Then
        If shuju(2) = 1 Then
            errt = errt & t_type & "錯誤響應-非法命令!" + Chr(10) + Chr(13)
        Else
            errt = errt & t_type & "錯誤響應-非法數據位置!" + Chr(10) + Chr(13)
        End If
    Else
        errt = errt & t_type & "錯誤響應!" + Chr(10) + Chr(13)
    End If
Else
'置超時標志
    t_flag = 3
    Timer1.Enabled = False
End If
End Sub