VERSION 5.00 Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" Begin VB.Form COMForm Caption = "Com Port" ClientHeight = 2130 ClientLeft = 60 ClientTop = 345 ClientWidth = 3360 LinkTopic = "Form1" ScaleHeight = 2130 ScaleWidth = 3360 StartUpPosition = 3 'Windows Default Begin VB.CommandButton AbortButton Caption = "Stop" Height = 375 Left = 2400 TabIndex = 3 Top = 120 Width = 735 End Begin VB.TextBox ReadBox Height = 1335 Left = 240 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 2 Top = 120 Width = 2055 End Begin VB.CommandButton SendButton Caption = "Send" Height = 375 Left = 2400 TabIndex = 1 Top = 1560 Width = 735 End Begin VB.TextBox DataEntry Height = 375 Left = 240 TabIndex = 0 Top = 1560 Width = 2055 End Begin MSCommLib.MSComm MSComm1 Left = 2400 Top = 720 _ExtentX = 1005 _ExtentY = 1005 _Version = 393216 DTREnable = 0 'False InputLen = 1 NullDiscard = -1 'True RThreshold = 1 RTSEnable = -1 'True End End Attribute VB_Name = "COMForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '============================================================================' ' Com port control for Cybernetic Micro System's CYxxx devices. ' this VB6 code requires Microsoft Comm Control 6 (MScomm32.ocx) ' ' CMS assumes no responsibility for third party use ' of this sample segment of code. This code segment is ' intended merely as a starting point for code development. ' This code may contain flaws in it's current state. ' Please report code errors to info@Controlchips.com ' 09Feb2002 '============================================================================' Dim AbortFlag ' trigger on a key or provide a command button to ' abort com transfers to avoid "hanging" the port Dim NL As String ' this will be CarriageReturn/Linefeed '============================================================================' Private Sub Form_Load() '============================================================================' NL = Chr$(13) + Chr$(10) End Sub '============================================================================' Private Sub AbortButton_Click() '============================================================================' AbortFlag = True ' use this to stop a Com transfer if the hardware hangs. End Sub '============================================================================' Private Sub SendButton_Click() '============================================================================' AbortFlag = False SendString = DataEntry.Text + Chr$(13) ' This is where one would decide to add or subtract ' a carriage return or line feed. ' Since commands to CYxxx chips are uppercase, the ' string could be set to UCASE$(DataEntry.Text) ' The entire data string could be sent out the com port, ' but we are parsing to send one character at a time, ' which helps slow things down when no CTS is available. If Len(SendString) > 0 Then For i = 1 To Len(SendString) SendChar$ = Mid$(SendString, i, 1) Call WriteComPort(SendChar$) DoEvents 'this would allow abort code to interrupt. Next i End If DataEntry.Text = "" ' clear text box for next send string. DataEntry.SetFocus ' put the cursor back in the data entry field ' for typing convenience. ' If a record of the sent data is desired, then ' SendString could also be displayed and scrolled in ' another text window, similar the ReadBox window. End Sub '============================================================================' Private Sub OpenCom() '============================================================================' If MSComm1.PortOpen = False Then ' open the com port if it is not already open. '--Set COM# MSComm1.CommPort = 1 '--set baud rate, no parity, 8 data, and 1 stop bit. MSComm1.Settings = "9600,N,8,1" ' default settings '--the handshaking is turned off here, but many CYxx chips ' will use the CTS signal. The RTS line is not used by CYxxx ' chips, but it is part of the handshaking pair CTS/RTS. ' To use CTS, the MSComm1.RTSenable property must be set True. MSComm1.Handshaking = 0 '=no handshaking, or select from list: '0=ComNone '1=ComXOnXoff '2=ComRTS/CTS (use with RTSenable=true) '3=ComRTSXonXoff On Error Resume Next '--Open the port. MSComm1.PortOpen = True If Err Then Msg$ = "Can Not Open COM" + Str$(MSComm1.CommPort) + "." If Err = 8005 Then Msg$ = Msg$ + NL + "Another App is using it." ElseIf Err = 8002 Then Msg$ = Msg$ + NL + "Port does Not Exist." Else ErrNumber$ = Str$(Err) End If MsgBox Msg$, vbExclamation, "Com Error" + ErrNumber$ AbortFlag = True Exit Sub End If End If End Sub '============================================================================' Private Sub MSComm1_OnComm() '============================================================================' ' Handle each event or error by placing ' code below each CASE statement. ' This application will only use the Receive event ' which has been set in the Control property to interrupt ' when the RcvBuf gets one character. Select Case MSComm1.CommEvent ' Errors Case comEventBreak ' A Break was received. Case comEventCDTO ' CD (RLSD) Timeout. Case comEventCTSTO ' CTS Timeout. Case comEventDSRTO ' DSR Timeout. Case comEventFrame ' Framing Error Case comEventOverrun ' Data Lost. Case comEventRxOver ' Receive buffer overflow. If MSComm1.PortOpen = True Then MSComm1.PortOpen = False ' If the receive buffer is overflowing, then ' close port and clear buffer to prevent a ' continuous stream of data from freezing Windows. ' Increase the MSComm1.InBufferSize if long data is expected. Msg$ = "" Call UpdateReadBox(Msg$) DoEvents Case comEventRxParity ' Parity Error. Case comEventTxFull ' Transmit buffer full. Case comEventDCB ' Unexpected error retrieving DCB] ' Events Case comEvCD ' Change in the CD line. Case comEvCTS ' Change in the CTS line. Case comEvDSR ' Change in the DSR line. Case comEvRing ' Change in the Ring Indicator. Case comEvSend ' There are SThreshold number of ' characters in the transmit buffer. Case comEvEOF ' An EOF character was found in the input stream Case comEvReceive ' Received RThreshold # of chars. Call ReadComPort ' call the procedure to handle incoming COM data. End Select End Sub '============================================================================' Public Sub WriteComPort(SendData As String) '============================================================================' '--Open the com port if it is closed. If MSComm1.PortOpen = False Then Call OpenCom '--If the com port was not properly opened, then exit this sub. If MSComm1.PortOpen = False Then Exit Sub MSComm1.Tag = "BUSY" ' use this tag in your code to test the ' state of the com port before shutting down ' or before sending more data. DoEvents If AbortFlag = True Then GoTo ExitCom '--Place the data in the Com output/send buffer. Dim Buffer As Variant Buffer = SendData If MSComm1.PortOpen = True Then ' test here because DoEvents lets the ' receive buffer fail and close the comport ' in the OnComm event handler. MSComm1.Output = Buffer Else ' report an error. End If While MSComm1.OutBufferCount > 0 ' Loop through DoEvents while waiting for ' the send buffer to empty. Because we send only ' one character at a time, this is superfluous, but ' would be needed if long strings are sent instead. If AbortFlag = True Then GoTo ExitCom DoEvents Wend ExitCom: MSComm1.Tag = "" ' not busy. ' If other apps need to share the port, and we are not ' expecting input from the port, then we can close Com ' here with MSComm1.PortOpen = False. The test at the ' beginning of each send operation will reopen it. End Sub '============================================================================' Private Sub ReadComPort() '============================================================================' ' The OnComm event will notify us of incoming data in the Comm ' InBuffer. The Rthreshold has been set to one, to be notified ' when any byte arrives in the buffer. ' ' InBufLen could be set to zero, to read all bytes arriving in the ' buffer, but this example will set the control's InBufLen property ' to read just one byte at a time. We will then analyze each byte ' and concatenate until a Carriage return (13) is detected. Dim InString As String InString = MSComm1.Input ' The Receive window expects ASCII characters, as does the ' MSComm1.InputMode. ' Binary data would be handled differently. ' Clear the Receive window at the start of each new line. ' Update the window by concatenating the received bytes. If InString < Chr$(32) Then ' then a ctrl-char ' or a line terminator. If InString = "" Then ' null causes a problem with Ltrim if one sneaks ' past the built in NullDiscard of MSComm1 due to ' a buffer overflow or other error. NewChar = "<0>" Else NewChar = "<" + LTrim$(Str$(Asc(InString))) + ">" End If Msg$ = NewChar If InString = Chr$(13) Then Msg$ = Msg$ + NL ' we have decided to treat a carriage return as a new line. Call UpdateReadBox(Msg$) ElseIf InString >= Chr$(128) And InString < Chr$(160) Then ' more non-printable characters. NewChar = "<" + LTrim$(Str$(Asc(InString))) + ">" Msg$ = NewChar Call UpdateReadBox(Msg$) Else ' else a printable char. Msg$ = InString Call UpdateReadBox(Msg$) End If End Sub '============================================================================' Private Sub UpdateReadBox(Msg$) '============================================================================' ReadBox.Text = ReadBox.Text + Msg$ End Sub