frm_sendget.frm

mmodbus

      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Line Line3 
      X1              =   120
      X2              =   11760
      Y1              =   5520
      Y2              =   5520
   End
   Begin VB.Line Line2 
      X1              =   720
      X2              =   11760
      Y1              =   720
      Y2              =   720
   End
   Begin VB.Label Label3 
      Caption         =   "发送目标："
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   1080
      Width           =   975
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   11880
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Label Label2 
      Caption         =   "发送内容："
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1920
      Width           =   975
   End
End
Attribute VB_Name = "Frm_SendGet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim objItem As ListItem
Dim i As Integer
Dim Mcount As Integer
Public Function LRC(str As String) As String 'LRC校验算法
Dim c As Integer
Dim i As Integer
Dim c_data As String
Dim d_lrc As Variant
    c = 0
    l = Len(str)
    For c = c + 1 To l
        c_data = Mid$(str, c, 2)
        d_lrc = d_lrc + Val("&H" + c_data)
        c = c + 1
    Next c
    If d_lrc > &HFF Then
        d_lrc = d_lrc Mod &H100
    End If
    h_lrc = Hex(&HFF - d_lrc + 1)
    If Len(h_lrc) > 2 Then
        h_lrc = Mid(h_lrc, Len(h_lrc) - 1, 2)
    End If
       LRC = h_lrc
End Function
Private Sub Cmd_Clear_Click()
  Text_send.Text = ""
End Sub

Private Sub Cmd_ClearRecive_Click()
    ListView_Recive.ListItems.Clear
End Sub

Private Sub Cmd_ClearSend_Click()
    ListView_Send.ListItems.Clear
End Sub

Private Sub Cmd_ColsePort_Click()
On Error GoTo ComErr
    If MSComm1.PortOpen = True Then '
        MSComm1.PortOpen = False
    End If
    StatusBar1.Panels(2).Text = "       端口已关闭！"
    Exit Sub
ComErr:
    MsgBox "端口关闭失败，请检查端口！", vbExclamation + vbOKOnly, "提示！"
End Sub

Private Sub Cmd_OpenPort_Click()
    '初始化端口
'On Error GoTo ComErr
    If MSComm1.PortOpen = True Then '设置短口前先关闭端口
        MSComm1.PortOpen = False
    End If

    MSComm1.CommPort = PortItem   '设置并返回通讯端口号。
    MSComm1.Settings = "9600,n,8,1" '  '设置波特率、校验位(1)、数据位、停止位
    MSComm1.InputLen = 0      ' 属性确定被 Input 属性读取的字符数。设置 InputLen 为 0，则 Input 属性读取缓冲区中全部的内容。
    MSComm1.InputMode = comInputModeTex  'comInputModeTex文本comInputModeBinary此模式下得到的是各种字节数值，
    MSComm1.Handshaking = comNone      '无握手
    MSComm1.RThreshold = 1 '接受缓冲区内有多少字符都不会引发ONcOMM事件'MSComm1.RThreshold = 0   '传输缓冲区完全空时生成OnComm事件MSComm1.DTREnable = True '用于在通信时是否起用DTR线路用于计算机告诉调制解调器可以发送数据MSComm1.RTSEnable = True '是否使RTS线有效，有计算机发送信号到解调器要求将数据送出
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = True
    MSComm1.SThreshold = 0  '传输缓冲区不引发发送事件
    MSComm1.PortOpen = True   '打开端口
    If MSComm1.OutBufferCount <> 0 Then
       MSComm1.OutBufferCount = 0  '清除发送缓冲区
    End If
    If MSComm1.InBufferCount <> 0 Then
       MSComm1.InBufferCount = 0  '清除接收缓冲区
    End If
    '
    Timer1.Enabled = False
   ' Timer1.Interval = 10000
   '
    StatusBar1.Panels(1).Text = " 端口设置:" & MSComm1.Settings
    StatusBar1.Panels(2).Text = "       端口已打开！"
'    Exit Sub
'ComErr:
'    MsgBox "端口打开失败，请检查端口是否已经被别的程序打开！", vbExclamation + vbOKOnly, "提示！"
End Sub

Private Sub Cmd_Port_Click()
    Frm_Config.Show
End Sub

Private Sub Cmd_Send_Click()
On Error GoTo CMGSError
    Dim BufSend As String '发送串
    Dim Sendstr As String
    Sendstr = Trim(Text_send.Text)
    BufSend = ":" & "01" & "00" & Sendstr & LRC(Sendstr) + Chr$(13) + Chr$(10) '发送串内容（1.起始位":"，2.通信地址2个字符 3.功能码2个字符 4.数据项 5.LRC校验 2字符 6.结束字符 回车。）
'    MsgBox Len(BufSend)
    MSComm1.Output = BufSend
'向已发送列表添加内容

    Dim StrTo   As String
    StrTo = "默认"
    Dim i As Integer
    i = 5
     Do While 10
        Set objItem = ListView_Send.ListItems.Add(, , StrTo)
        With objItem
            .SubItems(1) = Trim(Text_send.Text)
            .SubItems(2) = GetMyFormatDataAndTime
        End With
       DoMySleep (10)
       i = i - 1
    Loop
    Exit Sub
    MsgBox "fawan"
CMGSError:
     MsgBox "发送失败！", vbExclamation + vbOKOnly, "提示！"
End Sub

Private Sub Command1_Click()
    PlaySound App.Path & "\back.wav"
    MsgBox "222"
    MsgBox "222"
    
End Sub


Private Sub Command3_Click()
    Check1.Value = True
End Sub

Private Sub Command4_Click()
 PlaySound App.Path & "\Msg.wav"
 MsgBox "22211111"
 MsgBox "222111"
End Sub


Private Sub Form_Load()
  '************初始化ListView_Send
    ListView_Send.ColumnHeaders.Clear
     '加入列首
'    With ListView_Send.ColumnHeaders
'        .Add , , "目标", ListView_Send.Width * 0.5 / 8
'        .Add , , "内容", ListView_Send.Width * 6.2 / 8
'        .Add , , "时间", ListView_Send.Width * 1.2 / 8
'    End With
    ListView_Recive.ColumnHeaders.Clear
     '加入列首
    With ListView_Recive.ColumnHeaders
        .Add , , "来源", ListView_Recive.Width * 0.5 / 8
        .Add , , "内容", ListView_Recive.Width * 6.2 / 8
        .Add , , "时间", ListView_Recive.Width * 1.2 / 8
    End With
End Sub

Private Sub Timer1_Timer()
    Dim IntCount As Integer '缓冲区等待被取走的字符数
    IntCount = 0
    IntCount = MSComm_Recive.InBufferCount ' 在接收缓冲区等待被取走的字符数
    If IntCount > 0 Then
        OutStr = ""
        Text_Recive.Text = MSComm_Recive.Input
    End If
End Sub
Private Sub Command2_Click()
 Form_test.Show
End Sub
Private Sub MSComm1_OnComm()
On Error GoTo CMGSError
    Dim ComOutStr As String '得到字符串
    Dim StrData As String
    Select Case MSComm1.CommEvent
        Case comEvReceive
            '读取串口数据
            ComOutStr = ComOutStr + MSComm1.Input
    End Select
    If InStr(ComOutStr, ":") = 1 And Len(ComOutStr) >= 10 Then '开始标记是:
      StrData = Mid(ComOutStr, 6, Len(ComOutStr) - 9)
      If LRC(StrData) = Mid(ComOutStr, Len(ComOutStr) - 3, 2) Then '    接收时LRC校验，看发送总是否错误
        '向接收列表添加内容
        Dim StrTo   As String
        StrTo = "默认"
        Set objItem = ListView_Recive.ListItems.Add(, , StrTo)
        With objItem
            .SubItems(1) = StrData
            .SubItems(2) = GetMyFormatDataAndTime
        End With
      End If
    End If
    
    '
'    Text1.Text = ComOutStr
'    Mcount = Mcount + 1
'    Label4.Caption = Mcount
    Exit Sub
CMGSError:
     MsgBox "接收失败！", vbExclamation + vbOKOnly, "提示！"
End Sub