unit iiro16u; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, Registry, ExtCtrls ; type TMainFrm = class(TForm) Label5: TLabel; GroupBox1: TGroupBox; ExitButton: TBitBtn; Memo1: TMemo; BeginSample: TButton; RunTimer: TTimer; RelayOut: TPanel; OptoIn: TPanel; Label2: TLabel; Label4: TLabel; IsaLabel: TLabel; IsaEdit: TEdit; procedure ExitButtonClick(Sender: TObject); // procedure AddressListChange(Sender: TObject); procedure RunTimerTimer(Sender: TObject); procedure BeginSampleClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); public { Public declarations } end; var MainFrm: TMainFrm; Address : WORD; RunFlag:Boolean; implementation uses ACCES32; {$R *.DFM} procedure TMainFrm.ExitButtonClick(Sender: TObject); begin Close; end; procedure TMainFrm.RunTimerTimer(Sender: TObject); const value:array[0..3] of LongWord=(0,0,0,0); i : Integer=0; var j: Integer; y: Cardinal; msg: String; begin if i < 8 then begin value[1] := 0; value[0] := 1 shl i; end else begin value[0] := 0; value[1] := 1 shl (i mod 8); end; if i < 8 then OutPortB(Address,value[0]) else OutPortB(Address+4,value[1]); y := gettickcount + 10; repeat Application.ProcessMessages; until gettickcount > y; if i < 8 then begin value[3] := 0; value[2] := InPortB(Address+1); end else begin value[2] := 0; value[3] := InPortB(Address+5); end; inc(i); i := i mod 16; msg:=StringOfChar('0', 16); for j:=0 to 7 do msg[16-j] := chr(ord((value[0] and (1 shl j))>0)+$30); for j:=0 to 7 do msg[8-j] := chr(ord((value[1] and (1 shl j))>0)+$30); RelayOut.Caption := msg; for j:=0 to 7 do msg[16-j] := chr(ord((value[2] and (1 shl j))>0)+$30); for j:=0 to 7 do msg[8-j] := chr(ord((value[3] and (1 shl j))>0)+$30); OptoIn.Caption := msg; end; procedure TMainFrm.BeginSampleClick(Sender: TObject); begin if not RunFlag then Address := StrToInt('$'+IsaEdit.Text); if RunTimer.Enabled=True then Begin RunTimer.Enabled:=False; BeginSample.Caption:='Perform I/O'; end else begin RunTimer.Enabled:=True; BeginSample.Caption:='Stop I/O'; Outportb(Address+3, $01); end; end; procedure TMainFrm.FormActivate(Sender: TObject); begin if not RunFlag then FocusControl(IsaEdit); end; procedure TMainFrm.FormCreate(Sender: TObject); begin 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; end; END.