Jag kör inga plugins, det enda jag gör är att anropa gpib dll filen..
Kod: Markera allt
(* Filename - SimpleForm.pas
*
* 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.
*)
unit SimpleForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TSimple = class(TForm)
GroupBox1: TGroupBox;
RunCmd: TButton;
QuitCmd: TButton;
Label1: TLabel;
Label2: TLabel;
CommandBox: TEdit;
ReadingsList: TListBox;
procedure QuitCmdClick(Sender: TObject);
procedure RunCmdClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
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_SCOPE = 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
(* Type declarations for exported NI-488.2 Global Variables. *)
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
Simple: TSimple;
(* 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
*
* This procedure loads the GPIB-32.DLL library. If the LoadLibrary
* call is successful, the next step is to get the addresses of the
* global status variables and functions using GetProcAddress. If the
* GetProcAddress calls were successful, the procedure returns to the
* main routine. Otherwise, it will free the library and HALT.
*
* The HALT function will terminate this program.
* =====================================================================
*)
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
*
* 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.
* =====================================================================
*)
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 TSimple.RunCmdClick(Sender: TObject);
begin
(* Clear the List Box screen. *)
strcopy(Vstr, '');
strcopy(VStr, pchar(CommandBox.Text));
(* ========================================================================
*
* 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 CommandBox to the
* oscilloscope.
*)
ibwrt(Dev, VStr , strlen(VStr));
if (Pibsta^ AND ERR) <> 0 THEN
GPIBCleanup('Unable to write to device');
(*
* The application reads the ASCII string from the oscilloscope
* into the ValueStr variable.
*)
ibrd(Dev, ValueStr, ARRAYSIZE);
if (Pibsta^ AND ERR) <> 0 THEN
GPIBCleanup('Unable to read from device');
(*
* Assume that the returned string contains ASCII data. NULL
* terminate the string using the value in ibcntl which is the
* number of bytes read in.
*)
ValueStr[Pibcntl^ - 1] := #0;
(* The reading from the oscilloscope is displayed in the List box. *)
ReadingsList.Items.Add(ValueStr);
ReadingsList.Refresh;
end;
procedure TSimple.FormCreate(Sender: TObject);
begin
(* ========================================================================
*
* INITIALIZATION SECTION
*
* ========================================================================
*)
(* Load the GPIB-32.DLL Library. *)
loadDLL;
(*
* The application brings the oscilloscope online using ibdev. A
* device handle, Dev, is returned and is used in all subsequent
* calls to the device.
*)
Dev := ibdev(BDINDEX, PRIMARY_ADDR_OF_SCOPE,
NO_SECONDARY_ADDR, TIMEOUT, EOTMODE, EOSMODE);
if (Pibsta^ AND ERR) <> 0 Then
GPIBCleanup('Unable to open device');
(*
* The application resets the GPIB portion of the oscilloscope by
* calling ibclr.
*)
ibclr(Dev);
if (Pibsta^ AND ERR) <> 0 Then
GPIBCleanup('Unable to clear device');
(*
* The default command to be written to the oscilloscope is
* displayed in the List box.
*)
CommandBox.Text := '*IDN?';
end;
procedure TSimple.QuitCmdClick(Sender: TObject);
begin
(* ========================================================================
*
* CLEANUP SECTION
*
* ========================================================================
*)
(* The device is taken offline. *)
ibonl(Dev, 0);
(* Free the GPIB library before exiting the program. *)
FreeLibrary(Gpib32Lib);
Close;
end;
end.