gpib

这是两个关于VB控制CMU对手机的控制的源代码

 GPIB編程的兩個範例  
更多詳情,見:http://delta.126.com 
更多詳情,見:http://delta.126.com 
更多詳情,見:http://delta.126.com 
例一 

' Filename - Simple.frm' 
' This application demonstrates how to read from and write to the 
' Tektronix TDS 210 Two Channel Digital Real-Time Oscilloscope 
' using GPIB.' 
' This sample application is comprised of three basic parts:' 
' 1. Initialization 
' 2. Main Body 
' 3. Cleanup' 
' The Initialization portion consists of getting a handle to a 
' device and then clearing the device.' 
' In the Main Body, this application queries a device for its 
' identification code by issuing the '*IDN?' command. Many 
' instruments respond to this command with an identification string. 
' Note, 488.2 compliant devices are required to respond to this 
' command.' 
' The last step, Cleanup, takes the device offline.这部分为初始化的一些变量声明 

Option Explicit 

Const BDINDEX = 0                   ' Board Index 
Const PRIMARY_ADDR_OF_SCOPE = 17    ' Primary address of device  GPIB仪器的主要地址 
Const NO_SECONDARY_ADDR = 0         ' Secondary address of device  次要地址 
Const TIMEOUT = T100ms                ' Timeout value = 10 seconds  起时的时长 
Const EOTMODE = 1                   ' Enable the END message        字符串结束的信息 
Const EOSMODE = 0                   ' Disable the EOS mode       字符串结束的模式 

Const ARRAYSIZE = 1024              ' Size of read buffer      缓冲区长度 

Dim ErrMsg As String * 100             ' 一些变量的声明 
Dim Dev As Integer 
Dim ValueStr As String * ARRAYSIZE 
Dim ErrorMnemonic 


Private Sub GPIBCleanup(msg$)        '定义错误信息使用的函数 

   ' After each GPIB call, the application checks whether the call 
   ' succeeded. If an NI-488.2 call fails, the GPIB driver sets the 
   ' corresponding bit in the global status variable. If the call 
   ' failed, this procedure prints an error message, takes the device 
   ' offline and exits. 

   ErrorMnemonic = Array("EDVR", "ECIC", "ENOL", "EADR", "EARG", _ 
                         "ESAC", "EABO", "ENEB", "EDMA", "", _ 
                         "EOIP", "ECAP", "EFSO", "", "EBUS", _ 
                         "ESTB", "ESRQ", "", "", "", "ETAB") 

   ErrMsg$ = msg$ & Chr(13) & "ibsta = &H" & Hex(ibsta) & Chr(13) _ 
             & "iberr = " & iberr & " <" & ErrorMnemonic(iberr) & ">" 
   MsgBox ErrMsg$, vbCritical, "Error" 
   ilonl Dev%, 0      '如果出错,GPIB仪器就离线,断开远程连接 
   End 
End Sub 
Private Sub Form_Load()     '主函数 
' ======================================================================== 
'' INITIALIZATION SECTION 
'' ======================================================================== 
   ' The application brings the oscilloscope online using ildev. A 
   ' device handle, Dev, is returned and is used in all subsequent 
   ' calls to the device. 
   Dev% = ildev(BDINDEX, PRIMARY_ADDR_OF_SCOPE, NO_SECONDARY_ADDR, TIMEOUT, 
EOTMODE, EOSMODE)      '初始化仪器,所用变量在前面已经声明 
   If (ibsta And EERR) Then 
       ErrMsg = "Unable to open device" & Chr(13) & "ibsta = &H" & Hex(ibsta) & Chr 
(13) & "iberr = " & iberr 
       MsgBox ErrMsg, vbCritical, "Error" 
       End 
   End If       '如果出错显示的信息 

   ' The application resets the GPIB portion of the device by calling 
   ' ilclr. 
   ilclr Dev%       '清空GPIB装置 
   If (ibsta And EERR) Then 
       Call GPIBCleanup("Unable to clear device") 
   End If 

   ' The default command to be written to the oscilloscope is 
   ' displayed in the text box. 
ScopeCommand.Text = "READ?"     '设定要发送的命令字符串 
End Sub 

Public Sub RunCmd_Click() 

   Dim DisplayStr As String 
   ' ======================================================================== 
' 
'  MAIN BODY SECTION 
' 
'  In this application, the Main Body communicates with the instrument 
'  by writing a command to it and reading its response. This would be 
'  the right place to put other instrument communication. 
'' ======================================================================== 
   ' The application writes the text in ScopeCommand to the 
   ' oscilloscope. 
   ilwrt Dev%, ScopeCommand.Text, Len(ScopeCommand.Text) 
   If (ibsta And EERR) Then 
       Call GPIBCleanup("Unable to write to device") 
   End If                        '从GPIB卡送出命令,如果出错,则显示相关信息 

   ' The application reads the ASCII string from the oscilloscope 
   ' into the ValueStr variable. 
   ilrd Dev%, ValueStr$, Len(ValueStr$)    '从仪器读出数据,如果出错,则显示相关信息 
   If (ibsta And EERR) Then 
       Call GPIBCleanup("Unable to read from device") 
   End If 

   ' The oscilloscope returns a Line Feed character with its output 
   ' string. You could use the LEFT$() function which returns a 
   ' specified number of characters from the left side of a string to 
   ' remove the Line Feed character. The code fragment below 
   ' illustrates how to use the LEFT$() function along with the GPIB 
   ' global count variable, ibcntl, to copy the contents of ValueStr 
   ' into a new string called DisplayStr.   , that you need one less 
   ' character than the total number contained in ibcntl. 
   DisplayStr = Left(ValueStr, ibcntl - 1)           '对所读到的字符串作的一些处理 

   ' The reading from the oscilloscope is displayed in the List box. 
   ReadingsList.AddItem (DisplayStr) 
   ReadingsList.Refresh 

End Sub 
Private Sub QuitCmd_Click() 
' ======================================================================= 
'' CLEANUP SECTION 
'' ======================================================================= 
   ' The device is taken offline. 
       ilclr Dev%                             '清空GPIB装置,如果出错,则显示相关信息 
   If (ibsta And EERR) Then 
       Call GPIBCleanup("Unable to clear device") 
   End If 
   illoc Dev%                        '使仪器成本地连接 
   ilonl Dev%, 0                     '仪器下线 

   End 
End Sub 






例二 


Dim Dev As Integer      '定義Dev為GPIB儀器 

Private Function AddIbcnt() As String       '定義變量 
   AddIbcnt = Chr$(13) + Chr$(10) + "ibcnt = 0x" + Hex$(ibcnt) 
End Function 

Private Function AddIberr() As String      '定義出錯處理函數 
   If (ibsta And EERR) Then 
       If (iberr = EDVR) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EDVR <DOS 
Error>" 
       If (iberr = ECIC) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ECIC <Not 
CIC>" 
       If (iberr = ENOL) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ENOL <No 
Listener>" 
       If (iberr = EADR) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EADR 
<Address Error>" 
       If (iberr = EARG) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EARG 
<Invalid argument>" 
       If (iberr = ESAC) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ESAC <Not 
Sys Ctrlr>" 
       If (iberr = EABO) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EABO <Op. 
aborted>" 
       If (iberr = ENEB) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ENEB <No 
GPIB board>" 
       If (iberr = EOIP) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EOIP <Async 
I/O in prg>" 
       If (iberr = ECAP) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ECAP <No 
capability>" 
       If (iberr = EFSO) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EFSO <File 
sys. error>" 
       If (iberr = EBUS) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = EBUS 
<Command error>" 
       If (iberr = ESTB) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ESTB 
<Status byte lost>" 
       If (iberr = ESRQ) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ESRQ <SRQ 
stuck high>" 
       If (iberr = ETAB) Then AddIberr = Chr$(13) + Chr$(10) + "iberr = ETAB <Table 
overflow>" 
   Else 
       AddIberr = Chr$(13) + Chr$(10) + "iberr = " + Str$(iberr) 
   End If 
End Function 

Private Function AddIbsta() As String   '定義出錯處理函數 
    
   sta$ = Chr$(13) + Chr$(10) + "ibsta = &H" + Hex$(ibsta) + " <" 
   If (ibsta And EERR) Then sta$ = sta$ + " ERR" 
   If (ibsta And TIMO) Then sta$ = sta$ + " TIMO" 
   If (ibsta And EEND) Then sta$ = sta$ + " END" 
   If (ibsta And SRQI) Then sta$ = sta$ + " SRQI" 
   If (ibsta And RQS) Then sta$ = sta$ + " RQS" 
   If (ibsta And CMPL) Then sta$ = sta$ + " CMPL" 
   If (ibsta And LOK) Then sta$ = sta$ + " LOK" 
   If (ibsta And RREM) Then sta$ = sta$ + " REM" 
   If (ibsta And CIC) Then sta$ = sta$ + " CIC" 
   If (ibsta And AATN) Then sta$ = sta$ + " ATN" 
   If (ibsta And TACS) Then sta$ = sta$ + " TACS" 
   If (ibsta And LACS) Then sta$ = sta$ + " LACS" 
   If (ibsta And DTAS) Then sta$ = sta$ + " DTAS" 
   If (ibsta And DCAS) Then sta$ = sta$ + " DCAS" 
   sta$ = sta$ + ">" 
   AddIbsta = sta$ 
End Function 

' 
'   Clear the list of readings in the test window 
' 
Private Sub ClearReadingsList()        '定義清空列表,初始化用 
   If ReadingsList.ListCount > 0 Then 
       For i% = 0 To ReadingsList.ListCount - 1 
           ReadingsList.RemoveItem 0 
       Next i% 
   End If 
   ReadingsList.Refresh 
End Sub 

Private Sub GpibErr(msg$) 
   msg$ = msg$ + AddIbsta() + AddIberr() + AddIbcnt() + Chr$(13) + Chr$(13) + "I'm 
quitting!" 
   MsgBox msg$, vbOKOnly + vbExclamation, "Error" 
    
   '  Take the device offline. 
    
   ilonl Dev, 0    '出現任何錯誤,GPIB儀器就下線 
    
   End 
End Sub 

' 
'   Initalize the form controls. 
' 
Private Sub Form_Load() 
   GPIBglobalsRegistered = 0      '程序運行時,清空列表 
    
   ' Clear the List Box. 

   Call ClearReadingsList 
    
End Sub 

' 
'   Information about Devquery.      '定義相關信息 
' 
Private Sub Info_Click() 
   msg$ = "This form queries a device using the '*IDN?' command to read back the 
identification code." 
   MsgBox msg$, vbInformation 
End Sub 

Private Sub QuitButton_Click() 
   End 
End Sub 

Private Sub RunRepeat_Click() 
   Call Run                     '運行程序的按鈕 
End Sub 

Private Sub Run()            '主要程序 

   Dim DisplayStr As String 

'   Disable QUIT button during run. 

   QuitButton.Enabled = 0 

' ======================================================================== 
' 
' INITIALIZATION SECTION         初始化裝置 
' 
' ======================================================================== 

'  Assign a unique identifier to the device and store in the variable 
'  Dev.  If the ERR bit is set in ibsta, call GpibErr with an error 
'  message. Otherwise, the device handle, Dev, is returned and is used in 
'  all subsequent calls to the device. 

Const BDINDEX = 0              ' Board Index 
Const PRIMARY_ADDR_OF_DEV = 1  ' Primary address of device 
Const NO_SECONDARY_ADDR = 0    ' Secondary address of device 
Const TIMEOUT = T10s           ' Timeout value = 10 seconds 
Const EOTMODE = 1              ' Enable the END message 
Const EOSMODE = 0              ' Disable the EOS mode 

   Dev = ildev(BDINDEX, PRIMARY_ADDR_OF_DEV, _ 
               NO_SECONDARY_ADDR, TIMEOUT, EOTMODE, EOSMODE)   '初始化 
   If (ibsta And EERR) Then 
       GpibErr ("Error opening device.") 
   End If 
    
'  Clear the internal or device functions of the device.  If the error bit 
'  EERR is set in ibsta, call GpibErr with an error message. 
    
   ilclr Dev                    '初始化時清空裝置 
   If (ibsta And EERR) Then 
       GpibErr ("Error clearing device.") 
   End If 

' ======================================================================== 
' 
'  MAIN BODY SECTION 
' 
'  In this application, the Main Body communicates with the instrument 
'  by writing a command to it and reading its response. This would be 
'  the right place to put other instrument communication. 
' 
' ======================================================================== 
    
'  This application queries a device for its identification code by 
'  issuing the "*IDN?" command. Many instruments respond to this command 
'  with an identification string. Note, 488.2 compliant devices are 
'  required to respond to this command.  If the error bit EERR is set in 
'  ibsta, call GpibErr with an error message. 

   wrtbuf$ = "*IDN?"                  '要寫出的字串 
   ilwrt Dev, wrtbuf$, Len(wrtbuf$) 
   If (ibsta And EERR) Then 
       GpibErr ("Error writing to device.") 
   End If 
    
'  Read the identification code by calling ilrd. If the ERR bit is set in 
'  ibsta, call GpibErr with an error message. 
    
   rdbuf$ = Space$(100) 
   ilrd Dev, rdbuf$, Len(rdbuf$)              '從GPIB儀器讀數據到電腦 
   If (ibsta And EERR) Then 
       GpibErr ("Error reading from device.") 
   End If 
    
'  The device returns a Line Feed character with the identification 
'  string. You could use the LEFT$() function which returns a 
'  specified number of characters from the left side of a string to 
'  remove the Line Feed character. The code fragment below illustrates 
'  how to use the LEFT$() function along with the GPIB global count 
'  variable, ibcntl, to copy the contents of rdbuf$ into a new string 
'  called DisplayStr. Note, that you need one less character than the 
'  total number contained in ibcntl. 

   DisplayStr = Left$(rdbuf$, ibcntl - 1)       '把讀出的數據加入到列表中 

'   Display the list of readings. 

   ReadingsList.AddItem DisplayStr 

' ======================================================================== 
' 
' CLEANUP SECTION 
' 
' ======================================================================== 

'  Take the device offline. 

   ilonl Dev, 0                          '下線用 
   If (ibsta And EERR) Then 
       GpibErr ("Error putting device offline.") 
   End If 

'   Enable user inputs. 

   QuitButton.Enabled = 1 
    
End Sub 



更多詳情,見:http://delta.126.com