frmmain.frm

这是一本学习串口编程喝计算机监控的好书里面是用VB开发的源代码

      Height          =   255
      Index           =   0
      Left            =   2040
      Picture         =   "frmMain.frx":06D6
      Top             =   6120
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Image imgCar 
      Height          =   255
      Index           =   2
      Left            =   2280
      Picture         =   "frmMain.frx":0C68
      Top             =   3120
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Image imgCar 
      Height          =   255
      Index           =   3
      Left            =   0
      Picture         =   "frmMain.frx":11FA
      Top             =   5040
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Image imgCar 
      Height          =   255
      Index           =   1
      Left            =   5640
      Picture         =   "frmMain.frx":178C
      Top             =   5280
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.Image Image1 
      Height          =   3585
      Left            =   0
      Picture         =   "frmMain.frx":1D1E
      Top             =   2880
      Width           =   6360
   End
   Begin VB.Label Label15 
      Alignment       =   2  'Center
      Caption         =   "Power"
      Height          =   255
      Left            =   2640
      TabIndex        =   1
      Top             =   2400
      Width           =   615
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Sub initialPRJ()
  strRecHex = ""
  TimerCommStartMark = False
  timerComm.Enabled = False
End Sub

Private Sub DisplayCmd()
    If GetWinSockState(tcpWinsock) <> "Connected" Or _
                        (nWorkMode = MODE_AUTO) Then
        cmdLampOn.Enabled = False
        cmdLampOff.Enabled = False
        cmdRingOn.Enabled = False
        cmdRingOff.Enabled = False
        cmdInq.Enabled = False
    Else
        cmdLampOn.Enabled = True
        cmdLampOff.Enabled = True
        cmdRingOn.Enabled = True
        cmdRingOff.Enabled = True
        cmdInq.Enabled = True
    End If
End Sub

Public Sub SetTcpStatus()
    If tcpWinsock.State <> 7 Then
        imgNotConnected.ZOrder
        timerIn.Enabled = False
    Else
        imgConnected.ZOrder
        If nWorkMode = MODE_AUTO Then timerIn.Enabled = True
    End If
    
    DisplayCmd
    StatusBar1.Panels("TcpStatus").Text = "Status: " + RemoteHost + ":" + _
                      ts(RemotePort) + " / " + GetWinSockState(tcpWinsock)
    StatusBar1.Panels("Address").Text = "ADD: " + strADDress
    StatusBar1.Panels("tInterval").Text = "Interval: " + _
                                    Trim(Str(timerIn.Interval) \ 1000) + "S"
End Sub

Private Sub cmdClose_Click()
  tcpWinsock.Close
  timerComm.Enabled = False
  timerIn.Enabled = False
  Unload Me
End Sub

Private Sub DisplayStatus(bData As Byte)
    Dim I As Integer
    Dim bInput As Byte
    Dim bOut As Byte
    Dim bSend As Boolean
    Dim bControl As Byte
    
    bInput = bData And &HF
    bOut = bData And &H30
    
    For I = 0 To 3
      If (bData And (2 ^ I)) <> 0 Then
        imgCar(I).Visible = True
      Else
        imgCar(I).Visible = False
      End If
    Next I
    
    If (bData And (2 ^ 4)) <> 0 Then
      optRing(0).Value = True
    Else
      optRing(1).Value = True
    End If
    
    If (bData And (2 ^ 5)) <> 0 Then
      optLamp(0).Value = True
    Else
      optLamp(1).Value = True
    End If
    
    If nWorkMode = MODE_AUTO Then
        Select Case bInput
            Case 0
                If bOut <> 0 Then
                    bControl = 0
                    bSend = True
                End If
            Case 1, 2, 4
                If bOut <> &H20 Then
                    bControl = &H20
                    bSend = True
                End If
            Case 8
                If bOut <> &H30 Then
                    bControl = &H30
                    bSend = True
                End If
        End Select
        
        If bSend = True Then
            tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bControl), nBlockParity, nEndMark))
        End If
    End If
End Sub

Private Sub cmdInq_Click()
  Dim strTmp As String
  strTmp = EOT + strADDress + RD
  tcpWinsock.SendData HexCharsToVariant(GetFullPackage(strTmp, nBlockParity, nEndMark))
End Sub

Private Sub cmdLampOff_Click()
  Dim bTmp As Byte
  
  bTmp = bStatus And &HDF
  tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
  
  DelayTime 100
End Sub

Private Sub cmdLampOn_Click()
  Dim bTmp As Byte
  
  bTmp = bStatus Or &H20
  tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
  
  DelayTime 100
End Sub

Private Sub cmdRingOff_Click()
  Dim bTmp As Byte
  
  bTmp = bStatus And &HEF
  tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
  
  DelayTime 100
End Sub

Private Sub cmdRingOn_Click()
  Dim bTmp As Byte
  
  bTmp = bStatus Or &H10
  tcpWinsock.SendData HexCharsToVariant(GetFullPackage(EOT + strADDress + WD + ByteToTwoHexChars(bTmp), nBlockParity, nEndMark))
  
  DelayTime 100
End Sub

Private Sub cmdSetup_Click()
  frmSetup.Show vbModal
End Sub

Private Sub Form_Load()
    On Error Resume Next
      
    SetWindowPos frmMain.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    
    Call initialPRJ
  
    With tcpWinsock
        .RemoteHost = GetSetting(App.Title, "Properties", "RemoteHost", "")
        .RemotePort = GetSetting(App.Title, "Properties", "RemotePort", "")
        RemoteHost = .RemoteHost
        RemotePort = .RemotePort
    End With
  
    nEndMark = Val(GetSetting(App.Title, "Properties", "EndMark", ""))
    nBlockParity = Val(GetSetting(App.Title, "Properties", "BlockParity", ""))
    
    timerIn.Interval = Val(GetSetting(App.Title, "Properties", "lInterval", "")) * 1000
    strADDress = GetSetting(App.Title, "Properties", "ADDress", "")
End Sub

Private Sub imgConnected_Click()
    tcpWinsock.Close
    bStatus = 0
    DisplayStatus bStatus
End Sub

Private Sub imgNotConnected_Click()
    If bSwitch = False Then
        MsgBox "Please setup at first!", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    With tcpWinsock
        .Close
        .Protocol = sckTCPProtocol
        .Connect
    End With
    
    If Err.Number <> 0 Then MsgBox Error$, vbCritical + vbOKOnly
    
    bStatus = 0  'reset status
End Sub

Private Sub optMode_Click(Index As Integer)
  If Index = 0 Then
    nWorkMode = MODE_AUTO
  Else
    nWorkMode = MODE_MANUAL
    timerIn.Enabled = False
  End If
  
  DisplayCmd
End Sub

Private Sub tcpWinsock_DataArrival(ByVal bytesTotal As Long)
    Dim vInBuffer As Variant
    On Error Resume Next
    
    If TimerCommStartMark = False Then
        Call initialPRJ  'This is the first package
        TimerCommStartMark = True
    End If
      
    tcpWinsock.GetData vInBuffer
    strRecHex = strRecHex + VariantToHexChars(vInBuffer)
                
    'There is another package, so reset the commTimer.
    If TimerCommStartMark = True Then
        timerComm.Enabled = False
        timerComm.Enabled = True
    End If
End Sub

Private Sub timerComm_Timer()
    Dim strTmp As String
    On Error Resume Next
    
    timerComm.Enabled = False
    TimerCommStartMark = False
         
    If CheckPackage(strRecHex, nBlockParity, nEndMark) = False Then Exit Sub
    If Not (Mid(strRecHex, 1, 2) = STX And Mid(strRecHex, 3, 2) = _
                                    strADDress) Then Exit Sub
    If Len(strRecHex) / 2 <> nReplyLen Then Exit Sub
    
    strTmp = Mid(strRecHex, 5, 2)
    bStatus = TwoHexCharsToByte(strTmp)
    DisplayStatus bStatus
End Sub

Private Sub timerIn_Timer()
    Dim strTmp As String
    
    If tcpWinsock.State <> 7 Then Exit Sub
    
    strTmp = EOT + strADDress + RD
    tcpWinsock.SendData HexCharsToVariant(GetFullPackage(strTmp, nBlockParity, nEndMark))
End Sub

Private Sub timerStatus_Timer()
    SetTcpStatus
End Sub