VB与安捷伦34970A串口RS232通讯，问题在于程序的对错，与计算机的连接

Question

下面这段程序的对错请大神帮忙看一下，并且想让仪器的不同通道显示在不同的text中，而且存在连接问题，需要什么驱动

Answer 1

Option Explicit

Dim videfaultRM As Long ' Resource manager session returned by viOpenDefaultRM(videfaultRM)
Dim vi As Long ' Session identifier of devices
Dim errorStatus As Long ' VISA function status return code

Dim connected As Boolean ' Sets flag to determine if instrument is connected or not
Dim addr As String ' Used for the instrument address
Dim addrtype As String ' Used for the I/O type
Dim TotTime As Double ' Used to calculate total measurement time

Dim ReturnedData As String ' Used to read returned data
Dim NumRdgs As Long ' Used for the number of readings taken
Dim TrigCount As Integer ' Used to determine number of scans
Dim NumChan As Long ' Used to determine the number of channels scanned

Private Sub Form_Load()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub loads the form.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Enable form and list box
VISAExample.Enabled = True
VISAExample.Visible = True
List1.Enabled = True
List1.Visible = True

List1.AddItem ("Enter/select instrument address, if needed,")
List1.AddItem ("click on " + Chr(34) + "Select I/O" + Chr(34) + " to select the adress,")
List1.AddItem ("and click on " + Chr(34) + "Get Readings" + Chr(34) + " to trigger instrument.")
List1.AddItem ("Measurements will take some time.")

connected = False

End Sub

Sub RunProgram()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This program sets the 34970A to a pre-defined state, makes measurements, and
' returns the measurements.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Call the function that opens communication with instrument
If connected = False Then
If Not OpenPort Then
Exit Sub
End If
End If

' Abort a scan, if one is in progress
SendCmd "ABORt"

' Call sub to setup the 34970A
Setup

List1.Clear
List1.AddItem "Scanning and making measurements; please wait."
List1.AddItem "The instrument will scan through the channels once,"
List1.AddItem "then wait a pre-determined time, and scan again."
List1.AddItem "Measurement time is about: " + LTrim$(Str$(TotTime)) + " seconds."
List1.Refresh

' Call sub to trigger the 34970A, make measurements, and return the readings
Readings

' Enable Exit button
Exit_Prog.SetFocus

End Sub

Private Sub Setup()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub performs the instrument setup.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim DelayVal As Double
Dim TrigTime As Double

' Reset instrument to turn-on condition
SendCmd "*RST"

' Configure for temperature measurements
' Select channels 101 to 110
' Type J thermocouple measurement
' 3 digit (selected by *RST)
SendCmd "CONFigure:TEMPerature TCouple, J, (@101:110)"

' Select the temperature unit (C = Celcius)
SendCmd "UNIT:TEMPerature C, (@101:110)"

' Set the reference temperature type (internal)
SendCmd "SENSe:TEMPerature:TRANSducer:TCouple:RJUNction:TYPE INTernal, (@101:110)"

' Configure for voltage readings:
' Select channels 111 to 120
' DC volts
' 10 V range
' 5.5 digit (selected by *RST)
SendCmd "CONFigure:VOLTage:DC 10, (@111:120)"

' Set the number of power line cycles for all channels to 1
SendCmd "SENSe:VOLTage:NPLC 1,(@111:120)"

' Select the scan list for channels 101 to 120 (all configured channels)
SendCmd "ROUTe:SCAN (@101:120)"

' Set the same measurement delay between the channels
SendCmd "ROUTe:CHANnel:DELay 0.25, (@101:120)"

' Set number of sweeps to 2; use your own value
SendCmd "TRIGger:COUNt 2"

' Set the trigger mode to TIMER (timed trigger); use your own type
SendCmd "TRIGger:SOURce TIMer"

' Set the trigger time to 10 seconds (i.e., time between scans); use your own value
SendCmd "TRIGger:TIMer 10"

' Format the reading time to show the time value from the start of the scan
SendCmd "FORMat:READing:TIME:TYPE RELative"

' Add time stamp to reading using the selected time format
SendCmd "FORMat:READing:TIME ON"

' Add the channel number to the returned readings
SendCmd "FORMat:READing:CHANnel ON"

' Wait for instrument to setup
SendCmd "*OPC?"
ReturnedData = GetData()

' Gets the number of channels to be scanned; used to determine the number of readings
SendCmd "ROUTe:SCAN:SIZE?"
NumChan = Val(GetData())

' Gets the number of triggers; used to determine the number of scans
SendCmd "TRIGger:COUNt?"
TrigCount = Val(GetData())

' Get the delay; for future use
SendCmd "ROUTe:CHANnel:DELay? (@101)"
DelayVal = Val(GetData())

' Get the trigger time
SendCmd "TRIGger:TIMer?"
TrigTime = Val(GetData())

' Calculate total number of readings
NumRdgs = NumChan * TrigCount

' Calculate total time
TotTime = (TrigTime * TrigCount) - TrigTime + (NumChan * DelayVal)

'Check for errors
Call Check_Error("Setup")

End Sub

Sub Readings()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub triggers the instrument, makes the measurements, and returns the readings.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim rdgs As String
Dim readval As String
Dim timerdg As String
Dim chrdg As String
Dim Dateval As String
Dim timeval As String
Dim temp As Long
Dim I As Long

' Trigger the insreument
SendCmd "INITiate"

' Get the date at which the scan was started
SendCmd "SYSTem:DATE?"
Dateval = GetData()

' Get the time at which the scan was started
SendCmd "SYSTem:TIME?"
timeval = GetData()

' Wait until instrument is finished taken readings.
Do
SendCmd "DATA:POINTS?"
ReturnedData = GetData()
temp = Val(ReturnedData)
Loop Until temp = NumRdgs

List1.Clear
List1.AddItem "Enter/select instrument address, if needed;"
List1.AddItem "then click on " + Chr$(34) + "Get Readings" + Chr$(34) + " to trigger instrument."
List1.AddItem "Measurements will take some time."

List1.AddItem ""
List1.AddItem "Start Date (yyyy,mm,dd): " + Left$(Dateval, Len(Dateval) - 1)
List1.AddItem "Start Time (hh,mm,ss): " + Left$(timeval, Len(timeval) - 1)
List1.AddItem "Rdng#" + Chr$(9) + "Channel" + Chr$(9) + "Value" + Chr$(9) + Chr$(9) + "Time"
List1.Refresh

' Check for errors
Call Check_Error("Readings")

' Take readings out of memory one reading at a time. The "FETCh?" can also be used.
' It reads all readings in memory, but leaves the readings in memory. The
' "DATA:REMove?" command removes and erases the readings in memory.
For I = 1 To NumRdgs

' Get reading value
SendCmd "DATA:REMove? 1  "
rdgs = GetData()
readval = Mid$(rdgs, 1, InStr(rdgs, ",") - 1)
rdgs = Mid$(rdgs, InStr(rdgs, ",") + 1, Len(rdgs))

' Get time stamp and channel number
timerdg = Mid$(rdgs, 1, InStr(rdgs, ",") - 1)
rdgs = Mid$(rdgs, InStr(rdgs, ",") + 1, Len(rdgs))

' Get channel number
chrdg = rdgs

rdgs = LTrim$(Str$(I)) + Chr$(9) + chrdg + Chr$(9) + readval + Chr$(9) + timerdg
List1.AddItem rdgs

Next I

End Sub

Function OpenPort() As Boolean
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This function opens a port (the communication between the instrument and computer).
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim addr As String

' If port is open, close it
If connected Then
errorStatus = viClose(vi)
End If

' Get I/O Address
addr = UCase(ioType.Text)

' Open the Visa session
errorStatus = viOpenDefaultRM(videfaultRM)

' Open communication to the instrument
errorStatus = viOpen(videfaultRM, addr & "::INSTR", 0, 0, vi)

' Set timeout in milliseconds; set the timeout for your requirements
errorStatus = viSetAttribute(vi, VI_ATTR_TMO_VALUE, 2000)

    ' Set the RS-232 parameters; refer to the 34970A and VISA documentation
    ' to change the settings. Make sure the instrument and the following
    ' settings agree.
    errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_BAUD, 115200)
    errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_DATA_BITS, 8)
    errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_PARITY, VI_ASRL_PAR_NONE)
    errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_STOP_BITS, VI_ASRL_STOP_ONE)
    errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_FLOW_CNTRL, VI_ASRL_FLOW_XON_XOFF)

    ' Set the instrument to remote
    SendCmd "SYSTem:REMote"

' Check and make sure the correct instrument is addressed
SendCmd "*IDN?"
ReturnedData = GetData()

If (InStr(ReturnedData, "34970A") = 0) Then
MsgBox "Incorrect instrument addressed; use the correct address."
ioType.Text = "::INSTR"
ioType.Refresh
connected = False
OpenPort = False

' Close instrument session
errorStatus = viClose(vi)

' Close the session
errorStatus = viClose(videfaultRM)

Exit Function

End If

' Clear list box
List1.Clear

List1.AddItem "Instrument ID is:"
List1.AddItem ReturnedData

' Check and make sure the 34901A Module is installed in slot 100;
' Exit program if not correct
SendCmd ("SYSTem:CTYPe? 100")
ReturnedData = GetData()

If InStr(ReturnedData, "34901A") = 0 Then
MsgBox "Incorrect Module Installed in slot 100!"
End_Prog
End If

' Check if the DMM is installed
SendCmd ("INSTrument:DMM:INSTalled?")
ReturnedData = GetData()
'If not installed, stop programming the 34970A
If Val(ReturnedData) = 0 Then
MsgBox "DMM not installed; unable to make measurements."
End_Prog
End If

' Check if the DMM is enabled; enable if not enabled
SendCmd ("INSTrument:DMM?")
ReturnedData = GetData()
If Val(ReturnedData) = 0 Then
SendCmd ("INSTrument:DMM ON")
End If

connected = True
OpenPort = True

End Function

Private Sub SendCmd(SCPICmd As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This routine will send a SCPI command string to the instrument. If the
' command contains a question mark (i.e., is a query command), you must
' read the response with the 'GetData' function.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim commandstr As String ' Command passed to instrument
Dim actual As Long ' Number of characters sent/returned

' Set up an error handler within subroutine to be called if an error occurs.
'On Error GoTo VIerrorHandler

' Write the command to the instrument (terminated by a linefeed)
commandstr = SCPICmd & Chr$(10)
errorStatus = viWrite(vi, ByVal commandstr, Len(commandstr), actual)

Exit Sub

End Sub

Function GetData() As String
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This function reads the string returned by the instrument
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim readbuf As String * 2048 ' Buffer used for returned string
Dim replyString As String ' Store the string returned
Dim valpos As Integer ' Location of any null's and line feed in readbuf
Dim actual As Long ' Number of characters sent/returned

' Read the response string
errorStatus = viRead(vi, ByVal readbuf, 2048, actual)
replyString = readbuf

If actual = 0 Then
GoTo VIerrorHandler
End If

' Strip out the line feed, if any
If InStr(replyString, Chr$(10)) Then
replyString = Left(replyString, InStr(replyString, Chr$(10)) - 1)
End If

' Strip out the carriage returnfeed, if any
If InStr(replyString, Chr$(13)) Then
replyString = Left(replyString, InStr(replyString, Chr$(13)) - 1)
End If

' return data
GetData = replyString

Exit Function

VIerrorHandler:

' Display the error message
MsgBox " I/O Error"

' Close the device session
errorStatus = viClose(vi)

' Close the session
errorStatus = viClose(videfaultRM)

End

End Function

Sub Check_Error(msg As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Checks for syntax and other errors.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim err_code As Integer
Dim err_msg As String
Dim TempCheck As Integer
Dim valpos As Integer

' check for initial error
SendCmd "SYSTem:ERRor?"
err_msg = GetData()

' If error found, check for more errors and exit program
err_code = Val(err_msg)

TempCheck = 0
While err_code <> 0
TempCheck = 1

msg = "Error in: " + msg + Chr$(10)
msg = msg + "Error Number: " + Str$(err_code) + Chr$(10) + "Error Message: " + err_msg

MsgBox msg

' check for more errors
SendCmd "SYSTem:ERRor?"
err_msg = GetData()
err_code = Val(err_msg)

Wend

If TempCheck <> 0 Then

' Send a device clear
SendCmd "*CLS"

' Close instrument session
errorStatus = viClose(vi)

' Close the session
errorStatus = viClose(videfaultRM)

' end the program
End

End If

End Sub

Private Sub GetReadings_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Call sub routine to trigger instrument and get readings.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Call the Readings sub
RunProgram

End Sub

Private Sub Exit_Prog_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Calls sub to close the session and end program.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Calls the sub
End_Prog

End Sub

Sub End_Prog()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Closes the session and program.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

If connected Then
' Abort a scan
SendCmd "ABORt"

' Send a device clear
SendCmd "*CLS"

' Close instrument session
errorStatus = viClose(vi)

' Close the session
errorStatus = viClose(videfaultRM)

End If

End

End Sub

Private Sub SelectIO_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Button that selects the I/O and creates an instrument session.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Establish communications
OpenPort

End Sub