Bei der Suche nach einener Sprache die schnell (?) und einfach und ohne viele Runtimelibs. auskommt habe ich ebend mal PB ausprobiert und bin recht zufrieden.
Nun müsste ich eigentlich lange Erklärungen abgeben, aber ich glaube, wer sich damit beschäftigen muss versteht das vorgestellte Konzept. Es erhebt auch keinen Anspruch auf Vollsdtändigkeit, weil nicht alle Möglichkeiten der GPIB ausgeschöpt sind. Aber wie die COM-Schnittstellen hat der GPIB immer noch seine Berechtigung und man kann anhand der *.h Dateien leicht nachrüsten. Na, die Implementation meines Code is nicht so gut.
Code: Alles auswählen
;== Const. Definitionen
#GpibLib=0
;== Globale Definition
Global BrdID.l = 0, ok.l=1,RecStr.s{256}
Global *PDevClear.l, *Pibln.l, *PEnableRemote.l, *PEnableLocal.l, *PReadStatusByte
Global *PReceive.l, *PSend.l, *PSendIFC.l, *PTestSRQ.l, *PWaitSRQ.l,*PTmo.l
Global *PResetBoard.l
;== Array, Structuren =====================================================
Global Dim DevName.s(30),Dim AddrLstn.l(30),Dim Tmp.l(30)
;== Prototypen ============================================================
;== Declare Functionen usw.================================================
Declare.b OpenLib()
Declare CloseLib()
;== Functionen ============================================================
Procedure.l PointerToFunction()
*PDevClear =GetFunction(#GpibLib,"DevClear")
*Pibln =GetFunction(#GpibLib,"ibln")
*PEnableRemote =GetFunction(#GpibLib,"EnableRemote")
*PEnableLocal =GetFunction(#GpibLib,"EnableLocal")
*PReadStatusByte=GetFunction(#GpibLib,"ReadStatusByte")
*PReceive =GetFunction(#GpibLib,"Receive")
*PSend =GetFunction(#GpibLib,"Send")
*PSendIFC =GetFunction(#GpibLib,"SendIFC")
*PTestSRQ =GetFunction(#GpibLib,"TestSRQ")
*PWaitSRQ =GetFunction(#GpibLib,"WaitSRQ")
*PTmo =GetFunction(#GpibLib,"ibtmo")
*PResetBoard =GetFunction(#GpibLib,"ibonl")
If (*PDevClear=0) Or (*Pibln=0) Or (*PEnableRemote=0) Or (*PEnableLocal=0)
ProcedureReturn #False
ElseIf ((*PReadStatusByte=0) Or (*PReceive=0) Or (*PSend=0) Or (*PSendIFC=0))
ProcedureReturn #False
ElseIf ((*PTestSRQ=0) Or (*PWaitSRQ=0) Or (*PTmo=0) Or (*PResetBoard=0))
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndProcedure
Procedure.b DevClear(addr.l)
ok=#True
CallFunctionFast(*PDevClear,BrdID,addr)
If ( ibsta & Err)>0:ok=#False: EndIf
ProcedureReturn ok
EndProcedure
Procedure FindLstnAddr(AddrList(1))
For Index.l=1 To 30
Status.l= CallFunctionFast(*Pibln,BrdID,Index,NO_SAD,@listen.l)
If ((( Status & Err)=0) And listen)
DevClear(Index);
AddrList(Cnt)=Index
Cnt=Cnt+1
EndIf
Next
AddrLstn(Cnt)=-1
EndProcedure
Procedure.b SetRemote(addr.l)
Tmp(0)=addr:Tmp(1)=-1:ok=#True
CallFunctionFast(*PEnableRemote,BrdID,Tmp())
If ( ibsta & Err):ok=#False: EndIf
ProcedureReturn ok
EndProcedure
Procedure.b SetLocal(addr.l)
Tmp(0)=add:Tmp(1)=-1:ok=#True
CallFunctionFast(*PEnableLocal,BrdID,Tmp())
If ( ibsta & Err): ok=#False: EndIf
ProcedureReturn ok
EndProcedure
; SerialPoll in "result" ist das zurückgegebene Statusbyte
Procedure.b ReadStatusByte(addr.l)
CallFunctionFast(*PReadStatusByte,BrdID,addr,@Result.l)
If ( ibsta & Err):
ProcedureReturn #False
EndIf
ProcedureReturn Result
EndProcedure
; Strings werden als Zeiger auf String zurückgegeben. "PeekS(wert.l)" anwenden
Procedure.l Receive(DevAddr.l)
Cnt.l=CallFunctionFast(*PReceive,BrdID,DevAddr,@RecStr,$100,mode=$0A)
If ( ibsta & Err): ProcedureReturn #False:EndIf
ProcedureReturn @RecStr
EndProcedure
Procedure.b Send(DevAddr.l,Command.s,mode.l=$01)
ok=#True
CallFunctionFast(*PSend,BrdID,DevAddr,Command,Len(Command),mode)
If ( ibsta & Err): ok=#False: EndIf
ProcedureReturn ok
EndProcedure
Procedure.b SendIFC(); Setzt das Board zurück und aktiviert es
CallFunctionFast(*PSendIFC,BrdID)
If (ibsta & Err) : ProcedureReturn #False: EndIf
ProcedureReturn #True
EndProcedure
;Testet die SRQ Line. 0 | 1. (1)SRQ aktiv , (0) SRQ inaktiv
Procedure.b TestSRQ();
CallFunctionFast(*PTestSRQ,BrdID,@Result.l)
If (ibsta & Err): ProcedureReturn #False : EndIf
ProcedureReturn Result
EndProcedure
Procedure.b WaitSRQ(); 0 | 1 (1) SRQ ist aktiv , (0) SRQ nicht aktiv und Time Out ist aktiv
CallFunctionFast(*PWaitSRQ,BrdID,@Result.b)
If (ibsta & Err): ProcedureReturn #False : EndIf
ProcedureReturn Result
EndProcedure
;TNONE(0)- no limit,T10us(1),T30us(2),T100us(3),T300us(4),T1ms(5),T3ms(6),T10ms7)
;T30ms(8),T100ms(9),T300ms(10),T1s(11),T3s(12),T10s(13),T30s(14),T100s(15)
;T300s(16),T1000s(17)
Procedure.b Tmo(time.l)
CallFunctionFast(*PTmo,BrdID,time)
If (ibsta & Err): ProcedureReturn #False : EndIf
ProcedureReturn #True
EndProcedure
Procedure.b ResetBoard(); Reset der Hard- und Software. Muss mit SendIFC reaktiviert werden
CallFunctionFast(*PResetBoard,BrdID,0)
If (ibsta & Err): ProcedureReturn #False: EndIf
ProcedureReturn #True
EndProcedure
;== Öffnen und Schliessen der Library ====================================
Procedure.b OpenLib(); Öffnen der Library und Interface clear
open = OpenLibrary(#GpibLib,"GPIB-32.Dll")
If (open <> 0)
open=#True
If PointerToFunction()=0
MessageRequester("Error: GPIB-32.dll","Can not read the functions address in DLL (Gpib-32.dll)")
ProcedureReturn 0
EndIf
open=SendIFC()
EndIf
ProcedureReturn open
EndProcedure
Procedure CloseLib()
CloseLibrary(#GpibLib)
EndProcedure
;== Zusammengesetzte Prozeduren ==========================================
Procedure.s SearchDevName(addr.l)
SetRemote(addr)
If Send(addr,"*IDN?",$1)
Rec.l=Receive(addr)
If Rec<>0:ProcedureReturn PeekS(Rec): EndIf
Else
ProcedureReturn "none"
EndIf
EndProcedure