Need help for trouble shooting delphi code , THANKS FOR HELP.

violin_1 — Wed, 10 Jun 2009 01:07:30 GMT

Hello all fellows,

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.

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.

Dennis Handly — Thu, 11 Jun 2009 03:12:05 GMT

What OS version are you using?
Why kind of computer do you have?

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.

violin_1 — Thu, 11 Jun 2009 04:26:06 GMT

OS:win2003
normal desktop PC, p4 CPU

Thx :)

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.

emha_1 — Thu, 11 Jun 2009 06:46:12 GMT

Hi,

hard to say as ibwrt is external function from the DLL...

according ENOL error description I would guess remote partner is not responding/prepared.
I would check whether Dev and Vstr are initialized properly before ibwrt call.
if you have available sources of the DLL you may look what ibwrt in fact do and why it reports error.

emha.

topic Need help for trouble shooting delphi code , THANKS FOR HELP. in Windows Server 2003

Need help for trouble shooting delphi code , THANKS FOR HELP.

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.

Re: Need help for trouble shooting delphi code , THANKS FOR HELP.