Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Type PumpStringDef
    high As String
    low As String
    default As String
End Type
 
Type PumpDef
    Busy As Boolean
    On As Boolean
    ID As Integer
    SendString As String
    LastSync As Long
    MaxSyncTime As Long
    Port As Object
    TimeOut As Single
    Buffer As String
    Error As Long
    ErrDescription As String
    Pressure As Long
End Type
 
Public Event Error(Value As Long)
Public Event Pressure(Pressure As Long)
Public Event Fault(DiffTime As Long)
....
 
Private WithEvents ePumpTimer As Timer
 
Private Sub Class_Initialize()
    Set Pump.Port = PumpForm.RS232Pump
    Set ePumpTimer = PumpForm.PumpTimer
    Pump.MaxSyncTime = 12000
    SyncString = "0310ED;"
    StartString.high = "061180006009;"
    StartString.low = "061180002049;"
 ...
End Sub
 
Public Function PumpActivate(Port As Integer) As Boolean
    Pump.Port.Settings = "9600,n,8,1"
    Pump.Port.CommPort = Port
    Pump.Port.Handshaking = 0
    Pump.Port.PortOpen = True
    PumpActivate = True
End Function
 
Public Function PumpDeActivate() As Boolean
    Pump.Port.PortOpen = False    
    PumpDeActivate = True
End Function
 
Public Function PumpAction(Action As String, Optional TimeOut As Long = 1000) _
  As Boolean
    Pump.TimeOut = TimeOut
    Select Case Action
        Case "PumpOn"
            PumpAction = SendPump("Start")
        Case "PumpOff"
            PumpAction = SendPump("Stop")
 ...
 
   End Select
 End Function
 
Private Sub ePumpTimer_Timer()
Dim Flag As Boolean
    Flag = SendPump("Sync")
End Sub
 
Private Function SendPump(Action As String) As Boolean
    Dim StartSendPump As Long
    If Pump.Busy Then
        SendPump = False
        Exit Function
    End If
    Pump.Busy = True
    If ((GetTickCount - Pump.LastSync) > Pump.MaxSyncTime) _
        And (Action <> "Start") Then RaiseEvent Fault(GetTickCount - _
        Pump.LastSync - Pump.MaxSyncTime)
 
    Select Case Action
        Case "Sync"
        Case "Start"
            mSync = True
            Pump.On = True
            StartString.default = StartString.low
            StopString.default = StopString.low
            Pump.SendString = StartString.default
        Case "Stop"
            mSync = False
            Pump.On = False
            Pump.SendString = StopString.default
            StartString.default = StartString.low
            StopString.default = StopString.low
        Case "High"
            StartString.default = StartString.high
            StopString.default = StopString.high
            Pump.SendString = StartString.default
        Case "Low"
            StartString.default = StartString.low
            StopString.default = StopString.low
            Pump.SendString = StartString.default
        Case "Pressure"
        Case Else
            SendPump = False
            Pump.Busy = False
            Exit Function
    End Select
    Pump.Buffer = ""
    Pump.Port.Output = "!Q" & Pump.SendString
    While InStr(1, Pump.Buffer, ".") = 0 And Pump.Error = 0
        If Pump.Port.InBufferCount Then
            Pump.Port.InputLen = 0
            Pump.Buffer = Pump.Buffer & Pump.Port.Input
        End If
        Pump.Error = IIf((GetTickCount - StartSendPump) > Pump.TimeOut, 101, 0)
        DoEvents
    Wend
    If (Pump.Error <> 0) Then GoTo PumpErrorHandling
    Pump.Pressure = Val("&H" + Mid$(Pump.Buffer, 7, 2)) * 2
    Pump.Buffer = ""
    StartSendPump = GetTickCount
    Pump.Port.Output = "!Q" & SyncString
    While InStr(1, Pump.Buffer, ".") = 0 And Pump.Error = 0
        If Pump.Port.InBufferCount Then
            Pump.Port.InputLen = 0
            Pump.Buffer = Pump.Buffer & Pump.Port.Input
        End If
        Pump.Error = IIf((GetTickCount - StartSendPump) > Pump.TimeOut, 201, 0)
        DoEvents
    Wend
    If (Pump.Error <> 0) Then GoTo PumpErrorHandling
    Pump.LastSync = GetTickCount
    If Action = "Pressure" Then RaiseEvent Pressure(Pump.Pressure)
    Pump.Busy = False
    ePumpTimer.Enabled = mSync
    SendPump = True
    Exit Function
 
PumpErrorHandling:
    SendPump = False
    Pump.Busy = False
    RaiseEvent Error(Pump.Error)
    ePumpTimer.Enabled = mSync
    Pump.Error = 0
End Function
 
Private Sub Class_Terminate()
    If Not (ePumpTimer Is Nothing) Then
        ePumpTimer.Enabled = False
    End If
    Set ePumpTimer = Nothing
    Set Pump.Port = Nothing
    Unload PumpForm
End Sub