unit LPTPort;
{.$define WINIO} // WinIo nutzen um auf den ParPort zuzugreifen
{.$define USERPORT}  // UserPort.sys nutzen um auf den ParPort zuzugreifen

{$ifdef WINIO}
 {$ifdef USERPORT}
  Es kann nur ein Kernel Mode Treiber genutzt werden
 {$endif}
{$endif}
{$ifdef USERPORT}
 {$ifdef WINIO}
  Es kann nur ein Kernel Mode Treiber genutzt werden
 {$endif}
{$endif}

{ Beschreibung:  Parallel Port Objekt mit direktem Hardwarezugriff }
interface
uses Windows, SysUtils, Classes{$ifdef WINIO}, WinIo{$endif};
const
  PortNames: array [0..2] of string = ('None', 'LPT1', 'LPT2');
  PortAddress: array[0..2] of Word = (0, $378, $278);
  STB = $01;
  AUTOFD = $02;
  INITL = $04;
  SLCI = $08;
  IRQEN = $10;
  ERR = $08;
  SLCO = $10;
  PE = $20;
  ACK = $40;
  BSY = $80;

type
  TPortNumber = (portNone, portLPT1, portLPT2);

  TParPort = class(TObject)
  private
    FPort: TPortNumber;
    FPortAddress: Word;
    PortHandle: THandle;
    FData, FControl, FStatus: Byte;
    FStrobe, FAutoFd, FInit, FSlctIn, FError, FSlct, FPaperEnd: Boolean;
    FAcknlg, FBusy: Boolean;
    procedure SetPort(Value: TPortNumber);
    function GetData: Byte;
    procedure SetData(Value: Byte);
    function GetControl: Byte;
    procedure SetControl(Value: Byte);
    function GetStatus: Byte;
    function GetStrobe: Boolean;
    procedure SetStrobe(Value: Boolean);
    function GetAutoFd: Boolean;
    procedure SetAutoFd(Value: Boolean);
    function GetInit: Boolean;
    procedure SetInit(Value: Boolean);
    function GetSlctIn: Boolean;
    procedure SetSlctIn(Value: Boolean);
    function GetError: Boolean;
    function GetSlct: Boolean;
    function GetPaperEnd: Boolean;
    function GetAcknlg: Boolean;
    function GetBusy: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    function OpenPort(PortNo: Byte): Boolean;
    function ClosePort: Boolean;

    property Control: Byte read GetControl write SetControl;
  public
    property Port: TPortNumber read FPort write SetPort;
    property BaseAddress: word read FPortAddress;
    property Status: Byte read GetStatus;
    property Data: Byte read GetData write SetData;
    property Strobe: Boolean read GetStrobe write SetStrobe;
    property AutoFeed: Boolean read GetAutofd write SetAutofd;
    property Initialize: Boolean read GetInit write SetInit;
    property SlctIn: Boolean read GetSlctIn write SetSlctIn;
    property Error: Boolean read GetError;
    property Slct: Boolean read GetSlct;
    property PaperEnd: Boolean read GetPaperEnd;
    property Acknlg: Boolean read GetAcknlg;
    property Busy: Boolean read GetBusy;
  end;


implementation

{ ************************************************************************* }

{ Get a Byte from the port }
function InPort(PortAddr: Word): Byte; stdcall;
begin
{$ifdef WINIO}
  Result := WinIo_GetPort(PortAddr)
{$else}
  try
    asm
      mov dx, PortAddr
      in al, dx
      mov Result, al
    end;
  except
    Result := 0;
  end;
{$endif}
end;

{ ************************************************************************* }
{ Write a Byte to the port }
procedure OutPort(PortAddr: Word; DataByte: Byte); stdcall;
begin
{$ifdef WINIO}
  WinIo_SetPort(PortAddr, DataByte)
{$else}
  try
    asm
      mov al, DataByte
      mov dx, PortAddr
      out dx, al
    end;
  except
  end;
{$endif}
end;

{ ************************************************************************* }
{ Do (Action) to b(Bit) of (PortAddr) }
procedure SetBitState(PortAddr: Word; Action: Boolean; Bit: Byte);
begin
  if Action = True then OutPort(PortAddr, InPort(PortAddr) or Bit)
   else   OutPort(PortAddr, InPort(PortAddr) and not Bit);
end;

{ ************************************************************************* }
{ Return status of b(Bit) of (PortAddr) }
function GetBitState(PortAddr: Word; Bit: Byte): Boolean;
begin
  Result := (InPort(PortAddr) and Bit) <> 0;
end;

{----------  TParPort ----------}

{ ************************************************************************* }
constructor TParPort.Create;
begin
  inherited Create;
  FPort := portNone;
  FPortAddress := 0;
  PortHandle := 0;
end;

{ ************************************************************************* }
destructor TParPort.Destroy;
begin
  ClosePort;
  inherited Destroy;
end;

{ ************************************************************************* }
function TParPort.OpenPort(PortNo: Byte): Boolean;
var s: string;
begin
  ClosePort;
  s := '';
  Result := False;
  if (PortNo < 1) or (PortNo > 2) then exit;
  s := '\\.\LPT' + IntToStr(PortNo);
  PortHandle := CreateFile(PChar(s),
                    GENERIC_READ or GENERIC_WRITE,
                    0, nil,
                    OPEN_EXISTING,
                    0, 0);
  if PortHandle = INVALID_HANDLE_VALUE then PortHandle := 0;
  if PortHandle <> 0 then begin
    case PortNo of
      1: FPort := portLPT1;
      2: FPort := portLPT2;
    end;
    FPortAddress := PortAddress[PortNo];
   { Output data = 0 }
    OutPort(FPortAddress, 0);
   { Control reg = 0c }
    OutPort(FPortAddress + 2, (InPort(FPortAddress + 2) and $F0) or $0C);
    Result := True;
  end;
end;

{ ************************************************************************* }
procedure TParPort.SetPort(Value: TPortNumber);
begin
  if Value <> FPort then begin
    { Set default output data }
     OpenPort(Ord(Value));
  end;
end;

{ ************************************************************************* }
function TParPort.GetData: Byte;
begin
  { Get a Byte from the data port }
  if PortHandle <> 0 then FData := InPort(FPortAddress)
   else FData := 0;
  Result := FData;
end;

{ ************************************************************************* }
procedure TParPort.SetData(Value: Byte);
begin
  { Send a Byte to the data port }
  if PortHandle <> 0 then OutPort(FPortAddress, Value);
end;

{ ************************************************************************* }
function TParPort.GetControl: Byte;
begin
 { Get a Byte from the control port }
  if PortHandle <> 0 then FControl := InPort(FPortAddress + 2)
   else FControl := 0;
  Result := FControl;
end;

{ ************************************************************************* }
procedure TParPort.SetControl(Value: Byte);
begin
{ Send a Byte to the control port }
  if PortHandle <> 0 then
     OutPort(FPortAddress + 2, (InPort(FPortAddress + 2) and $F0) or (Value and $0F));
end;

{ ************************************************************************* }
function TParPort.GetStatus: Byte;
begin
{ Read port status, inverting B7 (busy) }
  if PortHandle <> 0 then FStatus := InPort(FPortAddress + 1)
   else FStatus := 0;
  Result := FStatus;
end;

{ ************************************************************************* }
function TParPort.GetStrobe: Boolean;
begin
 { Read the STROBE output level }
  if PortHandle <> 0 then
     FStrobe := not GetBitState(FPortAddress + 2, STB)
   else
     FStrobe := False;
  Result := FStrobe;
end;

{ ************************************************************************* }
procedure TParPort.SetStrobe(Value: Boolean);
begin
 { Condition the STROBE output }
  if PortHandle <> 0 then
     SetBitState(FPortAddress + 2, not Value, STB);
end;

{ ************************************************************************* }
function TParPort.GetAutoFd: Boolean;
begin
 { Read the AUTOFD output level }
  if PortHandle <> 0 then FAutoFd := not GetBitState(FPortAddress + 2, AUTOFD)
   else FAutoFd := False;
  Result := FAutoFd;
end;

{ ************************************************************************* }
procedure TParPort.SetAutoFd(Value: Boolean);
begin
 { Condition the STROBE output }
  if PortHandle <> 0 then
     SetBitState(FPortAddress + 2, not Value, AUTOFD);
end;

{ ************************************************************************* }
function TParPort.GetInit: Boolean;
begin
 { Read the INITIALIZE output level }
  if PortHandle <> 0 then FInit := GetBitState(FPortAddress + 2, INITL)
   else FInit := False;
  Result := FInit;
end;

{ ************************************************************************* }
procedure TParPort.SetInit(Value: Boolean);
begin
 { Condition the INITIALIZE output }
  if PortHandle <> 0 then
     SetBitState(FPortAddress + 2, Value, INITL);
end;

{ ************************************************************************* }
function TParPort.GetSlctIn: Boolean;
begin
 { Read the SLCTIN output level }
  if PortHandle <> 0 then FSlctIn := not GetBitState(FPortAddress + 2, SLCI)
   else FSlctIn := False;
  Result := FSlctIn;
end;

{ ************************************************************************* }
procedure TParPort.SetSlctIn(Value: Boolean);
begin
 { Condition the SLCTIN output }
  if PortHandle <> 0 then
     SetBitState(FPortAddress + 2, not Value, SLCI);
end;

{ ************************************************************************* }
function TParPort.GetError: Boolean;
begin
 { Read the ERROR input level }
  if PortHandle <> 0 then FError := GetBitState(FPortAddress + 1, ERR)
   else FError := False;
  Result := FError;
end;
{ ************************************************************************* }
function TParPort.GetSlct: Boolean;
begin
 { Read the SLCT input level }
  if PortHandle <> 0 then FSlct := GetBitState(FPortAddress + 1, SLCO)
   else FSlct := False;
  Result := FSlct;
end;
{ ************************************************************************* }
function TParPort.GetPaperEnd: Boolean;
begin
 { Read the PE input level }
  if PortHandle <> 0 then FPaperEnd := GetBitState(FPortAddress + 1, PE)
   else FPaperEnd := False;
  Result := FPaperEnd;
end;
{ ************************************************************************* }
function TParPort.GetAcknlg: Boolean;
begin
 { Read the ACK input level }
  if PortHandle <> 0 then FAcknlg := GetBitState(FPortAddress + 1, ACK)
   else FAcknlg := False;
  Result := FAcknlg;
end;
{ ************************************************************************* }
function TParPort.GetBusy: Boolean;
begin
 { Read the inverted BUSY input level }
  if PortHandle <> 0 then FBusy := not GetBitState(FPortAddress + 1, BSY)
   else FBusy := False;
  Result := FBusy;
end;

{ ************************************************************************* }
function TParPort.ClosePort: Boolean;
begin
 { Close currently open LPT }
  if PortHandle <> 0 then begin
   { Output data = 0 }
    OutPort(FPortAddress, 0);
   { Control reg b0..3 = $0C }
    OutPort(FPortAddress + 2, (InPort(FPortAddress + 2) and $F0) or $0C);
    Result := CloseHandle(PortHandle);
  end else Result := False;
  PortHandle := 0;
  FPort := portNone;
  FPortAddress := 0;
end;

{$ifdef USERPORT}
procedure StartUserPortDriver;
var hUserPort : THandle;
begin
  hUserPort := CreateFile('\\.\UserPort',
                          GENERIC_READ,
                          0,
                          nil,
                          OPEN_EXISTING,
                          FILE_ATTRIBUTE_NORMAL,
                          0
                          );
  CloseHandle(hUserPort); // Activate the driver
  Sleep(100); // We must make a process switch
end;

function IsWinNT: Boolean;
var OSVersionInfo: TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(OSVersionInfo);
  Result := OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;

initialization
  if IsWinNT then StartUserPortDriver;
{$endif}

{$ifdef WINIO}
initialization
  WinIo_InstallAndStart;

finalization
  WinIo_ShutDown;
{$endif}

end.