vbrs232io.bas

Tektronix TDS3000&TDS3000B series oscilloscope program examples ver3.0

Attribute VB_Name = "VBRS232"
'
'  rs232io.bas - collection of input/output routines to be used by the
'                example programs
'
Option Explicit

Public ATimeoutOccurred As Boolean

Public Declare Function GetTickCount Lib "kernel32" () As Long

'
'  RS232READ - reads strings and binary and ASCII blocks into a string from
'  RS-232.  For strings, reads until CR or LF terminator is seen.  If a block
'  is detected, the length of block is read and a terminator is scanned for.
'  CR/LF and LF/CR are not valid terminators.
'
Sub RS232Read(commCtrl As MSComm, stringVar As String)
    Dim lengthToRead As Integer     ' always 1 for strings
    Dim timeoutMilliSec As Integer  ' Timeout value in milliseconds
    Dim BIN As Integer
    Dim blockState As Integer       ' Boolean value:
                                    '       0 = read string, 1 = read block
    Dim startTime As Long           ' When timeout interval started.
    Dim messageString               ' The raw input from the scope.
    Dim ch As String                ' lengthToRead characters from messageString
    Dim lengthRead As Integer       ' Number of bytes read into 'ch'
    Dim doEventsValue As Integer
    Dim nzdig As Integer            ' Number of digits in block length.
    Dim blockSize As Integer        ' Number of bytes in block.
    
    'Count = 0
    stringVar = ""             ' clear string
    messageString = ""         ' Clear the buffer we read into.
    lengthToRead = 1
    timeoutMilliSec = 5000     ' set timeout for first byte for 5 sec
    ATimeoutOccurred = False
    
    'Block status variables
    BIN = 0
    blockState% = 0
    
    Do
        ' Wait for a character or the timeout interval to expire.
        Do While 1
            doEventsValue = DoEvents()
            If commCtrl.CommEvent = comEvReceive Then
                messageString = messageString + commCtrl.Input
                If Len(messageString) >= lengthToRead Then
                    ch = Left(messageString, lengthToRead)
                    lengthRead = Len(ch)
                    messageString = Mid(messageString, lengthToRead + 1, Len(messageString))
                    Exit Do
                End If
            End If
        Loop
    
        timeoutMilliSec = 1000     ' Reset timeout to 1 sec for remaining bytes.
        '
        '  Blocks are formatted as #<x><yyy><data><newline> where
        '       <x> is the number of y bytes; for example if yyy = 500, then
        '              x = 3
        '       <yyy> is the number of bytes to transfer including checksum;
        '              if width is 1 then all bytes on bus are single data
        '              points; if width is 2 then bytes on bus are
        '              2-byte pairs; this program uses width of 1
        '       <data> is the curve data
        '       <newline> is a single byte newline character at the end of
        '              the data
        '
        '  State machine for interpreting binary and ASCII blocks:
        '
        '   blockState%
        '        0        Initial state; remains in this state until # char
        '                    is received.
        '        1        Read <x>
        '        2        Read <yyy>
        '        3        Read length of block
        '        4        Scan for a CR or LF terminator then exit subroutine
        '
        If (BIN%) Then
            Select Case blockState%
                Case 1
                    If ((ch$ >= "1") And (ch$ <= "9")) Then
                        blockState% = 2
                        nzdig% = Val(ch$)
                        blockSize% = 0
                    Else
                        blockState% = 0
                        BIN% = 0
                    End If
                Case 2
                    If ((ch$ >= "0") And (ch$ <= "9")) Then
                        blockSize% = (blockSize% * 10) + Val(ch$)
                        nzdig% = nzdig% - 1
                        If (nzdig% = 0) Then
                            lengthToRead% = blockSize%        ' includes
                            lengthToRead% = lengthToRead% + 1 ' the terminator
                            blockState% = 4
                        End If
                    Else
                        blockState% = 0
                        BIN% = 0
                    End If
                Case 3
                    lengthToRead% = lengthToRead% - lengthRead%
                    If (lengthToRead% = 0) Then
                        blockState% = 4
                        lengthToRead% = 1   'scan for terminator
                    End If
                        stringVar$ = stringVar$ + ch$
                Case 4
                    If ((Right$(ch$, 1) = Chr$(10)) Or (Right$(ch$, 1) = Chr$(13))) Then
                        stringVar$ = Left(ch$, Len(ch$) - 1)
                        Exit Do
                    End If
            End Select
        Else
            Select Case ch$
                Case Chr$(10), Chr$(13)         'scan for terminator
                    Exit Do
                Case "#"                        'block detected
                    If (blockState% = 0) Then
                        BIN% = 1
                        blockState% = 1
                    End If
                Case Else
                    stringVar$ = stringVar$ + ch$
            End Select
        End If
    Loop
End Sub


'
'  RS232WRITE - send the contents of the string to the device and wait
'  for the write to finish.
'
Sub RS232WRITE(commCtrl As MSComm, stringVar As String)
    Dim startTime As Long
    Dim doEventsValue As Integer
    
    commCtrl.Output = stringVar
    commCtrl.Output = Chr$(13)
    ATimeoutOccurred = False
       
    startTime = GetTickCount()
    While (GetTickCount() - startTime < 5000) And commCtrl.OutBufferCount > 0
        doEventsValue = DoEvents()
    Wend
    If commCtrl.OutBufferCount > 0 Then
        ATimeoutOccurred = True
    End If
End Sub


'
'  SENDBREAK - sends break over RS-232 and reads DCL response from
'  instrument.  Timeout (in RS232READ) will occur if no response.
'
Sub SENDBREAK(commCtrl As MSComm)
    Dim startTime As Long
    Dim message As String
    ' Send the break signal.
    commCtrl.Break = True
    
    ' Wait 1 second
    startTime = GetTickCount()
    While GetTickCount() - startTime < 1000
    Wend
    
    ' Stop sending the break signal.
    commCtrl.Break = False
    Call RS232Read(commCtrl, message)  'read for DCL message; receive or timeout
End Sub


'
'  RS232WAITCOM - wait for a command to finish by doing a *OPC? query
'  and reading its results; wait only as long as the delay value.
'
Sub RS232WAITCOM(commCtl As MSComm, delay%)
    Dim rd As String
   
    frmtl.Timer1.Interval = delay * 1000
    frmtl.Timer1.Enabled = True
    
    Call RS232WRITE(commCtl, "*OPC?")    '*OPC? places a 1 in the Output
    Call RS232Read(commCtl, rd$)         'Queue once an operation is complete
    
    frmtl.Timer1.Enabled = False
End Sub

'
' WaitABit - wait for a specified elapsed time in seconds.
'
Sub WaitABit(timeToWaitInSeconds As Integer)
    Dim startTime As Long
    
    startTime = GetTickCount()
    While GetTickCount() - startTime < timeToWaitInSeconds * 1000
    Wend
    
End Sub