vbib-32.bas

广泛用于示波器上的gpig工业标准接口的计算机编成库

    
    Call copy_ibvars
End Function

Function ilwait(ud%, mask%) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameters into Longs.
    tmpUD& = CLng(ud%)
    tmpmask& = CLng(mask%)
    
' Call the 32-bit DLL.
    rc& = ibwait32(ByVal tmpUD&, ByVal tmpmask&)
    
    ilwait% = ConvertLongToInt(rc&)
    
    Call copy_ibvars
End Function

Function ilwrt(ud%, buf$, cnt&) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameters into Longs.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    rc& = ibwrt32(ByVal tmpUD&, ByVal buf$, ByVal cnt&)
    
    ilwrt% = ConvertLongToInt(rc&)
    
    Call copy_ibvars
End Function

Function ilwrta(ud%, buf$, cnt&) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameters into Longs.
    tmpUD& = CLng(ud%)

' Convert Unicode string into ANSI string. This
' prevents Visual Basic from remapping the buffer.
    bytebuf = StrConv(buf$, vbFromUnicode)
    
' Call the 32-bit DLL. Pass it the ANSI string.
    rc& = ibwrta32(ByVal tmpUD&, bytebuf(0), ByVal cnt&)

    ilwrta% = ConvertLongToInt(rc&)
    
    Call copy_ibvars
   
End Function

Function ilwrtf(ud%, filename$) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Convert Integer parameter into Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    rc& = ibwrtf32(ByVal tmpUD&, ByVal filename$)

    ilwrtf% = ConvertLongToInt(rc&)

    Call copy_ibvars
End Function

Function ilwrti(ud%, ibuf%(), cnt&) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Convert Integer parameters into Longs.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    rc& = ibwrt32(ByVal tmpUD&, ibuf%(0), ByVal cnt&)

    ilwrti% = ConvertLongToInt(rc&)

    Call copy_ibvars
End Function

Function ilwrtia(ud%, ibuf%(), cnt&) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Convert Integer parameters into Longs.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    rc& = ibwrt32(ByVal tmpUD&, ibuf%(0), ByVal cnt&)

' When Visual Basic remapping buffer problem solved, use this:
'    rc& = ibwrta32(ByVal tmpUD&, ibuf%(0), ByVal cnt&)

    ilwrtia% = ConvertLongToInt(rc&)

    Call copy_ibvars
End Function

Function ilwrtkey(ud%, buf$, cnt&) As Integer
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Convert Integer parameter into Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    rc& = ibwrtkey32(ByVal tmpUD&, ByVal buf$, ByVal cnt&)

    ilwrtkey% = ConvertLongToInt(rc&)

    Call copy_ibvars
End Function

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)

' Call the 32-bit DLL.
    Call PassControl32(ByVal tmpUD&, ByVal tmpaddr&)

    Call copy_ibvars
End Sub

Sub Ppoll(ud%, result%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call PPoll32(ByVal tmpUD&, tmpresult&)

    result% = ConvertLongToInt(tmpresult&)
    
    Call copy_ibvars
End Sub

Sub PpollConfig(ud%, addr%, lline%, sense%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)
    tmpline& = CLng(lline%)
    tmpsense& = CLng(sense%)
    
' Call the 32-bit DLL.
    Call PPollConfig32(ByVal tmpUD&, ByVal tmpaddr&, ByVal tmpline&, ByVal tmpsense&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call PPollUnconfig32(ByVal tmpUD&, addrs%(0))

    Call copy_ibvars
End Sub

Sub RcvRespMsg(ud%, buf$, term%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    cnt& = CLng(Len(buf$))
    tmpterm& = CLng(term%)

' Call the 32-bit DLL.
    Call RcvRespMsg32(ByVal tmpUD&, ByVal buf$, ByVal cnt&, ByVal tmpterm&)
    
    Call copy_ibvars
End Sub

Sub ReadStatusByte(ud%, addr%, result%)
    Static addr_list%(2)
    
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)
    
' Call the 32-bit DLL.
    Call ReadStatusByte32(ByVal tmpUD&, ByVal tmpaddr&, tmpresult&)

    result% = ConvertLongToInt(tmpresult&)
    
    Call copy_ibvars
End Sub

Sub Receive(ud%, addr%, buf$, term%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)
    cnt& = CLng(Len(buf$))
    tmpterm& = CLng(term%)

' Call the 32-bit DLL.
    Call Receive32(ByVal tmpUD&, ByVal tmpaddr&, ByVal buf$, ByVal cnt&, ByVal tmpterm&)

    Call copy_ibvars
End Sub

Sub ReceiveSetup(ud%, addr%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)

' Call the 32-bit DLL.
    Call ReceiveSetup32(ByVal tmpUD&, ByVal tmpaddr&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
 
' Call the 32-bit DLL.
    Call ResetSys32(ByVal tmpUD&, addrs%(0))
    
    Call copy_ibvars
End Sub

Sub Send(ud%, addr%, buf$, term%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)
    cnt& = CLng(Len(buf$))
    tmpterm& = CLng(term%)

' Call the 32-bit DLL.
    Call Send32(ByVal tmpUD&, ByVal tmpaddr&, ByVal buf$, ByVal cnt&, ByVal tmpterm&)
    
    Call copy_ibvars
End Sub

Sub SendCmds(ud%, cmdbuf$)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    cnt& = CLng(Len(cmdbuf$))

' Call the 32-bit DLL.
    Call SendCmds32(ByVal tmpUD&, ByVal cmdbuf$, ByVal cnt&)

    Call copy_ibvars
End Sub

Sub SendDataBytes(ud%, buf$, term%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    cnt& = CLng(Len(buf$))
    tmpterm& = CLng(term%)

' Call the 32-bit DLL.
    Call SendDataBytes32(ByVal tmpUD&, ByVal buf$, ByVal cnt&, ByVal tmpterm&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call SendIFC32(ByVal tmpUD&)

    Call copy_ibvars
End Sub

Sub SendList(ud%, addr%(), buf$, term%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameters to Longs.
    tmpUD& = CLng(ud%)
    cnt& = CLng(Len(buf$))
    tmpterm& = CLng(term%)

' Call the 32-bit DLL.
    Call SendList32(ByVal tmpUD&, addr%(0), ByVal buf$, ByVal cnt&, ByVal tmpterm&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call SendLLO32(ByVal tmpUD&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call SendSetup32(ByVal tmpUD&, addrs%(0))

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call SetRWLS32(ByVal tmpUD&, addrs%(0))

    Call copy_ibvars
End Sub

Sub TestSRQ(ud%, result%)
    Call ibwait(ud%, 0)
 
    If ibsta% And &H1000 Then
        result% = 1
    Else
        result% = 0
    End If
    
End Sub

Sub TestSys(ud%, addrs%(), results%())
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
 
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call TestSys32(ByVal tmpUD&, addrs%(0), results%(0))
    
    Call copy_ibvars
End Sub

Sub Trigger(ud%, addr%)
' Check to see if GPIB Global variables are registered
    If (GPIBglobalsRegistered = 0) Then
      Call RegisterGPIBGlobals
    End If
    
' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)
    tmpaddr& = CLng(addr%)

' Call the 32-bit DLL.
    Call Trigger32(ByVal tmpUD&, ByVal tmpaddr&)

    Call copy_ibvars
End Sub

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

' Convert Integer parameter to Long.
    tmpUD& = CLng(ud%)

' Call the 32-bit DLL.
    Call TriggerList32(ByVal tmpUD&, addrs%(0))

    Call copy_ibvars
End Sub

Sub WaitSRQ(ud%, result%)
    
    Call ibwait(ud%, &H5000)

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


Private Function ConvertLongToInt(LongNumb&) As Integer

  If (LongNumb& > 32767) Then
  ' Make Long "Unsigned" Int into Short Signed Int.
    tmpnumb& = LongNumb& - 32768
    ConvertLongToInt% = tmpnumb& + &H8000
  ElseIf (LongNumb& < 0) Then
    If (LongNumb& = -1) Then
    ' If Long Int = -1, then Short Int = -1.
      ConvertLongToInt% = -1
    Else
    ' If Long Int is a HUGE "negative" number. then
    ' "truncate" upper word, then convert Long to Short.
      tmpnumb& = LongNumb& And &H7FFF
      ConvertLongToInt% = CInt(tmpnumb&)
    End If
  Else
  ' Perform normal conversion.
    ConvertLongToInt% = CInt(LongNumb&)
  End If
    
End Function

Public Sub RegisterGPIBGlobals()
    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
      MsgBox "Operating System is not multi-threaded. Quitting the Program!", 16
      rc& = UnregisterGpibGlobalsForThread
      End
    ElseIf (rc& = 3) Then
      MsgBox "Unable to register GPIB thread globals. Quitting the Program!", 16
      rc& = UnregisterGpibGlobalsForThread
      End
    Else
      MsgBox "Unknown Error for Registering GPIB Globals!!! Quitting the Program!", 16
      End
    End If
End Sub

Public Sub UnregisterGPIBGlobals()
    rc& = UnregisterGpibGlobalsForThread
    If (rc& = 0) Then
      GlobalsRegistered = 0
    ElseIf (rc& = 1) Then
      GlobalsRegistered = 0
    ElseIf (rc& = 2) Then
      MsgBox "Operating System is not multi-threaded. Quitting the Program!", 16
      rc& = UnregisterGpibGlobalsForThread
      End
    ElseIf (rc& = 3) Then
      MsgBox "Unable to unregister GPIB thread globals. Quitting the Program!", 16
      rc& = UnregisterGpibGlobalsForThread
      End
    Else
      MsgBox "Unknown Error for Unregistering GPIB Globals!!! Quitting the Program!", 16
      End
    End If
End Sub



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

    ThreadIbsta% = ConvertLongToInt(rc&)
End Function

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

    ThreadIberr% = ConvertLongToInt(rc&)
End Function

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

    ThreadIbcnt% = ConvertLongToInt(rc&)
End Function

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