Need help for trouble shooting delphi code , THANKS FOR HELP.
Violin
we are testing a LCR machine for measuring components such like
Resistor / Capacitor / Transistor ....etc.
and we're testing a delphi code to get the LCR log , but the code
running with errors:
"Unable to write to device
ibsta = $8100 < ERR CMPL >
iberr = 2 < ENOL >
ibcntl = 0"
The delphi code are:
unit ULCRFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TLCRFrm = class(TForm)
Panel1: TPanel;
EdtCommand: TEdit;
BtnSend: TButton;
MMShow: TMemo;
procedure FormCreate(Sender: TObject);
procedure BtnSendClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
const
(* GPIB status bit
definitions. *)
ERR = $8000; (* Error detected *)
TIMO = $4000; (* Timeout *)
ENDgpib = $2000; (* EOI or EOS detected *)
SRQI = $1000; (* SRQ detected by CIC *)
RQS = $800; (* Device needs service *)
SPOLL = $400; (* Board has been serially polled *)
EVENT = $200; (* An event has occurred *)
CMPL = $100; (* I/O completed *)
LOK = $80; (* Local lockout state *)
REM = $40; (* Remote state *)
CIC = $20; (* Controller-in-charge *)
ATN = $10; (* Attention asserted *)
TACS = $8; (* Talker active *)
LACS = $4; (* Listener active *)
DTAS = $2; (* Device trigger state *)
DCAS = $1; (* Device clear state *)
(* Error messages returned in global variable
iberr: *)
EDVR = 0; (* System error *)
ECIC = 1; (* Function requires GPIB board to be CIC *)
ENOL = 2; (* Write function detected no Listeners *)
EADR = 3; (* Interface board not addressed correctly *)
EARG = 4; (* Invalid argument to function call *)
ESAC = 5; (* Function requires GPIB board to be SAC *)
EABO = 6; (* I/O operation aborted *)
ENEB = 7; (* Non-existent interface board *)
EDMA = 8; (* Error performing DMA *)
EOIP = 10; (* I/O operation started before previous *)
(* operation completed *)
ECAP = 11; (* No capability for intended operation *)
EFSO = 12; (* File system operation error *)
EBUS = 14; (* Command error during device call *)
ESTB = 15; (* Serial poll status byte lost *)
ESRQ = 16; (* SRQ remains asserted *)
ETAB = 20; (* The return buffer is full *)
T10s = 13;
BDINDEX = 0; (* Board Index *)
PRIMARY_ADDR_OF_DMM = 1; (* Primary address of device *)
NO_SECONDARY_ADDR = 0; (* Secondary address of device *)
TIMEOUT = T10s; (* Timeout value = 10 seconds *)
EOTMODE = 1; (* Enable the END message *)
EOSMODE = 0; (* Disable the EOS mode *)
ARRAYSIZE = 1024; (* Size of read buffer *)
(* Type declarations for exported NI-488.2 Global Variables *)
type
Tibsta = function: integer; stdcall;
Tiberr = function: integer; stdcall;
Tibcntl = function: Longint; stdcall;
(* Type declarations for exported NI-488.2 functions *)
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;
Tibwrt = function(ud: integer;
var wrtbuf;
cnt: longint): integer; stdcall;
var
LCRFrm: TLCRFrm;
(* Declaration for the Handle for the GPIB library.
*)
Gpib32Lib: THandle;
(* Addresses for NI-488.2 GPIB global status variables. *)
AddrIbsta: Tibsta;
AddrIberr: Tiberr;
AddrIbcntl: Tibcntl;
(* Pointers to the NI-488.2 GPIB global status variables. *)
Pibsta: ^integer;
Piberr: ^integer;
Pibcntl: ^Longint;
(* Declarations for the NI-488.2 GPIB calls. *)
ibclr: Tibclr;
ibdev: Tibdev;
ibrd: Tibrd;
ibwrt: Tibwrt;
ibonl: Tibonl;
(* Declaration of global variables. *)
Dev: integer;
VStr: packed array[0..ARRAYSIZE] of char;
ValueStr: packed array[0..ARRAYSIZE] of char;
implementation
{$R *.dfm}
procedure loadDLL;
var
str: string;
begin
(* Load the GPIB-32.DLL library using the LoadLibrary function. *)
Gpib32Lib := LoadLibrary('GPIB-32.DLL');
(*
* Check to see if library loaded successfully. If the library could
* not be loaded, display an error message and then HALT the
program.
*)
if Gpib32Lib = 0 then
begin
str := 'LoadLibrary FAILED!';
MessageDlg(str, mtError, [mbOK], 0);
halt;
end;
(* Get the addresses of the GPIB Global Variables.
*)
@AddrIbsta := GetProcAddress(Gpib32Lib, 'user_ibsta');
@AddrIberr := GetProcAddress(Gpib32Lib, 'user_iberr');
@AddrIbcntl := GetProcAddress(Gpib32Lib, 'user_ibcnt');
(* Get the addresses of the functions needed for this application.
*)
@ibclr := GetProcAddress(Gpib32Lib, 'ibclr');
@ibdev := GetProcAddress(Gpib32Lib, 'ibdev');
@ibonl := GetProcAddress(Gpib32Lib, 'ibonl');
@ibrd := GetProcAddress(Gpib32Lib, 'ibrd');
@ibwrt := GetProcAddress(Gpib32Lib, 'ibwrt');
(*
* Verify that addresses were obtained. If unable to get any one of
* the addresses, then free the library, display an error message
* and HALT the program.
*)
if (@AddrIbsta = nil) or
(@AddrIberr = nil) or
(@AddrIbcntl = nil) or
(@ibclr = nil) or
(@ibdev = nil) or
(@ibonl = nil) or
(@ibrd = nil) or
(@ibwrt = nil) then
begin
str := 'GetProcAddress FAILED!';
MessageDlg(str, mtError, [mbOK], 0);
(* Free the GPIB library. *)
FreeLibrary(Gpib32Lib);
halt;
end;
(* Initialize GPIB global pointers to point to address location. *)
Pibsta := @AddrIbsta;
Piberr := @AddrIberr;
Pibcntl := @AddrIbcntl;
end;
procedure GPIBCleanup(msg: string);
var
str: string; (* String used for displaying messages. *)
ibstaStr: string; (* String for converting ibsta. *)
iberrStr: string; (* String for converting iberr. *)
ibcntlStr: string; (* String for converting ibcntl. *)
begin
ibstaStr := IntToHex(Pibsta^, 4);
iberrStr := IntToStr(Piberr^);
str := msg;
str := Concat(str, #13); (* Add a line feed character. *)
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); (* Add a line feed character. *)
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); (* Add a line feed character. *)
ibcntlStr := IntToStr(Pibcntl^);
str := Concat(str, 'ibcntl = ' + ibcntlStr);
MessageDlg(str, mtError, [mbOK], 0);
(* The device is taken offline. *)
ibonl(Dev, 0);
(* Free the GPIB library. *)
FreeLibrary(Gpib32Lib);
//halt;
end;
procedure TLCRFrm.FormCreate(Sender: TObject);
begin
loadDLL;
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');
end;
procedure TLCRFrm.BtnSendClick(Sender: TObject);
begin
strcopy(Vstr, '');
strcopy(VStr, pchar(EdtCommand.Text));
ibwrt(Dev, VStr, strlen(VStr));
if (Pibsta^ and ERR) <> 0 then
GPIBCleanup('Unable to write to device');
ibrd(Dev, ValueStr, 100);
if (Pibsta^ and ERR) <> 0 then
GPIBCleanup('Unable to read from device');
ValueStr[Pibcntl^ - 1] := #0;
(* The reading from the multimeter is displayed in the List box.
*)
MMshow.Lines.Insert(0, ValueStr);
end;
procedure TLCRFrm.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
ibonl(Dev, 0);
FreeLibrary(Gpib32Lib);
Close;
end;
end.
If somebody know how to solve the problems,please give us any tips,
thanks in advance,
Regards,
Violin.
vio...@pouchen.com
Hans-Peter Diettrich
> we are testing a LCR machine for measuring components such like
> Resistor / Capacitor / Transistor ....etc.
>
> and we're testing a delphi code to get the LCR log , but the code
> running with errors:
> "Unable to write to device
> ibsta = $8100 < ERR CMPL >
> iberr = 2 < ENOL >
> ibcntl = 0"
You seem to have problems with the GPIB. Either it doesn't work
(drivers...), or you use wrong device addresses.
DoDi