frmcomtotcp.frm

监控类的开发

    
  txtHex.Text = ""
  txtChars.Text = ""
  txtResult.Text = ""
  ResultString = ""
End Sub

Public Sub cmdClose_Click()
  If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
  End If
    
  Dim Settings As String
  Settings = MSComm1.Settings
  ResultString = ResultString + GetTimeStamp(0) + "Serial port settings: " + _
            "COM" + Trim(Str(MSComm1.CommPort)) + "; " + Settings + "; " + _
            IIf(MSComm1.PortOpen = True, "Open", "Close")
    
  Call DisplayString(txtResult, ResultString)
End Sub

Private Sub cmdConnect_Click()
  With tcpSock
    .Close
    .Protocol = sckTCPProtocol
    .LocalPort = nLocalPort
    .RemoteHost = strRemoteHost
    .RemotePort = nRemotePort
    
    If nWorkMode = 0 Then
      .Connect
    Else
      .Listen
    End If
  End With
End Sub

Private Sub cmdFind_Click()
  Dim strTemp As String
  Dim nTemp, nCursor As Integer
  On Error Resume Next
    
  If txtResult.Text = "" Then
    MsgBox "There is no content in txtResult!", vbExclamation + vbOKOnly
    Exit Sub
  End If
    
  If txtResult.SelText <> "" Then
    txtHex.Text = txtResult.SelText
  End If
  strTemp = Trim(txtHex.Text)
    
  If strTemp = "" Then
    MsgBox "You must input some characters in Hex Box!", vbExclamation + vbOKOnly
    Exit Sub
  End If
    
  txtResult.SetFocus
  nCursor = txtResult.SelStart + 2
  nTemp = InStr(nCursor, txtResult.Text, strTemp)
  If nTemp = 0 Then
    txtResult.SelStart = Len(txtResult.Text)
    MsgBox "Cannot find 【" + strTemp + "】!", vbExclamation + vbOKOnly
    Exit Sub
  Else
    nTemp = nTemp - 1
    txtResult.SelStart = nTemp
  End If
End Sub

Private Sub cmdNetClose_Click()
  tcpSock.Close
End Sub

Private Sub Form_Load()
  Dim CommPort As String
  Dim Handshaking As String
  Dim Settings As String
  On Error Resume Next
  
  txtResult.ForeColor = vbBlue
  App.Title = "Serial Port to TCP Port"
    
  Settings = GetSetting(App.Title, "Properties", "Settings", "")
  nLocalPort = Val(GetSetting(App.Title, "Properties", "LocalPort", ""))
  nRemotePort = Val(GetSetting(App.Title, "Properties", "RemotePort", ""))
  strRemoteHost = GetSetting(App.Title, "Properties", "RemoteHost", "")
  nWorkMode = Val(GetSetting(App.Title, "Properties", "WorkMode", ""))
  nDisplayMode = Val(GetSetting(App.Title, "Properties", "DisplayMode", ""))
  
  If Settings <> "" Then
    MSComm1.Settings = Settings
    If Err Then
      MsgBox Error$, vbExclamation + vbOKOnly
      Exit Sub
    End If
  End If
    
  CommPort = GetSetting(App.Title, "Properties", "CommPort", "")
  If CommPort <> "" Then MSComm1.CommPort = CommPort
   
  Handshaking = GetSetting(App.Title, "Properties", "Handshaking", "")
  If Handshaking <> "" Then
    MSComm1.Handshaking = Handshaking
    If Err Then
      MsgBox Error$, vbExclamation + vbOKOnly
      Exit Sub
    End If
  End If
  
  If nWorkMode = 0 Then
    cmdConnect.Caption = "Connect"
  Else
    cmdConnect.Caption = "Listen"
  End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    StatusTimer.Enabled = False
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    tcpSock.Close
End Sub

Private Sub MSComm1_OnComm()
    On Error Resume Next
      
    Select Case MSComm1.CommEvent
        'Events
        Case comEvReceive
            Dim vInBuffer As Variant
            vInBuffer = MSComm1.Input
            strRecHex = VariantToHexChars(vInBuffer)
            txtHex.Text = strRecHex
            txtChars.Text = HexCharsToString(strRecHex)
                  
            If tcpSock.State <> 7 Then
                MsgBox "TCP connection is closed!", vbExclamation + vbOKOnly
                Exit Sub
            End If
            tcpSock.SendData vInBuffer
            
            If nDisplayMode = 0 Then
                ResultString = ResultString + GetTimeStamp(0) + "<[COM]" + _
                                HexCharsToString(strRecHex)
                ResultString = ResultString + GetTimeStamp(0) + "[TCP]>" + _
                                HexCharsToString(strRecHex)
            Else
                ResultString = ResultString + GetTimeStamp(0) + "<[COM]" + strRecHex
                ResultString = ResultString + GetTimeStamp(0) + "[TCP]>" + strRecHex
            End If
                
        Case comEvSend
                
        Case comEvCTS
            ResultString = ResultString + GetTimeStamp(0) + ":Change in the CTS line."
        Case comEvDSR
            ResultString = ResultString + GetTimeStamp(0) + ":Change in the DSR line."
                
        Case comEvCD
            ResultString = ResultString + "TickCount: " + Trim(Str(GetTickCount())) + _
                            "," + " Change in the CD line." + Chr(&HD) + Chr(&HA)
                
        Case comEvRing
            ResultString = ResultString + GetTimeStamp(0) + _
                            ":Change in the Ring Indicator."
                
        ' Errors
        Case comEventBreak
            ResultString = ResultString + GetTimeStamp(0) + ":A Break was received."
        Case comEventCDTO
            ResultString = ResultString + GetTimeStamp(0) + ":CD (RLSD) Timeout."
        Case comEventCTSTO
            ResultString = ResultString + GetTimeStamp(0) + ":CTS Timeout."
        Case comEventDSRTO
            ResultString = ResultString + GetTimeStamp(0) + ":DSR Timeout."
        Case comEventFrame
            ResultString = ResultString + GetTimeStamp(0) + ":Framing Error."
        Case comEventOverrun
            ResultString = ResultString + GetTimeStamp(0) + ":Data Lost."
        Case comEventRxOver
            ResultString = ResultString + GetTimeStamp(0) + ":Receive buffer overflow."
        Case comEventRxParity
            ResultString = ResultString + GetTimeStamp(0) + ":Parity Error."
        Case comEventTxFull
            ResultString = ResultString + GetTimeStamp(0) + ":Transmit buffer full."
        Case comEventDCB
            ResultString = ResultString + GetTimeStamp(0) + _
                            ":Unexpected error retrieving DCB."
    End Select
          
    Call DisplayString(txtResult, ResultString)
End Sub

Public Sub cmdOpen_Click()
  Dim Settings As String
  On Error Resume Next
    
  Settings = MSComm1.Settings
  If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
  
  ResultString = ResultString + GetTimeStamp(0) + "Serial port settings: " + _
            "COM" + Trim(Str(MSComm1.CommPort)) + "; " + Settings + "; " + _
            IIf(MSComm1.PortOpen = True, "Open", "Close")
    
  Call DisplayString(txtResult, ResultString)
End Sub

Private Sub cmdSetup_Click()
  Load frmSetup
  frmSetup.Show vbModal
End Sub

Private Sub StatusTimer_Timer()
  Call setStatusBar(tcpSock)
  
  With tcpSock
    If nWorkMode = 1 Then
        If .State <> sckConnected And .State <> sckListening Then
            .Close
            .LocalPort = nLocalPort
            .Listen
        End If
    End If
  End With
End Sub

Private Sub tcpSock_Close()
  On Error Resume Next
    
  ResultString = ResultString + GetTimeStamp(0) + "[Host]: Close"
  Call DisplayString(txtResult, ResultString)
End Sub

Private Sub tcpSock_Connect()
  On Error Resume Next
    
  ResultString = ResultString + GetTimeStamp(0) + "[Host]: Connected"
  Call DisplayString(txtResult, ResultString)
End Sub

Private Sub tcpSock_ConnectionRequest(ByVal requestID As Long)
    On Error Resume Next
    
    With tcpSock
      If .State <> sckClosed Then .Close
      .Accept requestID
    End With
    ResultString = ResultString + GetTimeStamp(0) + "[Host]: Connected"
    Call DisplayString(txtResult, ResultString)
End Sub

Private Sub tcpSock_DataArrival(ByVal bytesTotal As Long)
    Dim strTmp As String
    Dim strInfo As String
    Dim vInfo As Variant
    On Error Resume Next
    
    strTmp = GetTimeStamp(0)
    
    If MSComm1.PortOpen = False Then
        MsgBox "Com Port is closed!", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    If nDisplayMode = 0 Then
        tcpSock.GetData strInfo
        txtChars.Text = strInfo
        txtHex.Text = StringToHexChars(strInfo)
        ResultString = ResultString + strTmp + "<[TCP]" + strInfo
        
        MSComm1.Output = strInfo
        strTmp = GetTimeStamp(0)
        ResultString = ResultString + strTmp + "[COM]>" + strInfo
    Else
        tcpSock.GetData vInfo
        txtHex.Text = VariantToHexChars(vInfo)
        txtChars.Text = HexCharsToString(txtHex.Text)
        ResultString = ResultString + strTmp + "<[TCP]" + txtHex.Text
        
        MSComm1.Output = vInfo
        strTmp = GetTimeStamp(0)
        ResultString = ResultString + strTmp + "[COM]>" + txtHex.Text
    End If
    
    Call DisplayString(txtResult, ResultString)
End Sub

Private Sub txtResult_KeyDown(KeyCode As Integer, Shift As Integer)
  '114 for 【F3】
  If KeyCode = 114 And txtHex.Text <> "" Then Call cmdFind_Click

  If KeyCode = 65 And Shift = 2 Then
    txtResult.SelStart = 0
    txtResult.SelLength = Len(txtResult.Text)
  End If
End Sub