Quelltext /~heha/hs/io32.zip/SRC/IO32.PAS

unit io32;
{Hilfs-Unit zur Realisierung von Portzugriffen unter Delphi 2.0}

interface
 procedure outb(A:Word;B:Byte);
 procedure outw(A:Word;W:Word);
 function inb(A:Word):Byte;
 function inw(A:Word):Word;

implementation

uses Windows;

var
 F: THandle;		{Handle des ge”ffneten VxD}
 RetBytes: DWord;	{"Schluck-Variable"}

procedure outb(A:Word;B:Byte);
 var
  OutBuf:record
   AA: Word;		{I/O-Adresse}
   BB: Byte;		{Ausgabe-Byte}
  end;
 begin
  OutBuf.AA:=A; OutBuf.BB:=B;
  DeviceIoControl(F,2,nil,0,@OutBuf,3,RetBytes,nil);
 end;

procedure outw(A:Word;W:Word);
 var
  OutBuf:record
   AA: Word;
   WW: Word;
  end;
 begin
  OutBuf.AA:=A; OutBuf.WW:=W;
  DeviceIoControl(F,3,nil,0,@OutBuf,4,RetBytes,nil);
 end;

function inb(A:Word):Byte;
 begin
  DeviceIoControl(F,4,@Result,1,@A,2,RetBytes,nil);
 end;

function inw(A:Word):Word;
 begin
  DeviceIoControl(F,5,@Result,2,@A,2,RetBytes,nil);
 end;

var
 OldExit: Pointer;
procedure NewExit; far;		{sollte unter WIN32 NEAR bleiben!}
 begin
  CloseHandle(F);
 end;

initialization
 F:=CreateFile('\\.\io32.386',0,0,nil,0,File_Flag_Delete_On_Close,0); 
 if F=Invalid_Handle_Value then halt;	{Notbremse: VxD nicht ladbar (NT)!}
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.