unit ScanUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Registry;

type
  TScanForm = class(TForm)
    IntroLabel: TLabel;
    StartButton: TButton;
    ExitButton: TButton;
    Address8Edit: TEdit;
    Address8Label: TLabel;
    Address16Label: TLabel;
    Address16Edit: TEdit;
    OutMemo: TListBox;
    StatusLabel: TLabel;
    procedure ExitButtonClick(Sender: TObject);
    procedure StartButtonClick(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
     DriverRegistry: TRegistry;
  public
    { Public declarations }
  end;

const
  myKey = 'Software\PCIFIND\NTioPCI\Parameters';

var
  ScanForm: TScanForm;
  Address8, Address16: Word;
  done: Boolean = false;

implementation

{$R *.DFM}

uses
  ACCES32;

type
  TPCI_COMMON_CONFIG = record
     VendorID : word;
     DeviceID : word;
     Command : word;
     Status : word;
     RevisionID : byte;
     ProgIf : byte;
     SubClass : byte;
     BaseClass : byte;                        
     CacheLineSize : byte;
     LatencyTimer : byte;
     HeaderType : byte;
     BIST : byte;
     BaseAddresses : Array[0..5] of longint;
     Reserved1 : Array[0..1] of longint;
     RomBaseAddress : longint;
     Reserved2 : Array[0..1] of longint;
     InterruptLine : byte;
     InterruptPin : byte;
     MinimumGrant : byte;
     MaximumLatency : byte;
  end;
  //global variables for internal use
var
  buf: array [0..63] of TPCI_COMMON_CONFIG;
  

procedure CtrMode(addr: LongWord; cntr: Byte; mode: Byte);
var
  ctrl: Integer;
begin
  ctrl := ((cntr SHL 6) or $30 or (mode SHL 1));
  outportb(addr + 3, ctrl);
end;  //  end CtrMode

procedure CtrLoad(addr: LongWord; c: Word; val: Word);
begin
  outportb(addr + c, val and $00FF);
  outportb(addr + c, (val SHR 8) and $00FF);
end;  //  end CtrLoad

function CtrRead(addr: LongWord; c: Word): LongWord;
begin
  outportb(addr + 3, c SHL 6);
  Result := inportb(addr + c) + (inportb(addr + c) SHL 8);
end;  //  end CtrRead


procedure TScanForm.ExitButtonClick(Sender: TObject);
begin
   StopButtonClick(Sender);
   Close;
end;

procedure TScanForm.StartButtonClick(Sender: TObject);
var
   i, j: Integer;
   TempString: String;
   maxchan:integer;
   span:double;
   bipolar:boolean;
   //volts:double;

begin
   Address8 := StrToInt('$' + Address8Edit.Text);
   Address16 := StrToInt('$' + Address16Edit.Text);
   StartButton.OnClick := StopButtonClick;
   StartButton.Caption := 'End';
   done := false;

   TempString:='Card is configured for ';
   if (inportb(Address8+8) and 1)=1 then
     begin
       maxchan:=15;
       TempString:=TempString+'Single Ended (16CH), ';
     end
   else
     begin
       maxchan:=7;
       TempString:=TempString+'Differential (8CH), ';
     end;
   if (inportb(Address8+8) and 4)=4 then span:=10.0 else span:=20.0;
   if (inportb(Address8+8) and 2)=2 then
     begin
       bipolar:=true;
       TempString:=TempString+'±'+Format('%2d',[round(span / 2)])+' (Bipolar) Volt Range';
     end
   else
     begin
       bipolar:=false;
       TempString:=TempString+'0 - '+Format('%2d',[round(span)])+' (Unipolar) Volt Range';
     end;
   StatusLabel.Caption:=TempString;


   outportb(Address8 + $D, 1);         //turn on 2s complement.
   CtrMode(Address8 + $14, 0, 2);      //set counter 0 mode 2
   CtrMode(Address8 + $14, 1, 2);      //set counter 1 mode 2
   CtrMode(Address8 + $14, 2, 2);      //set counter 2 mode 2
   CtrLoad(Address8 + $14, 0, 5);
   CtrLoad(Address8 + $14, 1, 1000);    //divide counter source by (1000x1000) to get 10Hz
   CtrLoad(Address8 + $14, 2, 1000);
   outportb(Address8 + $1E, $C0);      //counter enable
   outportb(Address8 + $3, 0);         //disable burst
//$20 half
//$80 half
   while((inportb(Address8 + $8) and $80) <> $80) do
      inport(Address16);  //read fifo until empty

   outportb(Address8 + $2, (maxchan shl 4));  //write high and low scan limits
   outportb(Address8 + $1B, $01);             //gate timer, start timing
   outportb(Address8 + $1A, $11);             //GO! 1 sample per channel
   TempString := '';
   for i := 0 to maxchan do begin
      TempString := TempString + Format('%d'#9, [i]);
      if i = 7 then
         TempString := TempString;
   end;  //  for i

   OutMemo.items.Add(TempString);
   TempString := '';

   repeat
      while((inportb(Address8 + $8) and $80) > 0) do
         Application.ProcessMessages;  //wait for not empty
      TempString:='';
      while (not((inportb(Address8 + $8) and $80) > 0)) do begin  //drain until empty
         j := inport(Address16);
         if bipolar then
            j := smallint(j);
         TempString := TempString + Format('%6.3f'#9, [(j / 65536.0) * span]);
      end;  //  end while not inportb

      while (outmemo.items.count > ((outmemo.height div outmemo.itemheight) -2)) do outmemo.items.delete(1);
      OutMemo.items.add(tempstring);
      Application.ProcessMessages();
   until (done);

   CtrMode(Address8 + $14, 2, 2);  //stop data
   OutMemo.items.Add('Program done.');
end;

procedure TScanForm.StopButtonClick(Sender: TObject);
begin
   done := true;

   StartButton.OnClick := StartButtonClick;
   StartButton.Caption := 'Start';
end;

procedure TScanForm.FormCreate(Sender: TObject);
var
   num, i: Integer;
   found: Boolean;
begin
   found := false;
   DriverRegistry := TRegistry.Create;
   DriverRegistry.RootKey := HKEY_LOCAL_MACHINE;

   if (InPortB($61) = $AA55) then begin
      Application.MessageBox('ACCESNT.SYS not detected. Please copy ACCESNT.SYS into [NT]/system32/drivers and re-run this sample.', 'Warning', IDOK);
   end;

   DriverRegistry.OpenKey(MyKey, True);
   try
      num := DriverRegistry.ReadInteger('NumDevices');
   except
      on ERegistryException do num := 0;
   end;
   if (num > 0) then
      DriverRegistry.ReadBinaryData('PCICommonConfig', buf, num * sizeof(TPCI_COMMON_CONFIG));

   for i := 0 to num-1 do begin
      if found then
         Break;
      with Buf[i] do begin
         case (DeviceID) of
            $ECE8: begin
               Address16Edit.Text := Format('%X', [BaseAddresses[2] and $FFF8]);
               Address8Edit.Text := Format('%X', [BaseAddresses[3] and $FFF8]);
               found := true;
               end;
         end;{case}
      end;{with}
   end;{for}

   if not found then begin
      Application.MessageBox('No LPCI-A16-16A found. Please check that the card is installed correctly, and you have run PCIFind.', 'LPCI-A16-16A not found', MB_ICONWARNING + MB_OK);
   end;
   DriverRegistry.Free;
end;  //  end FormCreate

end.