VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "AgilentIO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'agilent demo
Private Rm As VisaComLib.ResourceManager
Private Instrument As VisaComLib.FormattedIO488
Private InitFlag As Boolean

'init agilent io
Function IOInit(addr) As Boolean
    
    On Error GoTo myErr
    Set Rm = New VisaComLib.ResourceManager
    Set Instrument = New VisaComLib.FormattedIO488
    Set Instrument.IO = Rm.Open(addr)
    Instrument.IO.Timeout = 300000
    Instrument.IO.TerminationCharacterEnabled = True
    InitFlag = True
    IOInit = True
    Exit Function
myErr:
    InitFlag = False
    IOInit = False
    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有能够初始化IO！"
        Exit Function
    End If
    
End Function
'write string agilent io
Sub IOSendStr(Command As String)

    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Sub
    End If
    Call Instrument.WriteString(Command)

End Sub
Sub WriteString(Command As String)

    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Sub
    End If
    Instrument.WriteString Command

End Sub
'read string agilent io
Function IOReadStr() As String

    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Function
    End If
    IOReadStr = Instrument.ReadString()
    
End Function
Function ReadString() As String

    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Function
    End If
    ReadString = Instrument.ReadString()
    
End Function
'read number agilent io
Function IOReadNumber() As Variant

    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Function
    End If
    IOReadNumber = Instrument.ReadNumber
    
End Function
'io opc
Sub IOOPC()
    
    Dim IOReadStr As String
    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Sub
    End If
    Call Instrument.WriteString("*OPC?")
    IOReadStr = Instrument.ReadNumber()
    While CInt(IOReadStr) <> 1
        DoEvents
        IOReadStr = CInt(Instrument.ReadNumber())
    Wend
    
End Sub
'io idn
Function IOidn() As String
    
    Dim IOReadStr As String
    If InitFlag = False Then
        On Error Resume Next
        Err.Raise 1000, "AgilentIO.cls", "没有初始化IO！"
        Exit Function
    End If
    Call Instrument.WriteString("*IDN?")
    IOidn = Instrument.ReadString()
    
End Function
Sub ResetIO()
    
    Instrument.WriteString "*RST"
    Instrument.WriteString "*WAI"
    
End Sub
Sub DropIO()

    Set Rm = Nothing
    Set Instrument = Nothing
    InitFlag = False
    
End Sub

Function readImgFile(fileName As String)

    Dim tmp
    tmp = "MMEM:STOR:IMAG " + """" + fileName + """"
    Instrument.WriteString "MMEM:STOR:IMAG " + """" + fileName + """"
    tmp = "MMEM:TRAN? " + """" + fileName + """"
    Instrument.WriteString "MMEM:TRAN? " + """" + fileName + """"    '仪器中数据到表格
    
    readImgFile = Instrument.ReadIEEEBlock(BinaryType_UI1)

End Function
Function readCsvFile(fileName As String)

    Dim tmp
    tmp = "MMEM:STOR:CSV " + """" + fileName + """"
    Instrument.WriteString "MMEM:STOR:FDAT " + """" + fileName + """"
    tmp = "MMEM:TRAN? " + """" + fileName + """"
    Instrument.WriteString "MMEM:TRAN? " + """" + fileName + """"    '仪器中数据到表格
    
    readCsvFile = Instrument.ReadIEEEBlock(BinaryType_UI1)

End Function