module3.bas

这是一个GPIB源程序代码,里面有硬件相对应的代码

Attribute VB_Name = "Module3"
Option Explicit '防止变量未定义

Public DMM1 As VisaComLib.FormattedIO488 ' 定义DMM KEITHLEY-2400
Public DMM2 As VisaComLib.FormattedIO488 ' 定义DMM HP-34401A
Public DMM3 As VisaComLib.FormattedIO488 ' 定义DMM HP-34907
Public DMM4 As VisaComLib.FormattedIO488 ' 定义DMM HP-6611C

'定义KEITHLEY-2400地址为24
'定义HP-34401A地址为22
'定义HP-34970地址为
'定义HP-6611C地址为5

'对KEITHLEY-2400操作
'打开设备
'=============================
Public Function keithley2400open()
    On Error GoTo ioerror
    Dim mgr1 As VisaComLib.ResourceManager
    Set mgr1 = New VisaComLib.ResourceManager
    Set DMM1 = New VisaComLib.FormattedIO488
    Set DMM1.IO = mgr1.Open("GPIB::24")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系统函数
'复位
'==============================================
Public Function keithley2400rst()
    On Error GoTo ioerror
    DMM1.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查询
'==============================================
Public Function keithley2400idn() As String
    On Error GoTo ioerror
    DMM1.WriteString "*IDN?"
    keithley2400idn = DMM1.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'版本
'==============================================
Public Function keithley2400vers() As String
    On Error GoTo ioerror
    DMM1.WriteString ":Syst:Vers?"
    keithley2400vers = DMM1.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'输出开
'==============================================
Public Function keithley2400outputon()
    On Error GoTo ioerror
    DMM1.WriteString ":OUTPUT ON"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'输出关
'==============================================
Public Function keithley2400outputoff()
    On Error GoTo ioerror
    DMM1.WriteString ":OUTPUT OFF"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置电压
'==============================================
Public Function keithley2400setvolatge(value As Single)
    On Error GoTo ioerror
    DMM1.WriteString ":SOUR:FUNC VOLT "
    DMM1.WriteString ":SOUR:VOLT " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置电流
'==============================================
Public Function keithley2400setcurrent(value As Single)
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:volt:RANG 2 "
    'DMM1.WriteString ":SOUR:volt:LEV 2 "
    DMM1.WriteString ":SOUR:FUNC CURR "
    DMM1.WriteString ":SOUR:CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测试电压
'==============================================
Public Function keithley2400sensvolatge() As Single
    
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:FUNC VOLT "
    'DMM1.WriteString "*rst"
    'DMM1.WriteString ":SENS:FUNC :OFF:ALL"
    DMM1.WriteString ":SENS:FUNC:ON 'VOLT'"
    DMM1.WriteString ":OUTPUT ON"
    'DMM1.WriteString ":READ?"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测试电流
'==============================================
Public Function keithley2400senscurrent(value As Single)
    On Error GoTo ioerror
    'DMM1.WriteString ":SOUR:VOLT:RANG 2 "
    'DMM1.WriteString ":SOUR:VOLT:LEV 2 "
    DMM1.WriteString ":SOUR:FUNC CURR "
    DMM1.WriteString ":SOUR:CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'对HP-34401A操作
'打开设备
'=============================
Public Function hp34401aopen()
    On Error GoTo ioerror
    Dim mgr2 As VisaComLib.ResourceManager
    Set mgr2 = New VisaComLib.ResourceManager
    Set DMM2 = New VisaComLib.FormattedIO488
    Set DMM2.IO = mgr2.Open("GPIB::22")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系统查询函数
'查询
'==============================================
Public Function hp34401aidn() As String
    On Error GoTo ioerror
    DMM2.WriteString "*IDN?"
    hp34401aidn = DMM2.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'版本
'==============================================
Public Function hp34401avers() As String
    On Error GoTo ioerror
    DMM2.WriteString ":Syst:Vers?"
    hp34401avers = DMM2.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'复位
'==============================================
Public Function hp34401arst()
    On Error GoTo ioerror
    DMM2.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量1次直流电压
'==============================================
Public Function hp34401ameasuredcvoltage() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Voltage:DC?"
    hp34401ameasuredcvoltage = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量1次交流电压
'==============================================
Public Function hp34401ameasureacvoltage() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Voltage:AC?"
    hp34401ameasureacvoltage = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量1次直流电流
'==============================================
Public Function hp34401ameasuredccurrent() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Current:DC?"
    hp34401ameasuredccurrent = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量1次交流电流
'==============================================
Public Function hp34401ameasureaccurrent() As Single
    On Error GoTo ioerror
    DMM2.WriteString "Measure:Current:AC?"
    hp34401ameasureaccurrent = DMM2.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'对HP-6611C操作
'打开设备
'=============================
Public Function hp6611copen()
    On Error GoTo ioerror
    Dim mgr3 As VisaComLib.ResourceManager
    Set mgr3 = New VisaComLib.ResourceManager
    Set DMM3 = New VisaComLib.FormattedIO488
    Set DMM3.IO = mgr3.Open("GPIB::5")
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'系统查询函数
'复位
'==============================================
Public Function hp6611crst()
    On Error GoTo ioerror
    DMM3.WriteString "*RST"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查询设备
'==============================================
Public Function hp6611cidn() As String
    On Error GoTo ioerror
    DMM3.WriteString "*IDN?"
    hp6611cidn = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查询版本
'==============================================
Public Function hp6611cvers() As String
    On Error GoTo ioerror
    DMM3.WriteString ":Syst:Vers?"
    hp6611cvers = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查询系统错误
'==============================================
Public Function hp6611csyserror() As String
    On Error GoTo ioerror
    DMM3.WriteString ":SYSTem:ERRor?"
    hp6611csyserror = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'查询系统语言
'==============================================
Public Function hp6611csyslanguage() As String
    On Error GoTo ioerror
    DMM3.WriteString ":SYSTem:LANGuage?"
    hp6611csyslanguage = DMM3.ReadString
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量函数
'测量电流
'==============================================
Public Function hp6611cmeasurecurrent() As Single
    On Error GoTo ioerror
    DMM3.WriteString ":MEASure:CURRent?"
    hp6611cmeasurecurrent = DMM3.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'测量电压
'==============================================
Public Function hp6611cmeasurevoltage() As Single
    On Error GoTo ioerror
    DMM3.WriteString ":MEASure:VOLTage?"
    hp6611cmeasurevoltage = DMM3.ReadNumber
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置电压
'==============================================
Public Function hp6611csetvoltage(value As Single)
    On Error GoTo ioerror
    DMM3.WriteString " VOLT " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置电流
'==============================================
Public Function hp6611csetcurrent(value As Single)
    On Error GoTo ioerror
    DMM3.WriteString " CURR " & value
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置输出开
'==============================================
Public Function hp6611coutputon()
    On Error GoTo ioerror
    DMM3.WriteString ":OUTPut ON"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function

'设置输出关
'==============================================
Public Function hp6611coutputoff()
    On Error GoTo ioerror
    DMM3.WriteString ":OUTPut OFF"
    Exit Function
ioerror:
    MsgBox "Set IO error:" & vbCrLf & Err.Description
End Function