test.bas

这个程序包的主要功能是对多台5101b进行功能化测试

Attribute VB_Name = "Module1"
Option Base 1

Declare Function outp Lib "pio.dll" (ByVal X As Integer, ByVal Y As Integer) As Integer
Declare Function inp Lib "pio.dll" (ByVal X As Integer) As Integer

Public Const GPIBIO = 784 - 3
Public Const METERADDS = 22
Public Const SWITCHADDS = 5
Public Const SOURCE57ADDS = 4
Public SOURCEADDS(10) As Integer

Public Number As Integer

Public keyflag, cnohmflag, cndciflag, cndcvflag As Integer
Public Saveflag As Integer
Public IEEnoteflag As Integer

Public temp As String

Public chdcvFS(10, 15) As String    'check dcv Full Scale point
Public chdciFS(10, 6) As String
Public chohmFS(10, 10) As String
Public chacvFS(10, 15) As String

Public msdcvTP(10, 38) As String     'measure dcv test point
Public msdciTP(10, 14) As String
Public msaci51(10, 52) As String
Public msaci57(52) As String
Public msaciTP(10, 52) As String
Public msrTP(10, 8) As String
Public msacvTP(10, 50) As String
Public msacv51(10, 9) As String
Public msacv57(9) As String
Public msacvHTP(10, 9) As String


Public chdcv As Variant           'check dcv test point
Public chdci As Variant
Public chohm As Variant
Public chacv As Variant


Public msdcv As Variant           'measure dcv test point
Public msdci As Variant
Public msaci As Variant
Public msr As Variant
Public msacv As Variant
Public msacvH As Variant

Public dcvrange, dcirange, acirange, acvrange, acvHrange As Variant

Public specdc, specdc1, specdc2, specdc3 As Variant
Public specohm, specohm1, specohm2, specohm3 As Variant
Public specacv, specacv1, specacv2, specacv3 As Variant
Public specaci, specaci1, specaci2, specaci3 As Variant
'初始化
Public Sub initialize()
   outp GPIBIO + 8, 1
   delay 1
   outp GPIBIO + 5, 2
   delay 1
   outp GPIBIO + 4, 1
   delay 1
   outp GPIBIO + 6, 32
   delay 1
   outp GPIBIO + 6, 192
   delay 1
   outp GPIBIO + 5, 0
   delay 1
   outp GPIBIO + 5, 31
   delay 1
   outp GPIBIO + 5, 30
   delay 1
   outp GPIBIO + 5, 22
End Sub
'发送程控命令
Public Sub send_order(order As String, n As Integer)
Dim L As Integer
Dim i As Integer
Dim C As Integer
Dim status As Integer

    outp GPIBIO + 5, 17
    outp GPIBIO, 64                     'speaker(488)'s adds
    receive_interrupt_check
    If n = 0 Then
       outp GPIBIO, 32 + METERADDS      'listener(source or meter)'s adds
    ElseIf n = 11 Then
       outp GPIBIO, 32 + SWITCHADDS
    ElseIf n = 20 Then
       outp GPIBIO, 32 + SOURCE57ADDS
    Else
       outp GPIBIO, 32 + SOURCEADDS(n)
    End If
    receive_interrupt_check
    outp GPIBIO + 5, 16
    order = order & vbCrLf              'add "\r\n"
    L = Len(order)
    For i = 1 To L
        C = Asc(Mid(order, i, 1))
        outp GPIBIO, C                  'output one char
        delay 1
        Do
            status = inp(GPIBIO + 1)
        Loop While (status And 2) = 0
    Next
End Sub

'接收数据
Public Sub receive_data(data As String, n As Integer)
Dim C As Integer
Dim status As Integer
Dim count As Long
    
    count = 0
    data = ""
    outp GPIBIO + 5, 17
    If n = 0 Then
       outp GPIBIO, 64 + METERADDS     'speaker(source or meter)'s adds
    Else
       outp GPIBIO, 64 + SOURCEADDS(n)
    End If
    receive_interrupt_check
    outp GPIBIO, 32                     'listener(488)'s adds
    receive_interrupt_check
    outp GPIBIO + 5, 16
    delay 1
    Do
       Do
         count = count + 1              ' note IEE488 interface no pass
         If count > 1000000 Then
            MsgBox "请检查IEEE488接口的连接!", vbOKOnly + vbCritical, "IEEE488 Connect"
            'IEEnoteflag = 1
            'fomnote488.Show 1
            Exit Sub
         End If
         
         status = inp(GPIBIO + 1)
       '  wait 1
         Loop While (status And 1) = 0    'status=1 means one char has arrived
       C = inp(GPIBIO)
       If C <> 10 Then
           data = data & Chr(C)
       End If
    Loop While C <> 10
End Sub
'判断GPIB命令是否被受控设备接收
Public Sub receive_interrupt_check()
Dim status As Byte
      Do
         status = inp(GPIBIO + 2)
      Loop While (status And 8) = 0
End Sub
Public Sub wait(p As Single)
'p is PauseTime(seconds).
    Start = Timer               ' Set start time.
    Do While Timer < Start + p
        DoEvents                ' Yield to other processes.
    Loop
End Sub
Public Sub delay(X As Integer)
'x is DelayTime(milliseconds).
    Start = Timer               ' Set start time.
    Do While Timer < Start + X / 1000
        
        DoEvents                ' Yield to other processes.
    Loop
   ' Dim i As Long
   'For i = 1 To X * 4000
   '    i = i + 1
   'Next i
End Sub
'使系统中各设备处于不讲状态
Public Sub untalking()
   outp GPIBIO + 5, 17
   outp GPIBIO, 95
   receive_interrupt_check
   outp GPIBIO + 5, 16
End Sub