frmcomm3.frm

这是一个实际的工程中所用的源程序

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmComm3 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer tmrCommStatus3 
      Enabled         =   0   'False
      Interval        =   1500
      Left            =   3960
      Top             =   1020
   End
   Begin VB.Timer tmrComm 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   4170
      Top             =   60
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   3510
      Top             =   30
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   4
      DTREnable       =   -1  'True
      RThreshold      =   19
      InputMode       =   1
   End
   Begin MSWinsockLib.Winsock sckServer 
      Index           =   0
      Left            =   90
      Top             =   60
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin MSCommLib.MSComm MSComm5 
      Left            =   2850
      Top             =   30
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   5
      DTREnable       =   -1  'True
      RThreshold      =   19
      InputMode       =   1
   End
End
Attribute VB_Name = "frmComm3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Const Settings_N As String = "9600,n,8,1"
Const Settings_M As String = "9600,m,8,1"
Const Settings_S As String = "9600,s,8,1"

Const Sc_IPs As String = "IP地址"
Dim CntClient As Integer ' = 5 '调度室客户端数

'这个模块通过串口4发送数据到调度室（或其他电脑）和接受流程数据。

Dim iDock As Integer
Dim DockData(0 To 19) As Integer

Private ComStatus3 '3#泊位流程
Public ComStatus
'Public ComTechs
Private mComTechs
Private bComTechs As Boolean


Public Property Let ComTechs(ByVal vNewValue As Variant)
   mComTechs = vNewValue
   If bComTechs = True Then
      If Not IsEmpty(mComTechs) Then
            #If dds = 0 Then
            
               Call SendStatus(mComTechs)
            #ElseIf dds = 1 Then
                  Call SockSend(mComTechs)
            #End If
            
      End If
   End If
End Property

'   SUCCESS  Length: 1: 86
'   SUCCESS  Length: 1: 12
'   SUCCESS  Length: 17: 20 80 00 0F 06 00 2A 24 03 00 00 D0 07 00 00 00 22
'   SUCCESS  Length: 1: 87
'   SUCCESS  Length: 1: 12
'   SUCCESS  Length: 17: 10 01 00 D0 0A 00 00 00 0E 00 00 00 00 FF 00 00 07
'   SUCCESS  Length: 1: 81
'   SUCCESS  Length: 1: 42
'   SUCCESS  Length: 12: 00 00 00 00 00 00 00 00 00 10 93 5C
'Lenth:8  3F 12 10 1 0 D0 A 0x
'Lenth:8  3F 12 20 80 0 F 6 0x
'
'Lenth:8  3F 12 10 1 0 F0 1B E8x
'Lenth:8  3F 12 20 80 0 F 6 0x

'测试输出：Lenth:19  3F 12 08 80 00 33 00 00 2F 00 00 00 00 80 00 00 00 00 95x
'实际输出：    Length: 17: 08 80 00 33 00 00 2F 00 00 00 00 80 00 00 00 00 95

Private Sub MSComm5_OnComm()
Dim i As Long
Dim j As Long

Dim Dock As Integer

    Dim iAddr  As Integer '站号
    '
    Dim DisplayStr As String
    Dim dblTotal As Double
    Dim dblRate  As Double
    Dim dblSpeed As Double
    Dim isAlarm  As Boolean
    
    Dim bcNumber   As Integer, bcNumber1 As Integer
    Dim bcResetTotal As Double
    Dim bcTotal    As Double
    Dim bcSetPoint As Double
    Dim bcPreSet   As Double
    Dim bcPreAct   As Double
    
Dim sR As String
Dim Receive
    
    On Error Resume Next

    Select Case MSComm5.CommEvent
       'Errors
       Case comEventBreak
       Case comEventCDTO
       Case comEventCTSTO
       Case comEventDSRTO
       Case comEventFrame
       Case comEventOverrun
       Case comEventRxOver
       Case comEventRxParity
       Case comEventTxFull
       Case comEventDCB
       'Event
       Case comEvCD
       Case comEvCTS
       Case comEvDSR
       Case comEvRing
       Case comEvReceive

    'Debug.Assert False
    Receive = MSComm5.Input
    sR = ""
    For i = 0 To UBound(Receive)
        sR = sR & " " & CStr(Hex(Receive(i)))
    Next i
    
    Debug.Print "Lenth:" & UBound(Receive) + 1 & " " & sR & "x"
'    Text1.Text = ""
'    Text1.Text = sR
'    If (Receive(0) = &H86 And Receive(1) = &H0) Or (Receive(0) = &H87 And Receive(1) = &H12) Or (Receive(0) = &H3F And Receive(1) = &H12) Or (Receive(0) = 2 And Receive(1) = 16) Then

    If (Receive(0) = &H86 And Receive(1) = &H12) Or (Receive(0) = &H87 And Receive(1) = &H12) Or (Receive(0) = &H3F And Receive(1) = &H12) Or (Receive(0) = 2 And Receive(1) = 16) Then
      For i = 0 To 19 '泊位信号的起始时清零
         DockData(i) = -1
      Next i
    End If
    
      j = -1
      Do
         j = j + 1
      Loop Until DockData(j) < 0
    For i = 0 To UBound(Receive)
      DockData(j) = Receive(i)
      j = j + 1
      'If j = 19 Then Debug.Assert False
      If j > 19 Then Exit For
    Next i
      
    If j >= 19 Then
   If DockData(0) = 2 And DockData(1) = 16 Then
             iAddr = CInt(DockData(2))
                
                dblRate = DealFloat(CByte(DockData(3)), CByte(DockData(4)), CByte(DockData(5)), CByte(DockData(6)))
           bcResetTotal = DealFloat(CByte(DockData(7)), CByte(DockData(8)), CByte(DockData(9)), CByte(DockData(10)))
                bcTotal = DealFloat(CByte(DockData(11)), CByte(DockData(12)), CByte(DockData(13)), CByte(DockData(14)))
             bcSetPoint = DealFloat(CByte(DockData(15)), CByte(DockData(16)), CByte(DockData(17)), CByte(DockData(18)))
            
            Debug.Print "dblRate="; dblRate; " "; "ResetTotal="; bcResetTotal; " "; "bcTotal="; bcTotal; " "; "bcSetPoint="; bcSetPoint; " "; "bcPreSet="; bcPreSet; " "; "bcPreAct="; bcPreAct
            
             With frmTechs.Shop2(modAddr.LogicAddr(iAddr))
               .d计量 = bcResetTotal
               .d流量 = dblRate
               .d设定 = bcSetPoint
               .d累计 = bcTotal
             End With
             With frmTechs1
               .txtLJ(modAddr.LogicAddr(iAddr)).Text = Format(bcTotal, "#0.00")
               .txtSD(modAddr.LogicAddr(iAddr)).Text = Format(bcSetPoint, "#0.00")
               .txtJL(modAddr.LogicAddr(iAddr)).Text = Format(bcResetTotal, "#0.00")
            End With
'      ElseIf (DockData(0) = &H3F And DockData(1) = &H0) Then

  ElseIf (DockData(0) = &H3F And DockData(1) = &H12) Then
       #If dds = 0 Then
       DockData(18) = iDock '用最后的校验位鉴别2/3泊位，传送到调度室
       DockData(19) = &HFF
       #End If
       Dock = DockData(18)
'       frmComm3.ComStatus = DockData '传送到调度室
       ComStatus3 = DockData '3#泊位传送到调度室
       If Dock = 0 Then
       
         For i = 2 To UBound(DockData) - 2
           For j = 0 To 7
              NewStatus2((i - 2) * 8 + j) = Bit(DockData(i), j)
           Next j
         Next i
         
       ElseIf Dock = 1 Then
       
         For i = 2 To UBound(DockData) - 2
           For j = 0 To 7
              NewStatus3((i - 2) * 8 + j) = Bit(DockData(i), j)
           Next j
         Next i
       End If
   ElseIf (DockData(0) = &H86 And DockData(1) = &H12) Or (DockData(0) = &H87 And DockData(1) = &H12) Then
       #If dds = 0 Then
       DockData(18) = DockData(0) - &H86 'Dock '用最后的校验位鉴别2/3泊位，传送到调度室
       If DockData(18) < 0 Then Debug.Assert False
       DockData(19) = &HFF
       #End If
       Dock = DockData(18)
       frmComm3.ComStatus = DockData '传送到调度室
       If Dock = 0 Then
       
         For i = 2 To UBound(DockData) - 2
           For j = 0 To 7
              NewStatus2((i - 2) * 8 + j) = Bit(DockData(i), j)
           Next j
         Next i
         
       ElseIf Dock = 1 Then
       
         For i = 2 To UBound(DockData) - 2
           For j = 0 To 7
              NewStatus3((i - 2) * 8 + j) = Bit(DockData(i), j)
           Next j
         Next i
       End If
  End If
  End If 'j>=19
End Select
End Sub
Private Sub tmrCommStatus3_Timer()
         '修改的地方!!!!!!!!!!
            iDock = 1
'            Call Send8x02(iDock + &H86) '接受3#流程数据

End Sub

Private Sub tmrComm_Timer()
Static i As Integer
i = (i + 1) Mod 4

Select Case i
   Case 0, 3
      bComTechs = True
'      If Not IsEmpty(ComTechs) Then
'            #If dds = 0 Then
'
'               Call SendStatus(ComTechs)
'            #ElseIf dds = 1 Then
'                  Call SockSend(ComTechs)
'            #End If
'
'      End If
      
   Case 1
      bComTechs = False
      If Not IsEmpty(ComStatus) Then
   
            #If dds = 0 Then
               Call SendStatus(ComStatus)
            #ElseIf dds = 1 Then
                  Call SockSend(ComStatus)
            #End If
            
      End If
      DoEvents
      bComTechs = True
   Case 2
      bComTechs = False
      If Not IsEmpty(ComStatus3) Then
   
            #If dds = 0 Then
               Call SendStatus(ComStatus3)
            #ElseIf dds = 1 Then
'                  Call SockSend(ComStatus3)
            #End If
            
      End If
      DoEvents
      bComTechs = True
End Select
End Sub
Private Sub Send8x02(ByVal v2 As Integer)  'v2：2#泊位/3#泊位
Dim sd02(0) As Byte
sd02(0) = &H2
Dim sd(0) As Byte
sd(0) = v2
'sd(1) = &H2
'MSComm1.PortOpen = False
    With MSComm5
        .Settings = Settings_M 'M
        .InputLen = 0
        .OutBufferCount = 0
        .InBufferCount = 0
        .RThreshold = 17
        If .PortOpen = False Then .PortOpen = True
        .Output = sd '(0)
        Do
        Loop Until .OutBufferCount = 0
'            DoEvents

'        .Settings = Settings_S
'        If .PortOpen = False Then .PortOpen = True
'        .Output = sd02
    End With
    Call mePauseX
'    DoEvents
'    DoEvents
'    DoEvents
    DoEvents
    With MSComm5
        .Settings = Settings_S
        .InputLen = 0
        .OutBufferCount = 0
        .InBufferCount = 0
        .RThreshold = 17
        If .PortOpen = False Then .PortOpen = True
        .Output = sd02
        Do
        Loop Until .OutBufferCount = 0
    End With
''    Call mePauseX(0.5)
End Sub

Private Sub SendStatus(Status)
    'On Error Resume Next
    Dim oCom(0 To 19) As Byte
    Dim i As Integer
    For i = 0 To 19
      oCom(i) = Status(i)
    Next i
    
    With MSComm1
        .Settings = Settings_N
        .InputLen = 0
        .OutBufferCount = 0
        .InBufferCount = 0
        If .PortOpen = False Then .PortOpen = True
'     Status(19) = 0
'     Status(15) = 0
               .Output = oCom 'Status
        Do
        DoEvents
        Loop Until .OutBufferCount = 0
        
    End With
End Sub

Private Sub Form_Load()
Dim i As Integer
On Error GoTo err1
#If dds = 0 Then
   For i = 0 To 19
      DockData(i) = -1
   Next i
   MSComm5.CommPort = COMM_PORT3
   Call openComm(COMM_PORT2)
   tmrCommStatus3.Enabled = True
   On Error GoTo 0
#ElseIf dds = 1 Then
    Dim IPs() As String
    On Error GoTo err2
    CntClient = SetIni.GetSettingInt(Sc_IPs, "Count", 5)
    If CntClient >= 1 Then
      ReDim IPs(1 To CntClient) As String
      For i = 1 To CntClient
         IPs(i) = SetIni.GetSettingStr(Sc_IPs, "IP" & CStr(i), "")
         IPs(i) = Trim(IPs(i))
         If IPs(i) = "" Then
            IPs(i) = sckServer(0).LocalIP  '随便设置的无效IP
         End If
      Next i
      For i = 1 To CntClient
         Load sckServer(i)
         With sckServer(i)
            .RemoteHost = IPs(i)
            .RemotePort = 1010
            .LocalPort = 1010 + i
            .Bind
         End With
      Next i
    End If
    On Error GoTo 0
#End If

   tmrComm.Enabled = True

Exit Sub
err1:
   MsgBox "与调度室的通信没有打开！", vbExclamation
   Err.Clear
   Resume Next
err2:
   Call meErr("frmComm3:Form_Load", Err.Description)
   Err.Clear
   Resume Next
End Sub
Private Sub openComm(ByVal com As Long)
    With MSComm1
        .CommPort = com
        .RThreshold = 19
        .InBufferCount = 0
        .OutBufferCount = 0
        .InputMode = comInputModeBinary
        If .PortOpen = False Then .PortOpen = True
    End With
End Sub

Private Sub SockSend(Status)
   Dim i As Integer
   Dim sendBytes() As Byte
   ReDim sendBytes(0 To UBound(Status)) As Byte
   For i = 0 To UBound(Status)
    sendBytes(i) = Status(i)
    Next i
'   On Error Resume Next
   For i = 1 To CntClient
   sckServer(i).SendData sendBytes 'Status
   Next i
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

        On Error Resume Next
        If UnloadMode = vbFormControlMenu Then
           Cancel = 1
           Me.Hide
        Else
            Call CloseComm4
            Call CloseComm5
        End If

End Sub
Public Sub CloseComm4()
    On Error Resume Next
    tmrComm.Enabled = False
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
End Sub
Public Sub CloseComm5()
    On Error Resume Next
    tmrComm.Enabled = False
    If MSComm5.PortOpen = True Then
        MSComm5.PortOpen = False
    End If
End Sub