fsockclient.frm

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

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form fClient 
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   285
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   465
      Left            =   240
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   120
      Width           =   4425
   End
   Begin MSWinsockLib.Winsock SckClient 
      Left            =   540
      Top             =   570
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
End
Attribute VB_Name = "fClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Const Sc_IPs As String = "IP地址"
Dim CntClient As Integer ' = 5 '调度室客户端数
Dim iDock As Integer
Dim DockData(0 To 19) As Integer

Private Sub Form_Load()
Dim i As Integer
For i = 0 To 19
   DockData(i) = -1
Next i
    Dim IPs() As String
    On Error GoTo err2
    CntClient = SetIni.GetSettingInt(Sc_IPs, "Count", 5)
    If CntClient >= 1 Then
      ReDim IPs(0 To CntClient) As String
         IPs(0) = SetIni.GetSettingStr(Sc_IPs, "IP" & CStr(0), SckClient.LocalIP)
      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) = SckClient.LocalIP  '随便设置的无效IP
         End If
         If IPs(i) = SckClient.LocalIP Then
            SckClient.RemotePort = 1010 + i
         End If
      Next i
      With SckClient
         .RemoteHost = IPs(0)
      '   .RemotePort = 1010 + i
         .LocalPort = 1010
         .Bind
      End With
    End If
    On Error GoTo 0
    Exit Sub
err2:
   Call meErr("fClient:Form_Load", Err.Description)
   Err.Clear
   Resume Next

End Sub
Private Sub SckClient_DataArrival(ByVal bytesTotal As Long)
   
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 MSComm1.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 = MSComm1.Input
      SckClient.GetData Receive
    sR = ""
    For i = 0 To UBound(Receive)
        sR = sR & " " & CStr(Hex(Receive(i)))
    Next i
    
    Debug.Print "SckClient: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
        
'        frmComm3.ComTechs = DockData
            
            
             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 '传送到调度室/其他电脑(winsock)
       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