tongxun.bas

主要用于控制三相电能表检验装置

                    End If
                    lIntRet = WriteFile(CommSetJ(FileH).LHdcComm, outdata(0), DataLen, lLngWrited, lOvlWrite) '//发送数据
                    'Dim showst As String
                    'showst = HextoCharString(outdata, datalen)
                    'Debug.Print "发送:" & showst
           End If
        End If
    Next i
End Function
Function PutCommandBuff()
   Dim st As String
   Dim i As Byte
   Dim j As Byte
   If CommNUM <> 0 Then
      For i = 0 To CommNUM
          If CommSetJ(i).Comm <> "" Then
             st = CommSetJ(i).Comm
             CopyCommand (st)
          Else
             Exit Function
          End If
      Next i
   Else
      Exit Function
   End If
    i = 0
End Function

Function PutCommandBuff1(MeterNum As Byte) As Byte
   Dim st As String
   Dim i As Byte
   Dim j As Byte
   If MeterNum <> 0 Then 'CommNUM
      For i = 0 To MeterNum 'CommNUM
          If CommSetJ(i).Comm <> "" Then
             st = CommSetJ(i).Comm
             CopyCommand (st)
          Else
             PutCommandBuff1 = 1
             Exit Function
          End If
      Next i
   Else
      PutCommandBuff1 = 2
      Exit Function
   End If
End Function

Function CopyCommand(st As String) As Byte
    Dim i As Byte
    Dim j As Long
    For i = 0 To 11
        j = 0
        If st = BiaoWei(i).Comm Then
            Do While outdata(j) <> &HFF
                TxOutBuff(i, j) = outdata(j)
                j = j + 1
            Loop
            CommDWOut(i).Comm = st
            CommDWOut(i).DataLen = j
        End If
    Next i
End Function
Function PutInToComm(Comm As String, Data() As Byte, DataLen As Long) As Long '向某个串口发送数据
        Dim beishu As Byte
        If DataLen > 599 Then '
         Exit Function
        End If
        Dim i As Integer
        CommDWOut(CommScan).Comm = Comm
        CommDWOut(CommScan).DataLen = DataLen
        For i = 0 To DataLen - 1
            TxOutBuff(CommScan, i) = Data(i)
        Next i
        CommScan = CommScan + 1
        If CommScan > 23 Then
           CommScan = 0
        End If
End Function
Function JieShou_Main() '接收主程序
    Dim i As Byte
    For i = 0 To 23
        If CommSetJ(i).Comm <> "" Then
            UartReceiveFormComm CommSetJ(i).Comm
        End If
    Next i
End Function
Function GetCommFileH(Comm As String) As Long
       Dim i As Byte
       GetCommFileH = -1
       For i = 0 To 23
        If CommSetJ(i).Comm = Comm Then
            GetCommFileH = i 'CommSetJ(i).LHdcComm
            Exit For
        End If
    Next i
End Function
Function GetBuffIndex(Comm As String) As Byte
    Dim i As Byte
    Dim st As String
    
'    If MainJieShou = "自动搜索串口" Then
'        st = Comm
'        st = Right(st, Len(st) - 3)
'        i = Val(st)
'        GetBuffIndex = i - 1
'     Else
        For i = 0 To 11
            If BiaoWei(i).Comm = Comm Then
                GetBuffIndex = i
                Exit For
            End If
        Next i
        If i = 12 Then
            GetBuffIndex = 12
        End If
'    End If
    
    'For i = 0 To 23
    '    If CommDWIn(i).comm = comm Then
    '        GetBuffIndex = i
    '        Exit For
    '    End If
    'Next i
    
End Function
Function UartReceiveFormComm(Comm As String) As Long
  Dim BuffIndex As Byte
  Dim lLngTmp As Long
  Dim lLngError As Long
  Dim lLngChars As Long
  Dim lLngReceived As Long
  Dim lTypComStat As COMSTAT
  Dim lOvlRead As OVERLAPPED
  Dim pHdcCommFile As Long
  On Error Resume Next
  BuffIndex = GetBuffIndex(Comm)
  If BuffIndex = -1 Then
    Exit Function
  End If
  pHdcCommFile = GetCommFileH(Comm) '获取建立的句饼
  If pHdcCommFile = -1 Then
    Exit Function
  End If
  
  lLngTmp = ClearCommError(CommSetJ(pHdcCommFile).LHdcComm, lLngError, lTypComStat)
  If lTypComStat.cbInQue = 0 Then '数据缓冲区无数据，不接收
     'CommDWIn(BuffIndex).DataLen = 0
     Exit Function
  Else
     If CommDWIn(BuffIndex).DataLen = lTypComStat.cbInQue Then
        CommDWIn(BuffIndex).Comm = Comm
        lLngChars = ReadFile(CommSetJ(pHdcCommFile).LHdcComm, CommDWIn(BuffIndex).RxInBuff(0), CommDWIn(BuffIndex).DataLen, lLngReceived, lOvlRead)  '取出相关的数据
        'Dim showst As String
        'showst = HextoCharString(CommDWIn(BuffIndex).RxInBuff, CommDWIn(BuffIndex).datalen)
        'Debug.Print "接收：" & showst
        'If MainJieShou = "自动搜索串口" Then
        '    Aoto_Scan Comm, CommDWIn(BuffIndex).RxInBuff, CommDWIn(BuffIndex).datalen
        'ElseIf MainJieShou = "硬件测试" Then
        '    DataFenXi_CeShi Comm, CommDWIn(BuffIndex).RxInBuff, CommDWIn(BuffIndex).datalen
        'ElseIf MainJieShou = "程序升级" Then
        '    DataFenXi_wenjian Comm, CommDWIn(BuffIndex).RxInBuff, CommDWIn(BuffIndex).datalen
        'ElseIf MainJieShou = "文件自动下载" Then
        '     CanShuGet_Rece Comm, CommDWIn(BuffIndex).RxInBuff, CommDWIn(BuffIndex).datalen
        'End If
 
     Else
        'lLngChars = ReadFile(CommSetJ(pHdcCommFile).LHdcComm, CommDWIn(BuffIndex).RxInBuff(0), CommDWIn(BuffIndex).DataLen, lLngReceived, lOvlRead)  '取出相关的数据
        CommDWIn(BuffIndex).DataLen = lTypComStat.cbInQue '获取数据的长度
        'CommDWIn(BuffIndex).Comm = Comm
     End If
  End If
End Function

Function Cal_cs(DataLen As Long, DataBuff() As Byte) As Byte
    Dim cs As Integer
    Dim j As Long
    cs = 0
    For j = 0 To DataLen - 1
        cs = cs + DataBuff(j)
        cs = cs And &HFF
    Next j
    cs = cs And &HFF
    Cal_cs = cs
End Function
Function ZuTestZheng(Comm As String, Command As Byte, Name As Byte, DataLen As Long, DataBuff() As Byte)
    Dim temp() As Byte
    Dim le As Long
    le = DataLen + 7
    ReDim temp(le) As Byte
    temp(0) = &H68
    temp(1) = Command
    temp(2) = Name
    Dim j As Byte
    j = DataLen \ 256
    temp(3) = j
    j = DataLen And &HFF
    temp(4) = j
    le = 0
    If DataLen > 0 Then
        For le = 0 To DataLen - 1
            temp(5 + le) = DataBuff(le)
        Next le
    End If
    temp(5 + le) = Cal_cs(5 + le, temp)
    temp(6 + le) = &H16
    If Comm <> "" Then
        PutInToComm Comm, temp, 7 + le
    End If
End Function
Function Commpeizhi() '对串口进行自动配置
    Dim file
    Dim fname
    Dim i As Byte
    Dim st(13) As String
    fname = App.Path & "\CanShu\" & "自动搜索.txt"
    If FSO.FileExists(fname) = False Then
        MsgBox ("表台串口配置文件已丢失，请重新启动搜索！")
        st(0) = "台体00:"
        st(1) = "表位01:"
        st(2) = "表位02:"
        st(3) = "表位03:"
        st(4) = "表位04:"
        st(5) = "表位05:"
        st(6) = "表位06:"
        st(7) = "表位07:"
        st(8) = "表位08:"
        st(9) = "表位09:"
        st(10) = "表位10:"
        st(11) = "表位11:"
        st(12) = "表位12:"
        st(13) = "End"
        FSO.CreateTextFile (fname)
        Set file = FSO.OpenTextFile(fname, ForWriting, False)
        For i = 0 To 13
            file.WriteLine st(i)
        Next i
        file.Close
        'Load Form1
        'Main.Hide
    Else
        Dim tempstring As String
        Dim ss() As String
        Set file = FSO.OpenTextFile(fname, ForReading, False)
        For i = 0 To 13
             st(i) = file.ReadLine
        Next i
        For i = 1 To 12
            tempstring = st(i)
            tempstring = Right(tempstring, Len(tempstring) - 5)
            tempstring = Trim(tempstring)
            If Len(tempstring) > 10 Then
                ss = Split(tempstring, ":")
                BiaoWei(i - 1).Comm = ss(0)
                BiaoWei(i - 1).Peizhi = ss(1)
            End If
        Next i
        file.Close
    End If
End Function
Function ScanProcess()


End Function
Function DataJieXi(Comm As String) '对数据进行解析
Dim i As Integer
Dim ID As Long
Dim DataShow As Double
Dim L As Integer
Dim IDS As String
Dim ii(100) As Byte
Dim j As Integer
Dim NUM As Byte
For i = 0 To 11