e1968 driver.bas

通过VB, GPIB协议控制测试仪器, 实现测试自动化, 这个行业的人才有些缺乏, 本人愿意分享

    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)

    If Trim(strres) = "1" Then
        EndCall_E1968 = True
    Else
        EndCall_E1968 = False
    End If
    
Error1:
End Function

Public Function Start_DataConnect_E1968(ByVal iGPIBHandle As Integer, ByVal sIMSI As String) As Boolean
Dim sCommand As String
Dim argCount As String
Dim i As Integer
    On Error GoTo Error1
    sCommand = "CALL:FUNC:CONN:TYPE BLER; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    TimeDelay (1000)

    sCommand = "CALL:STAT:DATA?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)

    If Trim(strres) = "ATT" Then

    sCommand = "CALL:FUNC:DATA:STAR; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:TRAN?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If Trim(strres) = "1" Then
        Start_DataConnect_E1968 = True
    Else
        Start_DataConnect_E1968 = False
    End If


Error1:
End Function

Public Function EndDataConnect_E1968(ByVal iGPIBHandle As Integer) As Boolean
Dim sCommand As String
Dim argCount As String

    On Error GoTo Error1

    sCommand = "CALL:FUNC:DATA:STOP; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    TimeDelay (1000)

    sCommand = "CALL:CONN:STAT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (10)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)

    If Trim(strres) = "ATT" Then
        EndCall_E1968 = True
    Else
        EndCall_E1968 = False
    End If

Error1:
End Function

Public Function InitTests_E1968(ByVal iGPIBHandle As Integer, ByVal sTestItems As String) As Boolean
Dim sCommand As String
Dim argCount As String

    On Error GoTo Error1

    sCommand = "INIT:" & sTestItems & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (1000)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If Trim(strres) = "1" Then
        InitTests_E1968 = True
    Else
        InitTests_E1968 = False
    End If

Error1:
End Function

Public Function InitDone_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    InitDone_E1968 = "ERROR"
    
    On Error GoTo Error1

    sCommand = "INIT:DONE?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    InitDone_E1968 = strres

Error1:
End Function

Public Function FetchPVT_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    FetchPVT_E1968 = "Error"
    
    On Error GoTo Error1
    sCommand = "FETC:PVT:INT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    If InStr(strres, "0") > 0 Then
    
        sCommand = "FETC:PVT:MASK?" & vbCrLf
        'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
        argCount = ivprintf(iGPIBHandle, sCommand)
        TimeDelay (50)
        Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
        FetchPVT_E1968 = strres
    Else
        FetchPVT_E1968 = "NonDone"
    End If

Error1:
End Function

Public Function FetchPFER_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    FetchPFER_E1968 = "Error"
    
    On Error GoTo Error1
    
    sCommand = "FETC:PFER?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    FetchPFER_E1968 = strres

Error1:
End Function

Public Function FetchORFS_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    FetchORFS_E1968 = "Error"
    
    On Error GoTo Error1
    
    sCommand = "FETC:ORFS:INT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If InStr(strres, "0") > 0 Then
        sCommand = "FETC:ORFS:LIMIT?" & vbCrLf
        'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
        argCount = ivprintf(iGPIBHandle, sCommand)
        TimeDelay (50)
        Call iread(iGPIBHandle, strres, 80, 0&, actual)
        FetchORFS_E1968 = strres
    Else
        FetchORFS_E1968 = "NoneDone"
    End If

Error1:
End Function

Public Function FetchORFS1_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    FetchORFS1_E1968 = "Error"
    
    On Error GoTo Error1
    
    sCommand = "FETC:ORFS:INT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If InStr(strres, "0") > 0 Then
        sCommand = "FETC:ORFS:MOD:LIMIT?" & vbCrLf
        'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
        argCount = ivprintf(iGPIBHandle, sCommand)
        TimeDelay (50)
        Call iread(iGPIBHandle, strres, 80, 0&, actual)
        
        FetchORFS1_E1968 = strres

        sCommand = "FETC:ORFS:SWIT:LIMIT?" & vbCrLf
        'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
        argCount = ivprintf(iGPIBHandle, sCommand)
        TimeDelay (50)
        Call iread(iGPIBHandle, strres, 80, 0&, actual)

        FetchORFS1_E1968 = FetchORFS1_E1968 & "," & strres
    Else
        FetchORFS1_E1968 = "NoneDone"
    End If

Error1:
End Function

Public Function FetchTxPower_E1968(ByVal iGPIBHandle As Integer) As String
Dim sCommand As String
Dim argCount As String

    FetchTxPower_E1968 = "Error"
    
    On Error GoTo Error1
    
    sCommand = "FETC:TXP:INT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If InStr(strres, "0") > 0 Then
        sCommand = "FETC:TXP:POW?" & vbCrLf
        'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
        argCount = ivprintf(iGPIBHandle, sCommand)
        TimeDelay (50)
        Call iread(iGPIBHandle, strres, 80, 0&, actual)
        
        FetchTxPower_E1968 = strres

    Else
        FetchTxPower_E1968 = "NoneDone"
    End If

Error1:
End Function

Public Function ReConfigCall_E1968(ByVal iGPIBHandle As Integer, ByVal sBand As String, ByVal iTch As Integer, ByVal iMSTxLevel As Integer) As Boolean
Dim sCommand As String
Dim argCount As String

  
    On Error GoTo Error1
    
    sCommand = "CALL:SET:TCH:BAND " & sBand & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:SET:TCH " & iTch & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:SET:TCH:MS:TXL " & iMSTxLevel & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:HAND; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    TimeDelay (500)
    
    sCommand = "CALL:STAT:STAT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If InStr(strres, "CONN") > 0 Then
        ReConfigCall_E1968 = True
    Else
        ReConfigCall_E1968 = False
    End If

Error1:
End Function

Public Function ReConfigData_E1968(ByVal iGPIBHandle As Integer, ByVal sPDTCHBand As String, ByVal iPDTch As Integer, ByVal iMSTxLevel As Integer) As Boolean
Dim sCommand As String
Dim argCount As String

  
    On Error GoTo Error1
    
    sCommand = "CALL:SET:PDTCH:BAND " & sPDTCHBand & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:SET:PDTCH " & iPDTch & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:SET:PDTCH:MS:TXL:DCS:BURS " & iMSTxLevel & "; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    sCommand = "CALL:HAND; *OPC?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    TimeDelay (500)
    
    sCommand = "CALL:STAT:STAT?" & vbCrLf
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (50)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    If InStr(strres, "TRAN") > 0 Then
        ReConfigCall_E1968 = True
    Else
        ReConfigCall_E1968 = False
    End If

Error1:
End Function


Public Function Get_RxQuality_E1968(ByVal iGPIBHandle As Integer, ByVal sBSLevel As Single) As Single
Dim sCommand As String
Dim argCount As Integer
Dim strres As String * 80
Dim actual As Long
Dim i As Integer
    Get_RxQuality_E1968 = 99.9
    On Error GoTo Error1
    sCommand = "PROC:SET:POWER:CMD " & Str(sBSLevel) & "; *OPC?" & vbCrLf
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (100)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    
    i = 0
Do
    sCommand = "SENSE:SIGNALLING:RXQUAL?" & vbCrLf
    argCount = ivprintf(iGPIBHandle, sCommand)
    TimeDelay (100)
    Call iread(iGPIBHandle, strres, 80, 0&, actual)
    If InStr(strres, "NAN") <= 0 Then
       Exit Do
    End If
    i = i + 1
Loop Until i > 5

If i <= 5 Then
    Get_RxQuality_E1968 = CSng(Trim(strres))

End If
Error1:
End Function



Public Sub ReturnIdle_E1968(ByVal iGPIBHandle As Integer)
Dim sCommand As String
Dim argCount As Integer
    On Error GoTo Error1
    sCommand = "PROC:SELECT NONE" & Chr$(10)
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
Error1:
End Sub



Public Sub ExitRemote_E1968(ByVal iGPIBHandle As Integer)
Dim sCommand As String
Dim argCount As Integer
    On Error GoTo Error1
    sCommand = "SYSTEM:STATE:LOCAL" & Chr$(10)
    'Call iwrite(iGPIBHandle, sCommand, Len(sCommand), 1, 0&)
    argCount = ivprintf(iGPIBHandle, sCommand)
Error1:
End Sub