commu_oncom.bas

用vb编程

Attribute VB_Name = "Module2"
Declare Function bdatashl Lib "d:\vbapp\dllkt\deldllkt.dll" (ByVal data As Integer, ByVal lnum As Integer) As Byte
Declare Function bdatashr Lib "d:\vbapp\dllkt\deldllkt.dll" (ByVal data As Integer, ByVal rnum As Integer) As Byte
Declare Function idatashl Lib "d:\vbapp\dllkt\deldllkt.dll" (ByVal data As Integer, ByVal lnum As Integer) As Integer
Declare Function idatashr Lib "d:\vbapp\dllkt\deldllkt.dll" (ByVal data As Integer, ByVal rnum As Integer) As Integer
' need 1 communication port:
'dx: 1:send ipc12,rec ipc12
'send ipc12:
'              2byte start,
'              1byte length,
'              68=(15*2+1*4)*2byte data,
'              1byte end  data
'         total=2+1+68+1=72byte;
'reco ipc12:
'              2byte start,
'              1byte length,
'              8byte data,(p1,p2,t1,t2 or p3,p4,t3,t4)
'              1byte end  data
'              2+1+8+1=12byte;
Public Const buf_len = 512
Private Const v12sendlength = 72
Private Const v12datalength = 68
Private Const pt12reclength = 12
Private Const pt12datalength = 8

Public v12sdata(71), rec_count, send_count, buf_start, buf_end As Integer
Public v12ripcdata(11), rec_s1, rec_s2, buf_data(512) As Byte
Public rec_flag, commu_first As Boolean
Public Sub init_communication()
  v12senddata = False
  v12sendlen = False
  pt12dataflag = False
  pt12lenflag = False
  Call init_commu_port_1(3, 9600)
End Sub
Private Sub init_commu_port_1(ByVal port_no, bpds As Integer)
  Form1.MSComm1.CommPort = port_no
  Form1.MSComm1.InputLen = 0
  Form1.MSComm1.PortOpen = True
  Form1.MSComm1.Settings = bpds
End Sub
Public Sub close_commu_port()
  Form1.MSComm1.PortOpen = False
End Sub
Public Sub read_ipc12_byte()
Dim i As Integer
Dim a As Variant
Dim c As Byte
Dim sr() As Byte
  If (Form1.MSComm1.InBufferCount > 0) Then
   a = Form1.MSComm1.Input
   sr = a
   If (rec_flag) Then
     v12ripcdata(rec_count) = sr(0)
     rec_count = rec_count + 1
   ElseIf (rec_s1 <> &HFF) Then
     rec_s1 = sr(0)
   ElseIf (rec_s1 = &HFF) Then
     rec_s2 = sr(0)
     If (rec_s2 = &HFF) Then
       rec_flag = True
       v12ripcdata(0) = rec_s1
       v12ripcdata(1) = rec_s2
       rec_count = 2
       rec_s1 = 0
       rec_s2 = 0
     Else
       rec_s1 = 0
       rec_s2 = 0
     End If
   End If
  End If
  
 If ((rec_count = pt12reclength) And (rec_flag)) Then
   rec_count = 0
   rec_flag = False
   c = 0
   For i = 2 To pt12reclength - 2
     c = c Or v12ripcdata(i)
   Next i
   v12ripcdata(11) = v12ripcdata(11)
  If ((v12ripcdata(0) = &HFF) And (v12ripcdata(1) = &HFF) And _
      (v12ripcdata(2) = pt12datalength) And (v12ripcdata(pt12reclength - 1) = c)) Then
    For i = 0 To 1
      v1datapt(i) = v12ripcdata(i * 2 + 3) * 256 + v12ripcdata(i * 2 + 4)
      v1sampdatapt(i) = v1datapt(i) + admin
      If (v1datapt(i) > admaxr) Then v1datapt(i) = admaxr
      If (v1datapt(i) < adminr) Then v1datapt(i) = adminr
      v1valuept(i) = v1datapt(i) * mea_coi_v1pt(i) + mea_low_v1pt(i)
      v2datapt(i) = v12ripcdata(i * 2 + 7) * 256 + v12ripcdata(i * 2 + 8)
      v2sampdatapt(i) = v2datapt(i) + admin
      If (v2datapt(i) > admaxr) Then v2datapt(i) = admaxr
      If (v2datapt(i) < adminr) Then v2datapt(i) = adminr
      v2valuept(i) = v2datapt(i) * mea_coi_v2pt(i) + mea_low_v2pt(i)
    Next i
  End If
 End If
End Sub
Public Function read_ipc12_batch() As Boolean
Dim i, ri As Integer
Dim a As Variant
Dim c As Byte
Dim sr() As Byte
 If (rec_flag) Then
  rec_flag = False
  If (commu_first) Then
    i = 0
    Do Until (i > pt12reclength - 2) Or _
             ((buf_data(buf_start) = &HFF) And _
              (buf_data(buf_start + 1) = &HFF))
      i = i + 1
      buf_start = buf_start + 1
      If (buf_start > buf_len) Then buf_start = 0
      commu_first = False
    Loop
  ElseIf ((buf_end - buf_start) >= pt12reclength) Then
    For i = 0 To pt12reclength - 1
      v12ripcdata(i) = buf_data(buf_start + i)
    Next i
    buf_start = buf_start + pt12reclength
    If (buf_start > buf_len) Then
      buf_start = buf_start - (buf_len + 1)
    End If
    c = 0
    For i = 2 To pt12reclength - 2
      c = c Or v12ripcdata(i)
    Next i
    If ((v12ripcdata(0) = &HFF) And (v12ripcdata(1) = &HFF) And _
        (v12ripcdata(2) = pt12datalength) And v12ripcdata(pt12reclength - 1) = c) Then
      For i = 0 To 1
        v1datapt(i) = v12ripcdata(i * 2 + 3) * 256 + v12ripcdata(i * 2 + 4)
        v1sampdatapt(i) = v1datapt(i) + admin
        If (v1datapt(i) > admaxr) Then v1datapt(i) = admaxr
        If (v1datapt(i) < adminr) Then v1datapt(i) = adminr
        v1valuept(i) = v1datapt(i) * mea_coi_v1pt(i) + mea_low_v1pt(i)
        v2datapt(i) = v12ripcdata(i * 2 + 7) * 256 + v12ripcdata(i * 2 + 8)
        v2sampdatapt(i) = v2datapt(i) + admin
        If (v2datapt(i) > admaxr) Then v2datapt(i) = admaxr
        If (v2datapt(i) < adminr) Then v2datapt(i) = adminr
        v2valuept(i) = v2datapt(i) * mea_coi_v2pt(i) + mea_low_v2pt(i)
      Next i
    End If
  End If
 End If
End Function
Private Sub read_OnComm_3s()
Dim i As Integer
Dim a As Variant
Dim c As Byte
Dim sr() As Byte
 If (Form1.MSComm1.InBufferCount > 0) Then
  a = Form1.MSComm1.Input
  sr = a
  If (rec_flag) Then
    v12ripcdata(rec_count) = sr(0)
    rec_count = rec_count + 1
  ElseIf (rec_s1 <> &HFF) Then
    rec_s1 = sr(0)
  ElseIf (rec_s1 = &HFF) Then
    rec_s2 = sr(0)
    If (rec_s2 = &HFF) Then
      rec_flag = True
      v12ripcdata(0) = rec_s1
      v12ripcdata(1) = rec_s2
      rec_count = 2
      rec_s1 = 0
      rec_s2 = 0
    Else
      rec_s1 = 0
      rec_s2 = 0
    End If
  End If
 End If
  
 If ((rec_count = pt12reclength) And (rec_flag)) Then
   rec_count = 0
   rec_flag = False
   c = 0
   For i = 2 To pt12reclength - 2
     c = c Or v12ripcdata(i)
   Next i
  If ((v12ripcdata(0) = &HFF) And (v12ripcdata(1) = &HFF) And _
      (v12ripcdata(2) = pt12datalength) And v12ripcdata(pt12reclength - 1) = c) Then
    For i = 0 To 1
      v1datapt(i) = v12ripcdata(i * 2 + 3) * 256 + v12ripcdata(i * 2 + 4)
      v1sampdatapt(i) = v1datapt(i) + admin
      If (v1datapt(i) > admaxr) Then v1datapt(i) = admaxr
      If (v1datapt(i) < adminr) Then v1datapt(i) = adminr
      v1valuept(i) = v1datapt(i) * mea_coi_v1pt(i) + mea_low_v1pt(i)
      v2datapt(i) = v12ripcdata(i * 2 + 7) * 256 + v12ripcdata(i * 2 + 8)
      v2sampdatapt(i) = v2datapt(i) + admin
      If (v2datapt(i) > admaxr) Then v2datapt(i) = admaxr
      If (v2datapt(i) < adminr) Then v2datapt(i) = adminr
      v2valuept(i) = v2datapt(i) * mea_coi_v2pt(i) + mea_low_v2pt(i)
    Next i
  End If
 End If
End Sub
Private Sub prepare_v12data()
Dim lfsum, lfu3, lfu2, lfu1 As Long
Dim c, i As Byte
lfu3 = 16777216 '256*256*256
lfu2 = 65536     '256*256
lfu1 = 256
  v12sdata(0) = &HFF
  v12sdata(1) = &HFF
  v12sdata(2) = v12datalength
  For i = 0 To 14 'v1:1~14
    v12sdata(i * 2 + 3) = v1data(i) \ 256
    v12sdata(i * 2 + 4) = v1data(i) - v12sdata(i * 2 + 3) * 256
  Next i
  lfsum = Fix(v1_fsum)
  v12sdata(33) = lfsum \ lfu3
  v12sdata(34) = (lfsum - v12sdata(33) * lfu3) \ lfu2
  v12sdata(35) = (lfsum - v12sdata(33) * lfu3 _
                        - v12sdata(34) * lfu2) \ lfu1
  v12sdata(36) = lfsum - v12sdata(33) * lfu3 _
                       - v12sdata(34) * lfu2 _
                       - v12sdata(35) * lfu1
  For i = 0 To 14 'v2:1~14
    v12sdata(i * 2 + 37) = v2data(i) \ 256
    v12sdata(i * 2 + 38) = v2data(i) - v12sdata(i * 2 + 37) * 256
  Next i
  lfsum = Fix(v2_fsum)
  v12sdata(67) = lfsum \ lfu3
  v12sdata(68) = (lfsum - v12sdata(67) * lfu3) \ lfu2
  v12sdata(69) = (lfsum - v12sdata(67) * lfu3 _
                        - v12sdata(68) * lfu2) \ lfu1
  v12sdata(70) = lfsum - v12sdata(67) * lfu3 _
                       - v12sdata(68) * lfu2 _
                       - v12sdata(69) * lfu1
  c = 0
  For i = 3 To 70
    If (v12sdata(i) > admaxr) Then v12sdata(i) = admaxr
    If (v12sdata(i) < adminr) Then v12sdata(i) = adminr
    c = c Xor v12sdata(i)
  Next i
  v12sdata(71) = c
End Sub
Public Sub send_v12_win()
Dim vbsdata(71) As Byte
Dim a As Variant
Dim c, i As Byte
  prepare_v12data
  For i = 0 To 71
    vbsdata(71) = v12sdata(i)
  Next i
  a = vbsdata
  Form1.MSComm1.Output = a
End Sub
Public Sub send_v12_pas()
Dim pasdata(0) As Byte
Dim a As Variant
Dim c, i As Byte
  If (send_count >= v12sendlength) Then
    send_count = 0
    prepare_v12data
  End If
  pasdata(0) = v12sdata(send_count)
  a = pasdata
  Form1.MSComm1.Output = a
  send_count = send_count + 1
End Sub

Public Function read_ipc12_batch_test() As Boolean
Dim i As Integer
Dim a As Variant
Dim c As Byte
Dim sr() As Byte
  If (Form1.MSComm1.InBufferCount >= pt12reclength) Then
    a = Form1.MSComm1.Input
    sr = a
    For i = 0 To pt12reclength - 1
     v12ripcdata(i) = sr(i)
    Next i
    c = 0
    For i = 2 To pt12reclength - 2
      c = c Or v12ripcdata(i)
    Next i
  If ((v12ripcdata(0) = &HFF) And (v12ripcdata(1) = &HFF) And _
      (v12ripcdata(2) = pt12datalength) And v12ripcdata(pt12reclength - 1) = c) Then
    For i = 0 To 1
      v1datapt(i) = v12ripcdata(i * 2 + 3) * 256 + v12ripcdata(i * 2 + 4)
      v1sampdatapt(i) = v1datapt(i) + admin
      If (v1datapt(i) > admaxr) Then v1datapt(i) = admaxr
      If (v1datapt(i) < adminr) Then v1datapt(i) = adminr
      v1valuept(i) = v1datapt(i) * mea_coi_v1pt(i) + mea_low_v1pt(i)
      v2datapt(i) = v12ripcdata(i * 2 + 7) * 256 + v12ripcdata(i * 2 + 8)
      v2sampdatapt(i) = v2datapt(i) + admin
      If (v2datapt(i) > admaxr) Then v2datapt(i) = admaxr
      If (v2datapt(i) < adminr) Then v2datapt(i) = adminr
      v2valuept(i) = v2datapt(i) * mea_coi_v2pt(i) + mea_low_v2pt(i)
    Next i
  End If
 End If
End Function
Public Sub send_v12_test1()
Dim pasdata(11) As Byte
Dim a As Variant
Dim c, i As Byte
  pasdata(0) = &HFF
  pasdata(1) = &HFF
  pasdata(2) = 8
  pasdata(3) = &H3
  pasdata(4) = &H33
  pasdata(5) = &H6
  pasdata(6) = &H66
  pasdata(7) = &H9
  pasdata(8) = &H99
  pasdata(9) = &HC
  pasdata(10) = &HCC
  c = 0
  For i = 3 To pt12reclength - 2
   c = c Or pasdata(i)
  Next i
  pasdata(11) = c
  a = pasdata
  Form1.MSComm1.Output = a
End Sub
Public Sub send_v12_test2()
Dim pasdata(0) As Byte
Dim a As Variant
Dim c, i As Byte
  If (send_count >= v12sendlength) Then
    send_count = 0
    v12sdata(0) = &HFF
    v12sdata(1) = &HFF
    v12sdata(2) = &H8
    v12sdata(3) = &H3
    v12sdata(4) = &H33
    v12sdata(5) = &H6
    v12sdata(6) = &H66
    v12sdata(7) = &H9
    v12sdata(8) = &H99
    v12sdata(9) = &HC
    v12sdata(10) = &HCC
    c = 0
    For i = 3 To pt12reclength - 2
      c = c Or v12sdata(i)
    Next i
    v12sdata(11) = c
  End If
  pasdata(0) = v12sdata(send_count)
  a = pasdata
  Form1.MSComm1.Output = a
  send_count = send_count + 1
End Sub