vbib-32.bas

LDO在线测试程序

    Dim tmpresult As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call PPoll32(ud, tmpresult)

    result = ConvertLongToInt(tmpresult)

    Call copy_ibvars
End Sub

Sub PpollConfig(ByVal ud As Integer, ByVal addr As Integer, ByVal lline As Integer, ByVal sense As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call PPollConfig32(ud, addr, lline, sense)

    Call copy_ibvars
End Sub

Sub PpollUnconfig(ByVal ud As Integer, addrs() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call PPollUnconfig32(ud, addrs(0))

    Call copy_ibvars
End Sub

Sub RcvRespMsg(ByVal ud As Integer, buf As String, ByVal term As Integer)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(buf))

' Call the 32-bit DLL.
    Call RcvRespMsg32(ud, ByVal buf, cnt, term)

    Call copy_ibvars
End Sub

Sub ReadStatusByte(ByVal ud As Integer, ByVal addr As Integer, result As Integer)
    Dim tmpresult As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call ReadStatusByte32(ud, addr, tmpresult)

    result = ConvertLongToInt(tmpresult)

    Call copy_ibvars
End Sub

Sub Receive(ByVal ud As Integer, ByVal addr As Integer, buf As String, ByVal term As Integer)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(buf))

' Call the 32-bit DLL.
    Call Receive32(ud, addr, ByVal buf, cnt, term)

    Call copy_ibvars
End Sub

Sub ReceiveSetup(ByVal ud As Integer, ByVal addr As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call ReceiveSetup32(ud, addr)

    Call copy_ibvars
End Sub

Sub ResetSys(ByVal ud As Integer, addrs() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call ResetSys32(ud, addrs(0))

    Call copy_ibvars
End Sub

Sub Send(ByVal ud As Integer, ByVal addr As Integer, ByVal buf As String, ByVal term As Integer)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(buf))

' Call the 32-bit DLL.
    Call Send32(ud, addr, ByVal buf, cnt, term)

    Call copy_ibvars
End Sub

Sub SendCmds(ByVal ud As Integer, ByVal cmdbuf As String)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(cmdbuf))

' Call the 32-bit DLL.
    Call SendCmds32(ud, ByVal cmdbuf, cnt)

    Call copy_ibvars
End Sub

Sub SendDataBytes(ByVal ud As Integer, ByVal buf As String, ByVal term As Integer)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(buf))

' Call the 32-bit DLL.
    Call SendDataBytes32(ud, ByVal buf, cnt, term)

    Call copy_ibvars
End Sub

Sub SendIFC(ByVal ud As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call SendIFC32(ud)

    Call copy_ibvars
End Sub

Sub SendList(ByVal ud As Integer, addr() As Integer, ByVal buf As String, ByVal term As Integer)
    Dim cnt As Long

' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

    cnt = CLng(Len(buf))

' Call the 32-bit DLL.
    Call SendList32(ud, addr(0), ByVal buf, cnt, term)

    Call copy_ibvars
End Sub

Sub SendLLO(ByVal ud As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call SendLLO32(ud)

    Call copy_ibvars
End Sub

Sub SendSetup(ByVal ud As Integer, addrs() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call SendSetup32(ud, addrs(0))

    Call copy_ibvars
End Sub

Sub SetRWLS(ByVal ud As Integer, addrs() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call SetRWLS32(ud, addrs(0))

    Call copy_ibvars
End Sub

Sub TestSRQ(ByVal ud As Integer, result As Integer)
    Call ibwait(ud, 0)

    If ibsta And &H1000 Then
        result = 1
    Else
        result = 0
    End If

End Sub

Sub TestSys(ByVal ud As Integer, addrs() As Integer, results() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call TestSys32(ud, addrs(0), results(0))

    Call copy_ibvars
End Sub

Sub Trigger(ByVal ud As Integer, ByVal addr As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call Trigger32(ud, addr)

    Call copy_ibvars
End Sub

Sub TriggerList(ByVal ud As Integer, addrs() As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call TriggerList32(ud, addrs(0))

    Call copy_ibvars
End Sub

Sub WaitSRQ(ByVal ud As Integer, result As Integer)
    Call ibwait(ud, &H5000)

    If ibsta And &H1000 Then
        result = 1
    Else
        result = 0
    End If
End Sub


Private Function ConvertLongToInt(LongNumb As Long) As Integer

  If (LongNumb And &H8000&) = 0 Then
      ConvertLongToInt = LongNumb And &HFFFF&
  Else
    ConvertLongToInt = &H8000 Or (LongNumb And &H7FFF&)
  End If

End Function

Public Sub RegisterGPIBGlobals()
    Dim rc As Long

    rc = RegisterGpibGlobalsForThread(Longibsta, Longiberr, Longibcnt, ibcntl)
    If (rc = 0) Then
      GPIBglobalsRegistered = 1
    ElseIf (rc = 1) Then
      rc = UnregisterGpibGlobalsForThread
      rc = RegisterGpibGlobalsForThread(Longibsta, Longiberr, Longibcnt, ibcntl)
      GPIBglobalsRegistered = 1
    ElseIf (rc = 2) Then
      rc = UnregisterGpibGlobalsForThread
      ibsta = &H8000
      iberr = EDVR
      ibcntl = &HDEAD37F0
    ElseIf (rc = 3) Then
      rc = UnregisterGpibGlobalsForThread
      ibsta = &H8000
      iberr = EDVR
      ibcntl = &HDEAD37F0
    Else
      ibsta = &H8000
      iberr = EDVR
      ibcntl = &HDEAD37F0
    End If
End Sub

Public Sub UnregisterGPIBGlobals()
    Dim rc As Long

    rc = UnregisterGpibGlobalsForThread
    GPIBglobalsRegistered = 0

End Sub



Public Function ThreadIbsta() As Integer
' Call the 32-bit DLL.
    ThreadIbsta = ConvertLongToInt(ThreadIbsta32())
End Function

Public Function ThreadIberr() As Integer
' Call the 32-bit DLL.
    ThreadIberr = ConvertLongToInt(ThreadIberr32())
End Function

Public Function ThreadIbcnt() As Integer
' Call the 32-bit DLL.
    ThreadIbcnt = ConvertLongToInt(ThreadIbcnt32())
End Function

Public Function ThreadIbcntl() As Long
' Call the 32-bit DLL.
    ThreadIbcntl = ThreadIbcntl32()
End Function

Public Function illock(ByVal ud As Integer) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    illock = ConvertLongToInt(iblock32(ud))

    Call copy_ibvars
End Function

Public Function ilunlock(ByVal ud As Integer) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    ilunlock = ConvertLongToInt(ibunlock32(ud))

    Call copy_ibvars
End Function

Public Sub iblock(ByVal ud As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call iblock32(ud)

    Call copy_ibvars
End Sub

Public Sub ibunlock(ByVal ud As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call ibunlock32(ud)

    Call copy_ibvars
End Sub

Public Function illockx(ByVal ud As Integer, ByVal LockWaitTime As Integer, ByVal buf As String) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    illockx = ConvertLongToInt(iblockx32(ud, LockWaitTime, buf))

    Call copy_ibvars
End Function

Public Function ilunlockx(ByVal ud As Integer) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    ilunlockx = ConvertLongToInt(ibunlockx32(ud))

    Call copy_ibvars
End Function

Public Sub iblockx(ByVal ud As Integer, ByVal LockWaitTime As Integer, ByVal buf As String)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call iblockx32(ud, LockWaitTime, buf)

    Call copy_ibvars
End Sub

Public Sub ibunlockx(ByVal ud As Integer)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Call the 32-bit DLL.
    Call ibunlockx32(ud)

    Call copy_ibvars
End Sub