frmcomm.frm

eda9003串口程序编程源码

   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   1560
      Top             =   3120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label lbl1 
      Caption         =   "Label1"
      Height          =   375
      Left            =   645
      TabIndex        =   66
      Top             =   1155
      Width           =   1680
   End
   Begin VB.Label lbl2 
      Caption         =   "Label4"
      Height          =   255
      Left            =   645
      TabIndex        =   65
      Top             =   1875
      Width           =   10695
   End
   Begin VB.Label lbl3 
      Caption         =   "Label5"
      Height          =   255
      Left            =   645
      TabIndex        =   64
      Top             =   2355
      Width           =   1335
   End
   Begin VB.Label lbl4 
      Caption         =   "Label1"
      Height          =   255
      Left            =   2805
      TabIndex        =   63
      Top             =   2355
      Width           =   1335
   End
   Begin VB.Label lbl5 
      Caption         =   "Label4"
      Height          =   255
      Left            =   4845
      TabIndex        =   62
      Top             =   2355
      Width           =   1455
   End
   Begin VB.Label lbl6 
      Caption         =   "Label1"
      Height          =   375
      Left            =   4245
      TabIndex        =   61
      Top             =   1155
      Width           =   1455
   End
   Begin VB.Label Label1 
      Caption         =   "电压失败次数"
      Height          =   240
      Left            =   3075
      TabIndex        =   60
      Top             =   1155
      Width           =   1110
   End
   Begin VB.Label Label4 
      Caption         =   "电量失败次数"
      Height          =   240
      Left            =   3090
      TabIndex        =   59
      Top             =   1515
      Width           =   1110
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   330
      Left            =   4260
      TabIndex        =   58
      Top             =   1515
      Width           =   1260
   End
   Begin VB.Label Label6 
      Caption         =   "Label6"
      Height          =   255
      Left            =   5805
      TabIndex        =   57
      Top             =   1515
      Width           =   855
   End
   Begin VB.Label Label7 
      Caption         =   "Label7"
      Height          =   255
      Left            =   5805
      TabIndex        =   56
      Top             =   1155
      Width           =   855
   End
   Begin VB.Label Label9 
      Caption         =   "Label9"
      Height          =   540
      Left            =   630
      TabIndex        =   55
      Top             =   2835
      Width           =   2025
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   0
      Left            =   600
      TabIndex        =   54
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   1
      Left            =   1380
      TabIndex        =   53
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   2
      Left            =   2205
      TabIndex        =   52
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   3
      Left            =   2955
      TabIndex        =   51
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   4
      Left            =   3690
      TabIndex        =   50
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   5
      Left            =   4590
      TabIndex        =   49
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   6
      Left            =   5415
      TabIndex        =   48
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   7
      Left            =   6375
      TabIndex        =   47
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   8
      Left            =   7320
      TabIndex        =   46
      Top             =   0
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "Label11"
      Height          =   315
      Index           =   9
      Left            =   585
      TabIndex        =   45
      Top             =   270
      Width           =   870
   End
End
Attribute VB_Name = "frmComm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim strS As String
Dim str0 As String
Dim str1 As String
Dim str2 As String
Dim Dylc As String
Dim Dllc As String
Dim StartCount As Integer
Dim en As rdoEnvironment
Dim cn As rdoConnection
Dim rd As rdoResultset

Private Sub Command2_Click()
  'Dim comd As String
  'Dim ys As Single
  
  '  comd = "&" + Right("0" + Hex(ModAddress), 2) + zhen + Chr(13)
  '  frmComm.MSComm1.Output = comd
  '  ys = Timer + 0.2
  '  Do
  '     DoEvents
  '  Loop Until Timer > ys
  '  comd = frmComm.MSComm1.Input
'End Sub
End Sub

'Private Sub Command4_Click()
'    Set en = rdoEnvironments(0)
'    Set cn = en.OpenConnection("odbc;", False, False, "dsn=sy;uid="";pwd=""")
'    Dim AXDY, BXDY, CXDY, AXDL, BXDL, CXDL, AXYG, BXYG, CXYG, WGGL, DL As String
'    Dim YGGL, GLYS As String
'    Dim SqlStr As String
'    Dim Dylc1, Dllc1 As String
'    Dylc1 = Dylc(StartCount - 1)
'    Dllc1 = Dllc(StartCount - 1)
'    SqlStr = "insert into dianliang(address,axdy,bxdy,cxdy,axdl,bxdl,cxdl,yggl,glys,axyg,bxyg,cxyg,"
'    SqlStr = SqlStr + "Dylch,Dllch,wggl,dl) "
'    SqlStr = SqlStr + "values('" + ModAddress1(StartCount - 1) + "','" + AXDY + "',"
'    SqlStr = SqlStr + "'" + BXDY + "','" + CXDY + "','" + AXDL + "','" + BXDL + "',"
'    SqlStr = SqlStr + "'" + CXDL + "','" + YGGL + "','" + GLYS + "','" + AXYG + "','" + BXYG + "',"
'    SqlStr = SqlStr + "'" + CXYG + "','" + Dylc(StartCount - 1) + "','" + Dllc(StartCount - 1) + "',"
'    SqlStr = SqlStr + "'" + WGGL + "','" + DL + "')"
'    MsgBox SqlStr
'    cn.Execute SqlStr
'End Sub
Private Sub Form_Load()
  ReadCommandLine
  Set en = rdoEnvironments(0)
  Set cn = en.OpenConnection("odbc;", False, False, "dsn=sy;uid="";pwd=""")
  StartCount = 1
  If MSComm1.PortOpen = False Then
     MSComm1.PortOpen = True
  End If
  MSComm1.InputMode = 0
  Dim SendStr As String
  'SendStr = ModCount + 1
  '发送消息
  Dim str As String
   Dim i As Integer
   For i = 1 To 4
   SendStr = ModCount + 1
  str = "$" + "0" + SendStr + "M" + Chr(13)
  MSComm1.Output = str
  DoEvents
  WaitData
  strS = MSComm1.Input
  If Left(strS, 1) = "!" And Right(strS, 1) = Chr(13) Then
      '发送消息
     ' Dim i As Integer
     ' For i = 1 To 4
      str = "$" + Right("0" + Hex(i), 2) + "2" + Chr(13)
      MSComm1.Output = str
      WaitData
      strS = MSComm1.Input
      If Left(strS, 1) = "!" And Right(strS, 1) = Chr(13) Then
           ModAddress1(ModCount) = Format(i, "000") + "(" + Right("0" + Hex(i), 2) + "H)"
           'ModCount = ModCount + 1
      End If
      'Next i
      Timer3.Enabled = True
  End If
  ModCount = ModCount + 1
  Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
    MSComm1.PortOpen = False
End Sub

Private Sub Timer3_Timer()
If (StartCount <= ModCount) Then
    str0 = "#" + Right("0" + Hex(StartCount), 2) + "W" + Chr(13) '读电量
    str1 = "#" + Right("0" + Hex(StartCount), 2) + "A" + Chr(13) '读电流
    str2 = "#" + Right("0" + Hex(StartCount), 2) + "P" + Chr(13) '总功率
    GetModData
Else
    'Sleep 1000
    StartCount = 1
    Dim SqlStr As String
    SqlStr = "delete from dianliang"
    cn.Execute SqlStr
    'Sleep 1000
End If
End Sub
Public Sub GetModData()
    Dim i As Integer
    Dim DL As String
    '当参数传进来
    'Dylc = 250 '电压量程
    'Dllc = 5 '电流量程
    Dylc = 100
    Dllc = 5
    Dim dian1 As String
    Dim fh As String
    Dim str11 As String
    MSComm1.Output = str0
    WaitData
    strS = MSComm1.Input
    str11 = Mid(strS, 2, 1)
    If Left(strS, 1) = ">" And (Mid(strS, 2, 1) <> "+" And Mid(strS, 2, 1) <> "-") Then
            Dim zhen As Long
            zhen = Mid$(strS, 2, 2)
            fh = Mid$(strS, 4, 1)
            dian1 = ("&H" + Mid(strS, 5, 6))
            DL = fh & Val(dian1)
            DL = Mid(strS, 4, 1) & Val("&H" + Mid(strS, 5, 6))
            DL = Format(DL * Dylc * Dllc / 3 / 1000 / 3600, "0.000")
       Else
            fh = Mid$(strS, 2, 1)
            dian1 = ("&H" + Mid(strS, 3, 8))
            DL = fh & Val(dian1)
            DL = Mid(strS, 2, 1) & Val("&H" + Mid(strS, 3, 8))
            DL = Format(DL * Dylc * Dllc / 3 / 1000 / 3600, "0.000") '电量
    End If
    
    MSComm1.Output = str1
    WaitData
    strS = MSComm1.Input
    
    If Left(strS, 1) = ">" Then
       Dim AXDY As String
       On Error Resume Next
       AXDY = Mid(strS, 7 - 5, 7) * Dylc
       Dim BXDY As String
       On Error Resume Next
       BXDY = Mid(strS, 3 * 7 - 5, 7) * Dylc
       Dim CXDY As String
       On Error Resume Next
       CXDY = Mid(strS, 5 * 7 - 5, 7) * Dylc
       Dim AXDL As String
       On Error Resume Next
       AXDL = Mid(strS, 2 * 7 - 5, 7) * Dllc
       Dim BXDL As String
       On Error Resume Next
       BXDL = Mid(strS, 4 * 7 - 5, 7) * Dllc
       Dim CXDL As String
       On Error Resume Next
       CXDL = Mid(strS, 6 * 7 - 5, 7) * Dllc
       Dim YGGL As String
       On Error Resume Next
       YGGL = Mid(strS, 7 * 7 - 5, 7) * Dylc * Dllc * 3
       Dim WGGL As String
       On Error Resume Next
       WGGL = Mid(strS, 8 * 7 - 5, 7) * Dylc * Dllc * 3
       Dim GLYS As String
       On Error Resume Next
       GLYS = Mid(strS, 9 * 7 - 5, 7) '* Dylc * Dllc * 3
    End If
    
    MSComm1.Output = str2
    WaitData
    strS = MSComm1.Input
    If Left(strS, 1) = ">" Then
        Dim AXYG As String
        AXYG = Mid(strS, 1 * 7 - 5, 7) * Dylc * Dllc
        Dim BXYG As String
        BXYG = Mid(strS, 2 * 7 - 5, 7) * Dylc * Dllc
        Dim CXYG As String
        CXYG = Mid(strS, 3 * 7 - 5, 7) * Dylc * Dllc
    End If
    '建一个表
    Dim SqlStr As String
    SqlStr = "insert into dianliang(address,axdy,bxdy,cxdy,axdl,bxdl,cxdl,yggl,glys,axyg,bxyg,cxyg,"
    SqlStr = SqlStr + "Dylch,Dllch,wggl,dl) "
    SqlStr = SqlStr + "values('" + ModAddress1(StartCount - 1) + "','" + AXDY + "',"
    SqlStr = SqlStr + "'" + BXDY + "','" + CXDY + "','" + AXDL + "','" + BXDL + "',"
    SqlStr = SqlStr + "'" + CXDL + "','" + YGGL + "','" + GLYS + "','" + AXYG + "','" + BXYG + "',"
    SqlStr = SqlStr + "'" + CXYG + "','" + Dylc + "','" + Dllc + "',"
    SqlStr = SqlStr + "'" + WGGL + "','" + DL + "')"
    cn.Execute SqlStr
    StartCount = StartCount + 1
End Sub
Public Sub WaitData()
   Dim WaitCount As Integer
   Dim Flag As Boolean
   Flag = True
   While (Flag)
        If frmComm.MSComm1.InBufferCount >= 8 Then
            Flag = False
        Else
            Sleep (100)
            WaitCount = WaitCount + 1
            If WaitCount = 2 Then
                Flag = False
            End If
        End If
   Wend
End Sub
Public Sub ReadCommandLine()
'Dim CmdLine As String
'Dim C As String
'Dim CmdLnLen As Integer
'CmdLine = Command
'CmdLnLen = Len(CmdLine)
'Dim i, j, k As Integer
'j = 0
'k = 0
'Dim TempStr As String
'For i = 1 To CmdLnLen
'      C = Mid(CmdLine, i, 1)
'      'Test for space or tab.
'      If (C <> " " And C <> vbTab) Then
'         'Concatenate character to current argument.
'          TempStr = TempStr & C
'      Else
         'Found a space or tab.
'         If (j < 4) Then
'            Dylc(j) = Val(TempStr)
'            MsgBox Dylc(j)
'            j = j + 1
'         ElseIf (k < 4) Then
'            Dllc(k) = Val(TempStr)
'            MsgBox Dllc(k)
'            k = k + 1
'         End If
'         TempStr = ""
'      End If
'Next i
End Sub