Next: unlock.bas
Up: Code Listing
Previous: rti-815.bas
'
' Author: Terence Kelly
' Date: 5 September 1995
'
' This module contains functions for talking to the Tektronix 222
' oscilloscope through a serial port.
'
' On 8/22/95 Prof. Littman and I spent a great deal of time
' configuring the serial port on the 486 used with the WEBRTI
' project in order to enable it to speak to the Tektronix 222.
' Here are the settings for COM1 and COM2 that we finally
' settled on (we use COM1 for Tektronix communications):
'
' COM1 COM2
'
' Memory address: 03F8 02F8
' Baud rate: 2400 2400
' Parity: N N
' Data bits: 8 8
' Stop bits: 1 1
' IRQ: 4 3
'
'----------------------------------------------------------------------------
Global Const Tek_COMPortNumber% = 1
Global Const Tek_COMPortSettings$ = "2400,N,8,1"
' Keeps track of how many waveforms we've captured; used in
' naming output files.
Global WaveformCount As Integer
Function Tek_AcqMode (ByVal N%) As String
'
' Given a number in the range 0-3, return the corresponding
' acquisition mode string from table 5, page 13 of "222 RS-232
' Interface Guide."
'
R$ = ""
If N% < 0 Or N% > 3 Then
R$ = "Error in routine Tek_AcqMode: "
Tek_AcqMode = R$ & Str$(N%) & " not valid parameter"
Exit Function
End If
Select Case N%
Case 0
R$ = "NORM"
Case 1
R$ = "ENV"
Case 2
R$ = "AVG"
Case 3
R$ = "CENV"
Case Else
R$ = "Error in routine Tek_AcqMode: unclassified parameter"
End Select
Tek_AcqMode = R$
End Function
Function Tek_CPLG (ByVal N%) As String
'
' Given a number in the range 0-3, return the corresponding
' CPLG string from tables 1 and 2, pp. 10-11 of "222 RS-232
' Interface Guide."
'
R$ = ""
If N% < 0 Or N% > 3 Then
R$ = "Error in routine Tek_CPLG: "
Tek_CPLG = R$ & Str$(N%) & " is an invalid parameter"
Exit Function
End If
Select Case N%
Case 0
R$ = "DC"
Case 1
R$ = "AC"
Case 2
R$ = "GND"
Case 3
R$ = "OFF"
Case Else
R$ = "Error in routine Tek_CPLG: unclassified parameter"
End Select
Tek_CPLG = R$
End Function
Function Tek_ErrorMsg (ByVal in$) As String
'
' Given a string, search it for a Tektronix error message. If
' an Error message is found in the input string, return the
' "long version" of the error message. See p. 14 of the "222
' RS-232 Interfacing Guide" for details. This function only
' handles status codes, not diagnostic error codes. I've never
' had the scope give me a diagnostic error code, but it has
' often spit back status codes complaining about commands I've
' sent it.
'
R$ = ""
S$ = Trim$(CondenseWhitespace(in$))
I% = InStr(S$, "STA")
If I% > 0 Then
C$ = Mid$(S$, I%)
Select Case Mid$(Split(C$, 2, " "), 1, 4)
Case "0001"
R$ = "Unrecognized command"
Case "0002"
R$ = "Unrecognized character"
Case "0003"
R$ = "Command is query only"
Case "0004"
R$ = "Command has no query"
Case "0005"
R$ = "Bad command argument"
Case "0006"
R$ = "Bad data"
Case "0007"
R$ = "Data is required"
Case "0008"
R$ = "Argument is required"
Case "0009"
R$ = "Communication task busy"
Case "000A"
R$ = "CURV command had bad checksum"
Case "000B"
R$ = "Bad task name for message"
Case "FFFF"
R$ = "User pressed escape"
Case Else
R$ = "WEBRTI function Tek_ErrorMsg does not recognize"
R$ = R$ & " this status code"
End Select
End If
If InStr(UCase$(S$), "ERR") Then
If R$ <> "" Then R$ = R$ & ". "
R$ = R$ & "Diagnostic error code: see 222 RS-232 user "
R$ = R$ & "interface guide"
End If
Tek_ErrorMsg = R$
End Function
Function Tek_FP (ByVal logfp$) As String
'
' Get the front panel settings of the Tektronix scope and return
' them along with a human-readable decoding.
'
FP$ = Tek_send("3", "FP? " & logfp$)
R$ = Trim$(Tek_InsertErrorMsgs(CondenseWhitespace(FP$)))
If InStr(R$, "STA") Or InStr(R$, "ERR") Then
Tek_FP = R$
Else
R$ = R$ & CRLF()
Tek_FP = R$ & Tek_FPDecode(Mid$(FP$, InStr(FP$, ":") + 1, 10))
End If
End Function
Function Tek_FPDecode (ByVal FP$) As String
'
' Given a ten-character string representing the Tektronix 222
' response to the FP? command, decode this string into human-
' readable form according to tables 1 through 5, pp. 10 - 13
' of the "222 RS-232 Interface Guide."
'
If Len(FP$) <> 10 Then
R$ = "Error in routine Tek_FPDecode: Len(parameter) != 10"
Tek_FPDecode = R$
Exit Function
End If
C$ = CRLF()
R$ = ""
' channel 1
Ch$ = Mid$(FP$, 1, 1)
R$ = R$ & " CH1INV="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
R$ = R$ & " CH1VAR="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
R$ = R$ & "CH1CPLG=" & Tek_CPLG(HexExtract(Ch$, 2, 2)) & C$
R$ = R$ & " CH1V/D=" & Tek_VoltsDiv(Mid$(FP$, 2, 1)) & C$
' channel 2
Ch$ = Mid$(FP$, 3, 1)
R$ = R$ & " CH2INV="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
R$ = R$ & " CH2VAR="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
R$ = R$ & "CH2CPLG=" & Tek_CPLG(HexExtract(Ch$, 2, 2)) & C$
R$ = R$ & " CH2V/D=" & Tek_VoltsDiv(Mid$(FP$, 4, 1)) & C$
' Table 3: Sec/Div and Misc. settings
Ch$ = Mid$(FP$, 5, 2)
R$ = R$ & " RO-OFF="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1), "On/Off")) & C$
R$ = R$ & " XY="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 1, 1), "On/Off")) & C$
R$ = R$ & " X10MAG="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 2, 1), "On/Off")) & C$
R$ = R$ & "SEC/DIV=" & Tek_SecDiv(HexExtract(Ch$, 3, 5)) & C$
' Table 4: Trigger Position, Slope, Source and Mode Settings
Ch$ = Mid$(FP$, 7, 2)
R$ = R$ & "TRIGPOS=" & Tek_TrigPos(HexExtract(Ch$, 0, 2)) & C$
R$ = R$ & " SLOPE=" & Tek_TrigSlope(HexExtract(Ch$, 2, 1)) & C$
R$ = R$ & "TRIGSRC=" & Tek_TrigSource(HexExtract(Ch$, 3, 2)) & C$
R$ = R$ & "TRIGMOD=" & Tek_TrigMode(HexExtract(Ch$, 5, 3)) & C$
' Table 5: Acquisition Mode and Misc. Settings
Ch$ = Mid$(FP$, 9, 2)
' Decoding of Timeout is perverse; see table 5
R$ = R$ & " TIMEOUT="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 0, 1) - 1, "Yes/No")) & C$
R$ = R$ & " CHANSEL="
R$ = R$ & IIf(HexExtract(Ch$, 1, 1), "CH1", "CH2") & C$
R$ = R$ & "RECALLEDWFM="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 2, 1), "Yes/No")) & C$
R$ = R$ & " VALIDSTORE="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 3, 1), "Yes/No")) & C$
R$ = R$ & " ACQMODE=" & Tek_AcqMode(HexExtract(Ch$, 4, 2)) & C$
R$ = R$ & " STOREMODE="
R$ = R$ & IIf(HexExtract(Ch$, 6, 1), "STORE", "NONSTORE") & C$
R$ = R$ & " AUTOTRIG="
R$ = R$ & UCase$(Format$(HexExtract(Ch$, 7, 1), "Yes/No")) & C$
Tek_FPDecode = R$
End Function
Function Tek_get () As String
'
' Get waveforms CH1 and CH2, store them in files. Use global
' integer to keep track of how many non-null waveform files
' we've succeeded in grabbing from the scope. Return a string
' containing information on the number of bytes
'
' We assume that the scope is in SSEQ trigger mode and that
'
' See the Tektronix manual entitled "222 RS-232 Interface Guide"
' for details on the button numbering scheme, trigger modes, etc.
'
Const Delay$ = "7" ' CURV? commands take a while.
R$ = ""
' record the time that this routine is invoked
CapTime$ = Format$(Now, "hh:mm:ss m/d/yy")
' grab the waveforms
CH1$ = Tek_send(Delay$, "curv? ch1")
CH2$ = Tek_send(Delay$, "curv? ch2")
' store nonzero length waveforms to disk
If CH1$ <> "" Then
WaveformCount = WaveformCount + 1
Filename$ = RTIDir$ & "TEK_" & Format$(WaveformCount, "0000")
Filename$ = Filename$ & ".WFM"
Call ClobberFile(Filename$, CH1$)
End If
If CH2$ <> "" Then
WaveformCount = WaveformCount + 1
Filename$ = RTIDir$ & "TEK_" & Format$(WaveformCount, "0000")
Filename$ = Filename$ & ".WFM"
Call ClobberFile(Filename$, CH2$)
End If
R$ = " Bytes received: CH1=" & Trim$(Str$(Len(CH1$)))
R$ = R$ & ", CH2=" & Trim$(Str$(Len(CH2$))) & " at " & CapTime$
Tek_get = R$
End Function
Function Tek_initialize () As String
'
' Initialize the MSCOMM control used to communicate with the
' 222 oscilloscope. Return any error messages that occur during
' this process.
'
On Error GoTo Tek_Initialize_Error
strErrors$ = ""
Tek_initialize = ""
frmWEBRTIcontrols.Hide ' form containing MSCOMM control
frmWEBRTIcontrols.Comm1.CommPort = Tek_COMPortNumber%
frmWEBRTIcontrols.Comm1.settings = Tek_COMPortSettings$
frmWEBRTIcontrols.Comm1.InputLen = 0
frmWEBRTIcontrols.Comm1.InBufferSize = 4096
frmWEBRTIcontrols.Comm1.PortOpen = True
frmWEBRTIcontrols.Comm1.OutBufferCount = 0
frmWEBRTIcontrols.Comm1.InBufferCount = 0
frmWEBRTIcontrols.Comm1.Output = Chr$(13)
Delay (1)
strReply$ = Trim$(CondenseWhitespace(frmWEBRTIcontrols.Comm1.Input))
frmWEBRTIcontrols.Comm1.PortOpen = False
Tek_initialize = Tek_InsertErrorMsgs(strReply$) & strErrors$
Exit Function
Tek_Initialize_Error:
If strErrors$ <> "" Then strErrors$ = strErrors$ & CRLF()
T$ = strErrors$ & "Error " & Str$(Err)
strErrors$ = T$ & " (VB) in function Tek_initialize: " & Error(Err)
Resume Next
End Function
Function Tek_InsertErrorMsgs (ByVal in$) As String
'
' Given a reply string from the Tektronix scope, insert a
' parenthesized error message within every semicolon-delimited
' individual reply containing a STA or ERR notice.
'
' We assume that the last semicolon-delimited field of the
' string returned by the Tektronix scope is empty.
'
R$ = ""
For I% = 1 To NumOccur(in$, ";")
Msg$ = Split(in$, I%, ";")
E$ = Tek_ErrorMsg(Msg$)
If E$ <> "" Then
R$ = R$ & Msg$ & " (" & E$ & "); "
Else
R$ = R$ & Msg$ & "; "
End If
Next
Tek_InsertErrorMsgs = R$
End Function
Function Tek_SecDiv (ByVal N%) As String
'
' Given an integer in the range 0 - 26 return a string
' containing the corresponding Seconds/Division setting listed
' in Table 3, p. 12 of the Tektronix "222 RS-232 Interface
' Guide " or an error message."
'
If N% < 0 Or N% > 26 Then
R$ = "Error in routine Tek_SecDiv: " & Str$(N%)
Tek_SecDiv = R$ & " not a valid parameter (out of range)"
Exit Function
End If
Select Case N%
Case 0
R$ = "50 nS"
Case 1
R$ = "0.1 uS"
Case 2
R$ = "0.2 uS"
Case 3
R$ = "0.5 uS"
Case 4
R$ = "1 uS"
Case 5
R$ = "2 uS"
Case 6
R$ = "5 uS"
Case 7
R$ = "10 uS"
Case 8
R$ = "20 uS"
Case 9
R$ = "50 uS"
Case 10
R$ = "0.1 mS"
Case 11
R$ = "0.2 mS"
Case 12
R$ = "0.5 mS"
Case 13
R$ = "1 mS"
Case 14
R$ = "2 mS"
Case 15
R$ = "5 mS"
Case 16
R$ = "10 mS"
Case 17
R$ = "20 mS"
Case 18
R$ = "50 mS"
Case 19
R$ = "0.1 S"
Case 20
R$ = "0.2 S"
Case 21
R$ = "0.5 S"
Case 22
R$ = "1 S"
Case 23
R$ = "2 S"
Case 24
R$ = "5 S"
Case 25
R$ = "10 S"
Case 26
R$ = "20 S"
Case Else
R$ = "Error in routine Tek_SecDiv: unclassified parameter"
End Select
Tek_SecDiv = R$
End Function
Function Tek_send (ByVal Delay$, ByVal S$) As String
'
' Send the given string to the Tektronix scope and return
' whatever the scope replies. Wait Delay$ seconds before
' reading the scope's reply. It is the user/programmer's
' responsibility to choose Delay$ wisely.
'
On Error GoTo Tek_send_Error
D% = IIf(Val(Delay$) > 0, Val(Delay$), 1)
frmWEBRTIcontrols.Comm1.PortOpen = True
frmWEBRTIcontrols.Comm1.OutBufferCount = 0
frmWEBRTIcontrols.Comm1.InBufferCount = 0
frmWEBRTIcontrols.Comm1.Output = S$ & Chr$(13)
Delay (D%)
strReply$ = frmWEBRTIcontrols.Comm1.Input
frmWEBRTIcontrols.Comm1.PortOpen = False
Tek_send = strReply$
Exit Function
Tek_send_Error:
R$ = "Error " & Str$(Err) & " (VB) in function Tek_send: "
Tek_send = R$ & Error$(Err)
Exit Function
End Function
Function Tek_TrigMode (ByVal N%) As String
'
' Given a number in the range 0-3, return the corresponding
' trigger mode string from table 4, page 13 of "222 RS-232
' Interface Guide."
'
If N% < 0 Or N% > 3 Then
R$ = "Error in routine Tek_TrigMode: " & Str$(N%)
Tek_TrigMode = R$ & " not valid parameter (out of range)"
Exit Function
End If
Select Case N%
Case 0
R$ = "NORM"
Case 1
R$ = "AUTOLVL"
Case 2
R$ = "AUTOBL"
Case 3
R$ = "SSEQ"
Case Else
R$ = "Error in routine Tek_TrigMode: unclassified parameter"
End Select
Tek_TrigMode = R$
End Function
Function Tek_TrigPos (ByVal N%) As String
'
' Given an integer in the range 0-2, return the corresponding
' trigger position string from table 4, p. 13 of "222 RS-232
' Interface Guide."
'
If N% < 0 Or N% > 2 Then
R$ = "Error in routine Tek_TrigPos: " & Str$(N%)
Tek_TrigPos = R$ & " not valid parameter (out of range)"
Exit Function
End If
Select Case N%
Case 0
R$ = "POST"
Case 1
R$ = "MID"
Case 2
R$ = "PRE"
Case Else
R$ = "Error in routine Tek_TrigPos: unclassified parameter"
End Select
Tek_TrigPos = R$
End Function
Function Tek_TrigSlope (ByVal N%) As String
'
' Given a number in the range 0-1, return the corresponding
' trigger slope string from table 4, page 13 of "222 RS-232
' Interface Guide."
'
' This function could really be replaced with an IIf statement.
'
If N% < 0 Or N% > 1 Then
R$ = "Error in routine Tek_TrigSlope: " & Str$(N%)
Tek_TrigSlope = R$ & " not valid parameter"
Exit Function
End If
Select Case N%
Case 0
R$ = "NEG"
Case 1
R$ = "POS"
Case Else
R$ = "Error in routine Tek_TrigSlope: unclassified parameter"
End Select
Tek_TrigSlope = R$
End Function
Function Tek_TrigSource (ByVal N%) As String
'
' Given a number in the range 0-3, return the corresponding
' trigger source string from table 4, page 13 of "222 RS-232
' Interface Guide."
'
If N% < 0 Or N% > 3 Then
R$ = "Error in routine Tek_TrigSource: " & Str$(N%)
Tek_TrigSource = R$ & " not valid parameter"
Exit Function
End If
Select Case N%
Case 0
R$ = "VERT"
Case 1
R$ = "CH1"
Case 2
R$ = "CH2"
Case 3
R$ = "EXT"
Case Else
R$ = "Error in routine Tek_TrigSource: unclassified parameter"
End Select
Tek_TrigSource = R$
End Function
Function Tek_VoltsDiv (ByVal Ch$) As String
'
' Given a hex character in the range 0 - C, return the
' corresponding volts/division setting from tables 1 and 2,
' pp. 10-11 of the "222 RS-232 Interface Guide"
'
N% = Val("&H" & Ch$)
If Len(Ch$) <> 1 Or N% > 12 Or N% < 0 Then
R$ = "Error in routine Tek_VoltsDiv: " & Ch$
Tek_VoltsDiv = R$ & " is not a valid parameter (out of range)"
Exit Function
End If
Select Case N%
Case 0
R$ = "5 mV"
Case 1
R$ = "10 mV"
Case 2
R$ = "20 mV"
Case 3
R$ = "50 mV"
Case 4
R$ = "0.1 V"
Case 5
R$ = "0.2 V"
Case 6
R$ = "0.5 V"
Case 7
R$ = "1 V"
Case 8
R$ = "2 V"
Case 9
R$ = "5 V"
Case 10
R$ = "10 V"
Case 11
R$ = "20 V"
Case 12
R$ = "50 V"
Case Else
R$ = "Error in routine Tek_VoltsDiv: unclassified parameter"
End Select
Tek_VoltsDiv = R$
End Function