form1.frm

用VB通过串口与数字电表进行通信

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "总电能表"
   ClientHeight    =   2925
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   3075
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2925
   ScaleWidth      =   3075
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Combo2 
      Height          =   300
      ItemData        =   "Form1.frx":0000
      Left            =   1080
      List            =   "Form1.frx":0010
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   240
      Width           =   1215
   End
   Begin VB.Timer Timer1 
      Left            =   5520
      Top             =   3480
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Command5"
      Height          =   495
      Left            =   5640
      TabIndex        =   5
      Top             =   2280
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   3975
      Left            =   240
      ScrollBars      =   3  'Both
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   3240
      Visible         =   0   'False
      Width           =   7815
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   495
      Left            =   3120
      TabIndex        =   3
      Top             =   2280
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "close"
      Height          =   495
      Left            =   960
      TabIndex        =   2
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "send"
      Height          =   495
      Left            =   960
      TabIndex        =   1
      Top             =   1560
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   9600
      Top             =   1560
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command1 
      Caption         =   "open"
      Height          =   495
      Left            =   960
      TabIndex        =   0
      Top             =   960
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "COM"
      Height          =   495
      Left            =   600
      TabIndex        =   7
      Top             =   240
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'*******************
Private cnn As New ADODB.Connection
Private rs As New ADODB.Recordset
Private strcon As String
Private msg As String
Dim strOut() As Byte
Dim indata     As Variant
Private STR_GET As String
Private STR_GET_DEV(1) As String
Private Sub Command1_Click()
'    Cst = "this is test string"
    
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    MSComm1.CommPort = 1            '指定Com1口作为通信端口
    MSComm1.CommPort = Combo2.Text             '指定Com1口作为通信端口
    
    MSComm1.Settings = "300,E,7,1"
'    MSComm1.Settings = "1200,E,8,1"
    MSComm1.InputLen = 0            'default
    MSComm1.InputMode = comInputModeBinary
'    MSComm1.RThreshold = 18
    MSComm1.RThreshold = 1
'    MSComm1.InBufferSize = 18
'    MSComm1.OutBufferSize = 14
''MSComm1.InputLen = 14



    MSComm1.PortOpen = True         '打开串行端口
    MSComm1.InBufferCount = 0
    MSComm1.OutBufferCount = 0
    '*****************************
    Timer1.Enabled = True
    Timer1.Interval = 57000
    Call Command2_Click
    Command3.Enabled = True
    Command1.Enabled = False
End Sub

Private Sub Command2_Click()
Dim AAA() As Byte
Dim LLL() As Byte
Dim i As Integer
'flagD = 1
MSComm1.OutBufferCount = 0
STR_GET = ""
''''''''''''     '****************************
'ReDim AAA(14)
'MSComm1.OutBufferCount = 0
'9010H
'7f 7f 2F 3F 30 30 30 30 30 30 30 31 21 0D 0A
'AAA(0) = CByte("&H" & "7F")   '68H
'AAA(1) = CByte("&H" & "7F")    'A0
'AAA(2) = CByte("&H" & "2F")    'Hex(170)   'A1
'AAA(3) = CByte("&H" & "3F")   'A2
'AAA(4) = CByte("&H" & "30")   'A3
'AAA(5) = CByte("&H" & "30")   'A4
'AAA(6) = CByte("&H" & "30")   'A5
'AAA(7) = CByte("&H" & "30")   '68H
'
'AAA(8) = CByte("&H" & "30")      '81
'AAA(9) = CByte("&H" & "30")      '06
'AAA(10) = CByte("&H" & "30")    '43
'
'
'AAA(11) = CByte("&H" & "31")   'C3
'AAA(12) = CByte("&H" & "21")   '55
'AAA(13) = CByte("&H" & "0D")    'BB
'AAA(14) = CByte("&H" & "0A")    'BB



'ReDim AAA(7)
''MSComm1.OutBufferCount = 0
''7f 7f 06 30 35 31 0D 0A
'AAA(0) = CByte("&H" & "7F")   '68H
'AAA(1) = CByte("&H" & "7F")    'A0
'AAA(2) = CByte("&H" & "06")    'Hex(170)   'A1
'AAA(3) = CByte("&H" & "30")   'A2
'AAA(4) = CByte("&H" & "35")   'A3
'AAA(5) = CByte("&H" & "31")   'A4
'AAA(6) = CByte("&H" & "0D")   'A5
'AAA(7) = CByte("&H" & "0A")   '68H

'ReDim AAA(4)
''MSComm1.OutBufferCount = 0
'
'
'AAA(0) = CByte("&H" & "2F")    '/
'AAA(1) = CByte("&H" & "3F")    '?
'AAA(2) = CByte("&H" & "21")    '!
'AAA(3) = CByte("&H" & "0D")   'CR
'AAA(4) = CByte("&H" & "0A")   'LF

'*********************
ReDim AAA(12)
'MSComm1.OutBufferCount = 0


AAA(0) = CByte("&H" & "2F")    '/
AAA(1) = CByte("&H" & "3F")    '?


'AAA(2) = Asc("0")
'AAA(3) = Asc("0")
'AAA(4) = Asc("0")
'AAA(5) = Asc("0")
'AAA(6) = Asc("0")
'AAA(7) = Asc("0")
'AAA(8) = Asc("0")
'AAA(9) = Asc("0")
'AAA(10) = Asc("8")
'AAA(11) = Asc("0")
'AAA(12) = Asc("4")
'AAA(13) = Asc("8")
'AAA(14) = Asc("1")
'AAA(15) = Asc("4")
'AAA(16) = Asc("2")
'AAA(17) = Asc("8")

AAA(2) = Asc("8")
AAA(3) = Asc("0")
AAA(4) = Asc("4")
AAA(5) = Asc("8")
AAA(6) = Asc("1")
AAA(7) = Asc("4")
AAA(8) = Asc("2")
AAA(9) = Asc("8")

AAA(10) = CByte("&H" & "21")    '!
AAA(11) = CByte("&H" & "0D")   'CR
AAA(12) = CByte("&H" & "0A")   'LF


'''*********************************
''ReDim AAA(14)
'''MSComm1.OutBufferCount = 0
''
''AAA(0) = CByte("&H" & "7F")    '/
''AAA(1) = CByte("&H" & "7F")    '?
''AAA(2) = CByte("&H" & "2F")    '/
''AAA(3) = CByte("&H" & "3F")    '?
''
''AAA(4) = Asc("8")
''AAA(5) = Asc("0")
''AAA(6) = Asc("4")
''AAA(7) = Asc("8")
''AAA(8) = Asc("1")
''AAA(9) = Asc("4")
''AAA(10) = Asc("2")
''AAA(11) = Asc("8")
''
''AAA(12) = CByte("&H" & "21")    '!
''AAA(13) = CByte("&H" & "0D")   'CR
''AAA(14) = CByte("&H" & "0A")   'LF

'Debug.Print "*********SEND DATA*************"
'     For i = 0 To UBound(AAA)
'        Debug.Print "strOut(" & i & ")=" & AAA(i)
'     Next i
'Debug.Print "*******************************     "
    MSComm1.Output = AAA ' Cst         '将输入字符串写入发送缓冲区

End Sub

Private Sub Command3_Click()
On Error Resume Next
    Timer1.Enabled = False
    Timer1.Interval = 0
    MSComm1.PortOpen = False        '关闭端口
    Command1.Enabled = True
    Command3.Enabled = False
End Sub

Private Sub Command4_Click()
'Debug.Print Asc("/")
'Debug.Print Asc("?")
'
'
'Debug.Print Asc("0")



GET_DATA
End Sub

Private Sub Command5_Click()

Text1.Text = STR_GET
'MsgBox STR_GET_DEV(0)
                
                
'                If Chr(indata(i)) = ")" Then
'                    length_Str = Len(STR_GET)
'                    length_SubStr = InStrRev(STR_GET, ")", -1, vbTextCompare)
'                    STR_GET_DEV(0) = Mid(STR_GET, length_SubStr + 1, length_Str - length_SubStr)
'                End If

Dim i As Long
Dim j As Long
Dim Value_Str As String
Dim length_Str As Long, length_SubStr As Long

length_Str = Len(STR_GET)
'length_SubStr = InStrRev(STR_GET, CByte("&H" & "0D") & CByte("&H" & "0A"), -1, vbTextCompare)
length_SubStr = InStr(1, STR_GET, CByte("&H" & "0D") & CByte("&H" & "0A"), vbTextCompare)

j = 0
Value_Str = ""
For i = 1 To length_Str - 1

    If Asc(Mid(STR_GET, i, 1)) = 13 And Asc(Mid(STR_GET, i + 1, 1)) = 10 Then
        
        Value_Str = Mid(STR_GET, j + 1, i - j - 1)
        If Mid(Value_Str, 1, 3) = "20(" Then
            STR_GET_DEV(0) = Mid(Value_Str, 4, InStr(4, Value_Str, "*", vbTextCompare) - 4)
'            MsgBox InStr(4, Value_Str, "*", vbTextCompare)
        End If
        If Mid(Value_Str, 1, 3) = "22(" Then
            STR_GET_DEV(1) = Mid(Value_Str, 4, InStr(4, Value_Str, "*", vbTextCompare) - 4)
        End If
        j = i + 1
        
    End If
    
Next i


STR_GET = Mid(STR_GET, length_SubStr + 1, length_Str - length_SubStr)

End Sub

Private Sub Form_Load()
Command3.Enabled = False
Timer1.Enabled = False
Timer1.Interval = 0
'*****************
Call ConnectionDB
Call InitDB
'*****************
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Timer1.Enabled = False
    Timer1.Interval = 0
    If rs.State = 1 Then rs.Close
    If cnn.State = 1 Then cnn.Close
    Unload Me
    End
End Sub

Private Sub MSComm1_OnComm()

Dim s1
Dim s2
Dim s3
Dim s4
Dim ss As String
Dim i As Integer
Dim length_Str As Long, length_SubStr As String

        Command2.Enabled = False
        indata = MSComm1.Input
        strOut = indata
'            Debug.Print "---------indata(i)"
'             For i = 0 To UBound(strOut)
'                Debug.Print "strOut(" & i & ")=" & indata(i)
''                Debug.Print "strOut(" & i & ")=" & Hex(indata(i))
'             Next i
'             Debug.Print "---------Hex(indata(i))"
'             For i = 0 To UBound(strOut)
''                Debug.Print "strOut(" & i & ")=" & indata(i)
'                Debug.Print "strOut(" & i & ")=" & Hex(indata(i))
'             Next i
'             Debug.Print "---------Chr(indata(i))"
             For i = 0 To UBound(strOut)
'                Debug.Print "strOut(" & i & ")=" & indata(i)
'                Debug.Print "strOut(" & i & ")=" & Chr(indata(i))
                
                If Chr(indata(i)) <> "!" Then
                    STR_GET = STR_GET & Chr(indata(i))
                Else
                    Command2.Enabled = True
                End If
       
                
'                If Chr(indata(i)) = ")" Then
'                    length_Str = Len(STR_GET)
'                    length_SubStr = InStrRev(STR_GET, ")", -1, vbTextCompare)
'                    STR_GET_DEV(0) = Mid(STR_GET, length_SubStr + 1, length_Str - length_SubStr)
'                End If
                
                
                
                
             Next i
        '''     If strOut(0) = 68 Then
        '''     MsgBox "ksfdka"
        '''     End If
'        s4 = Format(Hex(indata(12) - 51), "00")
'        s3 = Format(Hex(indata(13) - 51), "00")
'        s2 = Format(Hex(indata(14) - 51), "00")
'        s1 = Format(Hex(indata(15) - 51), "00")
'        ss = s1 & s2 & s3 & "." & s4
        'Debug.Print "ss=" & ss

        MSComm1.InBufferCount = 0
End Sub


Private Sub GET_DATA()
Dim i As Long
        indata = MSComm1.Input
        strOut = indata
'            Debug.Print "---------indata(i)"
'             For i = 0 To UBound(strOut)
'                Debug.Print "strOut(" & i & ")=" & indata(i)
''                Debug.Print "strOut(" & i & ")=" & Hex(indata(i))
'             Next i
'             Debug.Print "---------Hex(indata(i))"
'             For i = 0 To UBound(strOut)
''                Debug.Print "strOut(" & i & ")=" & indata(i)
'                Debug.Print "strOut(" & i & ")=" & Hex(indata(i))
'             Next i
'             Debug.Print "---------Chr(indata(i))"
'             For i = 0 To UBound(strOut)
''                Debug.Print "strOut(" & i & ")=" & indata(i)
'                Debug.Print "strOut(" & i & ")=" & Chr(indata(i))
'             Next i
        '''     If strOut(0) = 68 Then
        '''     MsgBox "ksfdka"
        '''     End If
'        s4 = Format(Hex(indata(12) - 51), "00")
'        s3 = Format(Hex(indata(13) - 51), "00")
'        s2 = Format(Hex(indata(14) - 51), "00")
'        s1 = Format(Hex(indata(15) - 51), "00")
'        ss = s1 & s2 & s3 & "." & s4
        'Debug.Print "ss=" & ss
        
        MSComm1.InBufferCount = 0
End Sub




'************************************
Private Sub ConnectionDB()
On Error GoTo Err_ConnectionDB:
    If cnn.State = 1 Then cnn.Close
    Set cnn = New ADODB.Connection
    Set rs = New ADODB.Recordset
'    cnn.ConnectionString = "Provider=OraOLEDB.Oracle.1;Password=yq;Persist Security Info=True;User ID=yq;Data Source=yqdata"
'    cnn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=MQ_DBCONN_ACCESS"
    cnn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=mysqlconn"
'    cnn.CursorLocation = adUseClient
'    rs.CursorLocation = adUseClient
    cnn.Open

    Exit Sub
Err_ConnectionDB:
   msg = "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description
   MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
   Err.Clear
'   Exit Sub   ' 将控制返回到产生错误的语句。
   End
End Sub

Private Sub InitDB()
On Error GoTo Err_InitDB:

    If rs.State = 1 Then rs.Close
    strcon = "select count(*) from DCS_KWHR"
    rs.Open strcon, cnn, adOpenStatic, adLockOptimistic


    Exit Sub
Err_InitDB:
   msg = "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description
   MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
   Err.Clear
'   Exit Sub   ' 将控制返回到产生错误的语句。
   End
End Sub

Private Sub InsertDB(Dcs_value As Single, TAG As String)
    If rs.State = 1 Then rs.Close

    strcon = "insert into  DCS_KWHR (qty_c,tag) values (" & Dcs_value & ",'" & TAG & "')"
    rs.Open strcon, cnn, adOpenStatic, adLockOptimistic
End Sub

Private Sub Timer1_Timer()
On Error GoTo ERR_TIMER:
    If Command2.Enabled = True Then
        Call Command5_Click
        'WH_300_1
        InsertDB CSng(Trim(STR_GET_DEV(0))), "WH_300_1"
        'WH_300_2
        InsertDB CSng(Trim(STR_GET_DEV(1))), "WH_300_2"
        Call Command2_Click
        Command2.Enabled = False
    End If
    Exit Sub
ERR_TIMER:
    Call Form_Load
    Call Command1_Click

End Sub