Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.1 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) MSComm1.PortOpen = True MSComm1.Output = ":CONFIGURE:SAMPLE 100.0E-3" & deli$ MSComm1.Output = ":CONFIGURE:TDIV 1.0E+0" & deli$ MSComm1.Output = ":CONFIGURE:RECTIME 0,0,0,10" & deli$ MSComm1.Output = ":UNIT:STORE CH1,ON" & deli$ MSComm1.Output = ":UNIT:INMODE CH1,VOLTAGE" & deli$ MSComm1.Output = ":TRIGGER:SOURCE OR" & deli$ MSComm1.Output = ":TRIGGER:KIND CH1,LEVEL" & deli$ MSComm1.Output = ":TRIGGER:PRETRIG 0,0,0,5" & deli$ MSComm1.Output = ":TRIGGER:LEVEL CH1,0" & deli$ MSComm1.Output = ":TRIGGER:SLOPE CH1,UP" & deli$ MSComm1.Output = ":START" & deli$ MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.2 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) MSComm1.PortOpen = True MSComm1.Output = ":HEADER OFF" & deli$ MSComm1.Output = ":CONFIGURE:RECTIME?" & deli$ Do sh$ = sh$ & MSComm1.Input Loop Until InStr(1, sh$, Chr$(10)) MSComm1.Output = ":SYSTEM:TIME?" & deli$ Do tm$ = tm$ & MSComm1.Input Loop Until InStr(1, tm$, Chr$(10)) Text1.Text = "RECTIME = " & sh$ Text1.Text = Text1.Text & "TIME = " & tm$ MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.3 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) Dim d(100) As Double MSComm1.PortOpen = True MSComm1.Output = ":CONFIGURE:SAMPLE 100.0E-3" & deli$ MSComm1.Output = ":CONFIGURE:RECTIME 0,0,0,10" & deli$ MSComm1.Output = ":UNIT:STORE CH1,ON" & deli$ MSComm1.Output = ":TRIGGER:MODE SINGLE" & deli$ MSComm1.Output = ":START;:STOP;*OPC?" & deli$ Do o$ = o$ & MSComm1.Input Loop Until InStr(1, o$, Chr$(10)) MSComm1.Output = ":HEADER OFF" & deli$ MSComm1.Output = ":MEMORY:MAXPOINT?" & deli$ Do mx$ = mx$ & MSComm1.Input Loop Until InStr(1, mx$, Chr$(10)) If (Val(mx$) = 0) Then MSComm1.PortOpen = False Exit Sub End If MSComm1.Output = ":MEMORY:POINT CH1,0" & deli$ For i = 0 To 100 vd$ = "" MSComm1.Output = ":MEMORY:VDATA? 1" & deli$ Do vd$ = vd$ & MSComm1.Input Loop Until InStr(1, vd$, Chr$(10)) d(i) = Val(vd$) Next For i = 0 To 100 Text1.SelText = Format(d(i), "Scientific") & deli$ Next MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.4 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) MSComm1.PortOpen = True MSComm1.Output = ":CONFIGURE:SAMPLE 100.0E-3" & deli$ MSComm1.Output = ":CONFIGURE:RECTIME 0,0,0,10" & deli$ MSComm1.Output = ":UNIT:STORE CH1,ON" & deli$ MSComm1.Output = ":MEMORY:PREPARE;*OPC?" & deli$ Do o$ = MSComm1.Input Loop Until InStr(1, o$, Chr$(10)) MSComm1.Output = ":MEMORY:POINT CH1,0" & deli$ For i = 0 To 100 MSComm1.Output = ":MEMORY:ADATA " & Str$(Int(10000 * Sin(3.14 * i / 50))) & deli$ Next MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.5 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) MSComm1.PortOpen = True MAXCH = 8 '8420-51=8,8421-51=16,8422-51=32channels Dim ch_data$(32 + 1) MSComm1.Output = ":HEADER OFF" & deli$ MSComm1.Output = ":MEMORY:GETREAL" & deli$ For ch = 1 To MAXCH MSComm1.Output = ":MEMORY:AREAL? CH" + Str$(ch) & deli$ ar$ = "" Do ar$ = ar$ & MSComm1.Input Loop Until InStr(1, ar$, Chr$(10)) ch_data$(ch) = "CH" + Str$(ch) + " = " & ar$ Next ch For ch = 1 To MAXCH Text1.SelText = ch_data$(ch) & deli$ Next ch MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.6 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) na$ = "a:\sample.dat" MSComm1.PortOpen = True MSComm1.Output = ":HEADER OFF" & deli$ MSComm1.Output = ":MEMORY:MAXPOINT?" & deli$ Do mx$ = mx$ & MSComm1.Input Loop Until InStr(1, mx$, Chr$(10)) If (Val(mx$) = 0) Then MSComm1.PortOpen = False Exit Sub End If Open na$ For Output As #1 MSComm1.Output = ":MEMORY:POINT CH1,0" & deli$ Print #1, Val(mx$) For i = 1 To Val(mx$) MSComm1.Output = ":MEMORY:ADATA? 1" & deli$ ad$ = "" Do ad$ = ad$ & MSComm1.Input Loop Until InStr(1, ad$, Chr$(10)) Print #1, Val(ad$) Next Close #1 MSComm1.PortOpen = False End Sub
Private Sub Command1_Click() '******************************************************************************* ' RS232C SAMPLE PROGRAM NO.7 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) na$ = "a:\sample.dat" MSComm1.PortOpen = True MSComm1.Output = ":HEADER OFF" & deli$ MSComm1.Output = ":MEMORY:PREPARE;*OPC?" & deli$ Do o$ = MSComm1.Input Loop Until InStr(1, o$, Chr$(10)) Open na$ For Input As #1 MSComm1.Output = ":MEMORY:POINT CH1,0" & deli$ Line Input #1, mx For i = 1 To mx Line Input #1, dt MSComm1.Output = ":MEMORY:ADATA " & Str$(dt) & deli$ Next Close #1 MSComm1.PortOpen = False End Sub
*Send the command in the format specified, when the conditions
for the command to be acceptable are met.
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.1 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) SendMsg ":CONFIGURE:SAMPLE 100.0E-3" & deli$ SendMsg ":CONFIGURE:TDIV 1.0E+0" & deli$ SendMsg ":CONFIGURE:RECTIME 0,0,0,10" & deli$ SendMsg ":UNIT:STORE CH1,ON" & deli$ SendMsg ":UNIT:INMODE CH1,VOLTAGE" & deli$ SendMsg ":TRIGGER:SOURCE OR" & deli$ SendMsg ":TRIGGER:KIND CH1,LEVEL" & deli$ SendMsg ":TRIGGER:PRETRIG 0,0,0,5" & deli$ SendMsg ":TRIGGER:LEVEL CH1,0" & deli$ SendMsg ":TRIGGER:SLOPE CH1,UP" & deli$ SendMsg ":START" & deli$ End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
*Send the query in the format specified, when the conditions for
the query to be acceptable are met.
*The response data from the query is returned in the format
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.2 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) SendMsg ":HEADER OFF" & deli$ GetMsg ":CONFIGURE:RECTIME?" & deli$ sh$ = MsgBuf GetMsg ":SYSTEM:TIME?" & deli$ tm$ = MsgBuf Text1.Text = "RECTIME = " & sh$ Text1.Text = Text1.Text & "TIME = " & tm$ End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
*Using the :MEMORY:MAXPOINT? query, this program checks whether
data can be output from memory. If this query returns zero,
no data is stored, and it cannot therefore be output.
*Next, the program specifies the channel and point for output,
using the :MEMORY:POINT command. As data is input or output,
the point is incremented automatically. If capturing data
consecutively, it is sufficient to specify the point once only.
*To capture data in ASCII format use the :MEMORY:ADATA? query,
and to capture data as voltage values use the :MEMORY:VDATA?
query.
The number of data samples which may be output in one set is
1 to 80 using :ADATA? and 1 to 40 using the :VDATA? query.
*Outputting data in bigger sets reduces the overall processing
time.
*Read data (100+1 samples) for channel 1 when stored with
a 100ms interval and 10sec recording time.
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.3 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) Dim d(100) As Double SendMsg ":CONFIGURE:SAMPLE 100.0E-3" & deli$ SendMsg ":CONFIGURE:RECTIME 0,0,0,10" & deli$ SendMsg ":UNIT:STORE CH1,ON" & deli$ SendMsg ":TRIGGER:MODE SINGLE" & deli$ GetMsg ":START;:STOP;*OPC?" & deli$ o$ = MsgBuf SendMsg ":HEADER OFF" & deli$ GetMsg ":MEMORY:MAXPOINT?" & deli$ mx$ = MsgBuf If (Val(mx$) = 0) Then Exit Sub End If SendMsg ":MEMORY:POINT CH1,0" & deli$ For i = 0 To 100 vd$ = "" GetMsg ":MEMORY:VDATA? 1" & deli$ vd$ = MsgBuf d(i) = Val(vd$) Next For i = 0 To 100 Text1.SelText = Format(d(i), "Scientific") & deli$ Next End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
*This program prepares storage memory, using the :MEMORY:PREPARE
command.
*Next, the program specifies the channel and point for input,
using the :MEMORY:POINT command, and then uses
the :MEMORY:ADATA command to input data.
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.4 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) SendMsg ":CONFIGURE:SAMPLE 100.0E-3" & deli$ SendMsg ":CONFIGURE:RECTIME 0,0,0,10" & deli$ SendMsg ":UNIT:STORE CH1,ON" & deli$ GetMsg ":MEMORY:PREPARE;*OPC?" & deli$ o$ = MsgBuf SendMsg ":MEMORY:POINT CH1,0" & deli$ For i = 0 To 100 SendMsg ":MEMORY:ADATA " & Str$(Int(10000 * Sin(3.14 * i / 50))) & deli$ Next End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.5 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) MAXCH = 8 '8420-51=8,8421-51=16,8422-51=32 Dim ch_data$(32 + 1) SendMsg ":HEADER OFF" & deli$ SendMsg ":MEMORY:GETREAL" & deli$ For ch = 1 To MAXCH GetMsg ":MEMORY:AREAL? CH" + Str$(ch) & deli$ ar$ = MsgBuf ch_data$(ch) = "CH" + Str$(ch) + " = " & ar$ Next ch For ch = 1 To MAXCH Text1.SelText = ch_data$(ch) & deli$ Next ch End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.6 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) na$ = "a:\sample.dat" SendMsg ":HEADER OFF" & deli$ GetMsg ":MEMORY:MAXPOINT?" & deli$ mx$ = MsgBuf If (Val(mx$) = 0) Then Exit Sub End If Open na$ For Output As #1 SendMsg ":MEMORY:POINT CH1,0" & deli$ Print #1, Val(mx$) For i = 1 To Val(mx$) GetMsg ":MEMORY:ADATA? 1" & deli$ ad$ = MsgBuf Print #1, Val(ad$) Next Close #1 End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub
Dim MsgFlg As Integer Dim MsgBuf As String Private Sub Command1_Click() '******************************************************************************* ' 10BASE-T(LAN) SAMPLE PROGRAM NO.7 '******************************************************************************* deli$ = Chr$(13) & Chr$(10) na$ = "a:\sample.dat" SendMsg ":HEADER OFF" & deli$ GetMsg ":MEMORY:PREPARE;*OPC?" & deli$ o$ = MsgBuf Open na$ For Input As #1 SendMsg ":MEMORY:POINT CH1,0" & deli$ Line Input #1, mx For i = 1 To mx Line Input #1, dt SendMsg ":MEMORY:ADATA " & Str$(dt) & deli$ Next Close #1 End Sub Private Sub Command2_Click() Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = txtIP.Text Winsock1.RemotePort = Val(txtPort.Text) Winsock1.Connect Do While (Winsock1.State <> sckConnected) If Winsock1.State = sckConnecting Then Text2.Text = "connecting" DoEvents Loop If Winsock1.State = sckConnected Then Text2.Text = "finish" End Sub Private Sub Command3_Click() Winsock1.Close Do While (Winsock1.State <> sckClosed) If Winsock1.State = sckConnected Then Text2.Text = "disconecting" DoEvents Loop If Winsock1.State = sckClosed Then Text2.Text = "finish" End Sub Private Sub SendMsg(strMsg As String) Winsock1.SendData strMsg End Sub Private Sub GetMsg(strMsg As String) MsgFlg = 0 Winsock1.SendData strMsg Do While (MsgFlg = 0) DoEvents Loop End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData MsgBuf, vbString MsgFlg = 1 End Sub