unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    ComboBox1: TComboBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button9: TButton;
    Button10: TButton;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Timer1: TTimer;
    CheckBox1: TCheckBox;
    procedure SearchCards (Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ButtonReadClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Exit(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);

  private
    { Private declarations }
    Base   : longword;
    Adrlist :  TStrings;
    LED    : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
function InPort (ad : word) : Byte; stdcall; external 'POORT.DLL';
procedure OutPort(PortAddr: Word; DataByte: Byte); stdcall; external 'POORT.DLL';

function pci_getslot(vendor_id:word; device_id:word; karte:word):word;stdcall;export;
external 'PCICONF.DLL';

function pci_getver():word;stdcall;export;
external 'PCICONF.DLL';

function pci_getbus(vendor_id:word; device_id:word):byte;stdcall;export;
external 'PCICONF.DLL';

function pci_getfind(vendor_id:word; device_id:word):byte;stdcall;export;
external 'PCICONF.DLL';

function pci_gethead(vendor_id:word; funcdev:byte; bus:byte; reg_number:word):byte;stdcall;export;
external 'PCICONF.DLL';

function pci_getio(vendor_id:word; device_id:word; index_no:word):longword;stdcall;export;
external 'PCICONF.DLL';

{$R *.DFM}

const
  vendor = $1001;       { Kolter's Vendor_ID }


procedure TForm1.SearchCards (Sender: TObject);

var x : integer;
    str : string;
    bus : byte;
    slot : byte;
    device : word;
    adr    : word;
begin
  ComboBox1.Clear;              { initialize list of cards      }
  for device:=$0000 to $0020 do
  begin
    str:='';
    bus:=pci_getbus (vendor,device);
    slot:=pci_getslot (vendor,device,0);
    adr:=pci_getio(vendor,device,0);
    str:='Bus '+IntToHex(bus,2)+', Slot '+IntToHex(slot,2)+' Dev_ID '+IntToHex(device,2);
    str:=str+' adr '+IntToHex(adr,8);
    if (bus<$20) and (adr<>$FFFE) then      { Sometimes the DLL gives false reports... }
    begin
      ComboBox1.Items.Add(str);
    end;
  end;
 { If ComboBox1.Items.Count=0 then}
    ComboBox1.Items.Add ('<none>');
  ComboBox1.ItemIndex:=0;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  Startupform : TStartup;
begin
  Startupform:= TStartup.Create(Form1.Owner);
  Startupform.Show;
  Startupform.Update;
  SearchCards (Self);
  Startupform.Close;
  Startupform.Visible:=False;
  ComboBox1.ItemIndex:=0;
  ComboBox1Change (Self);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I : integer;
  Temp : TComponent;
  nr : integer;
begin
  LED:=False;           { LED is off... }
  nr:=0;
  for I:=0 to ComponentCount-1 do
  begin
    Temp:=Components[I];
    if (Temp is TEdit) then
    begin
      if nr<4 then
        TEdit (Temp).Text:='00'
      else
        TEdit (Temp).Text:='';
      nr := nr+1;
    end;
    if (Temp is TButton) then
      TButton (Temp).Enabled:=false;
    if (Temp is  TCheckBox) then
    begin
      TCheckBox (Temp).Enabled:=false;
      TCheckBox (Temp).Checked:=false;
    end;
  end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var str : string;
    I   : integer;
    Found : Boolean;
    Temp  : TObject;
begin
  str:=ComboBox1.Items.Strings[ComboBox1.ItemIndex];
  str:='$'+Copy (str,Length(str)-7,8);
  try
    Base:=StrToInt (str);
   except
    Base:=0;
  end;
  if Base=0 then
  begin
    Label7.Caption:='<no card selected>';
    Found:=False;
  end
  else
  begin
    Label7.Caption:=IntToHex (Base,8);
    Found:=True;
  end;
  for I:=0 to ComponentCount-1 do
  begin
    Temp:=Components[I];
    if (Temp is TButton) then
      TButton (Temp).Enabled:=Found;
    if (Temp is TCheckBox) then
      TCheckBox (Temp).Enabled:=Found;
  end;
  If (Found=True) and (CheckBox1.Checked=True)then
    Timer1.Enabled:=True
  else
    Timer1.Enabled:=False;
end;



procedure TForm1.ButtonReadClick(Sender: TObject);
var
  temp : integer;
begin
  temp:=TButton (Sender).Tag;
  If (temp=10) or (temp=19) then
    Edit5.Text:=IntToHex (Inport (base),2);
  If (temp=11) or (temp=19) then
    Edit6.Text:=IntToHex (Inport (base+1),2);
  If (temp=14) or (temp=19) then
    Edit7.Text:=IntToHex (Inport (base+4),2);
  If (temp=15) or (temp=19) then
    Edit8.Text:=IntToHex (Inport (base+5),2);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  temp : integer;
begin
  temp:=TButton (Sender).Tag;
  try
    If (temp=0) or (temp=9) then
      OutPort (base,StrToInt('$'+Edit1.Text));
    If (temp=1) or (temp=9) then
      OutPort (base+1,StrToInt('$'+Edit2.Text));
    If (temp=4) or (temp=9) then
      OutPort (base+4,StrToInt('$'+Edit3.Text));
    If (temp=5) or (temp=9) then
      OutPort (base+5,StrToInt('$'+Edit4.Text));
  except
    MessageDlg('Wrong Value!',mtWarning,[mbOk],0);
  end;
end;



procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  If (Key<'0') or (Key>'9') then
    if (Key<'a') or (Key>'f') then
      MessageDlg (IntToStr(Ord(Key))+' is pressed',mtInformation,[mbOk],0);
      Key:=Char(0);
end;

procedure TForm1.Edit1Exit(Sender: TObject);

var
  hexval : boolean;
  temp   : integer;
begin
  hexval:=True;
  try
    temp:=StrToInt ('$'+TEdit (Sender).Text);
  except
    hexval:=False;
  end;
  if (not hexval) then
  begin
    MessageDlg ('No hex value ('+TEdit (Sender).Text+')',mtWarning,[mbOk],0);
    TEdit (Sender).SetFocus;
  end;
  if (temp>255) then
  begin
    MessageDlg ('Value too big (00-FF)',mtWarning,[mbOk],0);
    TEdit (Sender).SetFocus;
  end;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  x:integer;
begin
  LED:=not LED;
  if (base<>0) then
  begin
    for x:=0 to 8 do
    begin
      if LED=True then
        OutPort (base+8,$FF)
      else
        OutPort (base+8,$00);
    end;
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  Timer1.Enabled:=Checkbox1.Checked;
end;

end.