有人搞过GPIB编程吗?(能否提供一下DEMO参考或者资料学习....谢谢!)

szdafu 2008-08-04 03:56:46
在网上找了一个DEMO, 运行报错!
unit ClearTriggerForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TClearTrigger = class(TForm)
GroupBox1: TGroupBox;
TriggerCmd: TButton;
QuitCmd: TButton;
ReadingsList: TListBox;
Timer1: TTimer;
procedure TriggerCmdClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure QuitCmdClick(Sender: TObject);
private
public
end;

const
ERR = $8000;
TIMO = $4000;
ENDgpib = $2000;
SRQI = $1000;
RQS = $800;
SPOLL = $400;
EVENT = $200;
CMPL = $100;
LOK = $80;
REM = $40;
CIC = $20;
ATN = $10;
TACS = $8;
LACS = $4;
DTAS = $2;
DCAS = $1;
EDVR = 0;
ECIC = 1;
ENOL = 2;
EADR = 3;
EARG = 4;
ESAC = 5;
EABO = 6;
ENEB = 7;
EDMA = 8;
EOIP = 10;
ECAP = 11;
EFSO = 12;
EBUS = 14;
ESTB = 15;
ESRQ = 16;
ETAB = 20;

T10s = 13;

BDINDEX = 0;
PRIMARY_ADDR_OF_DMM = 1;
NO_SECONDARY_ADDR = 0;
TIMEOUT = T10s;
EOTMODE = 1;
EOSMODE = 0;
ARRAYSIZE = 1024;
type
Tibsta = function : integer; stdcall;
Tiberr = function : integer; stdcall;
Tibcntl = function : Longint; stdcall;
Tibclr = function (ud : integer) : integer; stdcall;
Tibdev = function(ud: integer;
pad: integer;
sad: integer;
tmo: integer;
eot: integer;
eos: integer) : integer; stdcall;
Tibonl = function(ud: integer;
v: integer) : integer; stdcall;
Tibrd = function (ud: integer;
var rdbuf;
cnt: Longint) : integer; stdcall;
Tibtrg = function (ud : integer) : integer; stdcall;
Tibwrt = function (ud: integer;
var wrtbuf;
cnt: longint) : integer; stdcall;

var
ClearTrigger: TClearTrigger;
Gpib32Lib: THandle;
AddrIbsta : Tibsta;
AddrIberr : Tiberr;
AddrIbcntl : Tibcntl;
Pibsta : ^integer;
Piberr : ^integer;
Pibcntl : ^Longint;
ibclr : Tibclr;
ibdev : Tibdev;
ibonl : Tibonl;
ibrd : Tibrd;
ibtrg : Tibtrg;
ibwrt : Tibwrt;
ValueStr : packed array[0..2049] of char;
Dev : integer;
buf : packed array[0..100] of char;

implementation

procedure loadDLL;
var
str : string;

begin

If Gpib32Lib = 0 Then
Begin
str := 'LoadLibrary FAILED!';
MessageDlg(str, mtError, [mbOK], 0);
halt;
End;
@AddrIbsta := GetProcAddress(Gpib32Lib, 'user_ibsta');
@AddrIberr := GetProcAddress(Gpib32Lib, 'user_iberr');
@AddrIbcntl := GetProcAddress(Gpib32Lib, 'user_ibcnt');
@ibclr := GetProcAddress(Gpib32Lib, 'ibclr');
@ibdev := GetProcAddress(Gpib32Lib, 'ibdev');
@ibonl := GetProcAddress(Gpib32Lib, 'ibonl');
@ibrd := GetProcAddress(Gpib32Lib, 'ibrd');
@ibtrg := GetProcAddress(Gpib32Lib, 'ibtrg');
@ibwrt := GetProcAddress(Gpib32Lib, 'ibwrt');
if (@AddrIbsta = NIL) Or
(@AddrIberr = NIL) Or
(@AddrIbcntl = NIL) Or
(@ibclr = NIL) Or
(@ibdev = NIL) Or
(@ibonl = NIL) Or
(@ibrd = NIL) Or
(@ibtrg = NIL) Or
(@ibwrt = NIL) Then
Begin
str := 'GetProcAddress FAILED!';
MessageDlg(str, mtError, [mbOK], 0);
FreeLibrary(Gpib32Lib);
halt;
End;
Pibsta := @AddrIbsta;
Piberr := @AddrIberr;
Pibcntl := @AddrIbcntl;
end;

...全文
1068 10 打赏 收藏 转发到动态 举报
写回复
用AI写文章
10 条回复
切换为时间正序
请发表友善的回复…
发表回复
yeeyee 2009-05-15
  • 打赏
  • 举报
回复
Dev := ibdev(BDINDEX, PRIMARY_ADDR_OF_DMM,
NO_SECONDARY_ADDR, TIMEOUT, EOTMODE, EOSMODE);


BDINDEX 错误可能性最大,从 0 到 99 循环试
feimychen 2009-03-29
  • 打赏
  • 举报
回复
楼上的朋友您好 怎么联系你啊,能不能把你的源码发些给我,我的邮箱是baolongchen@tom.com QQ:402064966
songxjing 2009-02-17
  • 打赏
  • 举报
回复
我有很多,但是都是用VB写的,我可以给你````联系我````做这一行在什么地方找工作比较好,不知道你调查了没有,不想在这干了
shizhimao2003 2009-01-16
  • 打赏
  • 举报
回复
晕。。。没看日期是08年的了
shizhimao2003 2009-01-16
  • 打赏
  • 举报
回复
qq:343844069.
不过我放年假了。期间可能不能上网。等我上班了在联系吧。
懂得也不多,不过可以提供一些的我所知道的相关知识
shizhimao2003 2009-01-16
  • 打赏
  • 举报
回复
我现在用的是labview,这个比较直观方便。
szdafu 2008-08-07
  • 打赏
  • 举报
回复
自己顶,顶到有人帮忙为止!
kampan 2008-08-06
  • 打赏
  • 举报
回复
GPIB是类似串口之类的东西吗?
shuihan20e 2008-08-06
  • 打赏
  • 举报
回复
bd
szdafu 2008-08-04
  • 打赏
  • 举报
回复

procedure GPIBCleanup(msg: string);
var
str : string;
ibstaStr : string;
iberrStr : string;
ibcntlStr : string;
begin
ibstaStr := IntToHex(Pibsta^, 4);
iberrStr := IntToStr(Piberr^);
str := msg;
str := Concat(str, #13);
str := Concat(str, 'ibsta = $' + ibstaStr);
str := Concat(str, ' <');
if (Pibsta^ and ERR) <> 0 Then
str := Concat(str, ' ERR ');
if (Pibsta^ and TIMO) <> 0 Then
str := Concat(str, ' TMO ');
if (Pibsta^ and ENDgpib) <> 0 Then
str := Concat(str, ' END ');
if (Pibsta^ and SRQI) <> 0 Then
str := Concat(str, ' SRQI ');
if (Pibsta^ and RQS) <> 0 Then
str := Concat(str, ' RQS ');
if (Pibsta^ and SPOLL) <> 0 Then
str := Concat(str, ' SPOLL ');
if (Pibsta^ and EVENT) <> 0 Then
str := Concat(str, ' EVENT ');
if (Pibsta^ and CMPL) <> 0 Then
str := Concat(str, ' CMPL ');
if (Pibsta^ and LOK) <> 0 Then
str := Concat(str, ' LOK ');
if (Pibsta^ and REM) <> 0 Then
str := Concat(str, ' REM ');
if (Pibsta^ and CIC) <> 0 Then
str := Concat(str, ' CIC ');
if (Pibsta^ and ATN) <> 0 Then
str := Concat(str, ' ATN ');
if (Pibsta^ and TACS) <> 0 Then
str := Concat(str, ' TACS ');
if (Pibsta^ and LACS) <> 0 Then
str := Concat(str, ' LACS ');
if (Pibsta^ and DTAS) <> 0 Then
str := Concat(str, ' DTAS ');
if (Pibsta^ and DCAS) <> 0 Then
str := Concat(str, ' DCAS ');
str := Concat(str, '>');
str := Concat(str, #13);

str := Concat(str, 'iberr = ' + iberrStr);
str := Concat(str, ' <');
if Piberr^ = EDVR Then
str := Concat(str, ' EDVR ');
if Piberr^ = ECIC Then
str := Concat(str, ' ECIC ');
if Piberr^ = ENOL Then
str := Concat(str, ' ENOL ');
if Piberr^ = EADR Then
str := Concat(str, ' EADR ');
if Piberr^ = EARG Then
str := Concat(str, ' EARG ');
if Piberr^ = ESAC Then
str := Concat(str, ' ESAC ');
if Piberr^ = EABO Then
str := Concat(str, ' EABO ');
if Piberr^ = ENEB Then
str := Concat(str, ' ENEB ');
if Piberr^ = EDMA Then
str := Concat(str, ' EDMA ');
if Piberr^ = EOIP Then
str := Concat(str, ' EOIP ');
if Piberr^ = ECAP Then
str := Concat(str, ' ECAP ');
if Piberr^ = EFSO Then
str := Concat(str, ' EFSO ');
if Piberr^ = EBUS Then
str := Concat(str, ' EBUS ');
if Piberr^ = ESTB Then
str := Concat(str, ' ESTB ');
if Piberr^ = ESRQ Then
str := Concat(str, ' ESRQ ');
if Piberr^ = ETAB Then
str := Concat(str, ' ETAB ');
str := Concat(str, '>');
str := Concat(str, #13);
ibcntlStr := IntToStr(Pibcntl^);
str := Concat( str, 'ibcntl = ' + ibcntlStr);
MessageDlg(str, mtError, [mbOK], 0);
ibonl(Dev, 0);
FreeLibrary(Gpib32Lib);
halt;
end;

procedure TClearTrigger.TriggerCmdClick(Sender: TObject);
begin

TriggerCmd.Enabled := False;
Dev := ibdev(BDINDEX, PRIMARY_ADDR_OF_DMM,
NO_SECONDARY_ADDR, TIMEOUT, EOTMODE, EOSMODE);
if (Pibsta^ AND ERR) <> 0 Then
GPIBCleanup('Unable to open device');
ibclr(Dev);
if (Pibsta^ AND ERR) <> 0 Then
GPIBCleanup('Unable to clear device');
buf := 'TRIGGER 5';
ibwrt(Dev, buf, 9);
if (Pibsta^ AND ERR) <> 0 Then
GPIBCleanup('Unable to set trigger type');
Timer1.Enabled := True;

end;

procedure TClearTrigger.QuitCmdClick(Sender: TObject);
begin
ibonl(Dev, 0);
FreeLibrary(Gpib32Lib);
Close;
end;

end.


错误信息:

Unable to set trigger type
ibsta=$8100 <ERR CMPL>
iberr=2 <ENOL>
ibcntl=0


各位兄弟,能否提供一下DEMO参考或者资料学习....谢谢!(刚接触这个GPIB还没有入门...)

2,498

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 数据库相关
社区管理员
  • 数据库相关社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧