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