{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       TnrLPT class declaration (VCL)                  }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 04 Jan 2008                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrlpt;                    
interface
uses nrclasses,
     {$IFDEF LINUX}
     nrlinux,
     {$ELSE}
     nrwin32, windows, winspool, nrddbasew32,
     {$ENDIF}
     classes;

Type

  TLptPorts=(lpLPT1,lpLPT2,lpLPT3,lpLPT4,lpLPTxx);

  TLptMode =(pmCENTRONICS, pmIEEE,
   pmNIBBLE, pmCHANNEL_NIBBLE, pmBYTE_BIDIR,
   pmEPP_HW, pmEPP_SW, pmBOUNDED_ECP, pmECP_HW_NOIRQ,
   pmECP_HW_IRQ, pmECP_SW);

  TLptModes = set of TLptMode;

  TnrLptStatus = set of (lsPortClosed,lsInit,
                 lsAutoFeed,lsPaperEmpty,
                 lsOffLine,lsPowerOff,
                 lsNotConnected,lsBusy,lsSelected);

  TnrLPT=class(TnrBaseIO)
  private
//    fLptPort: TLptPorts;
    fLptPortNo:integer;
    fWriteModes: TLptModes;
    fReadModes: TLptModes;
    fDirectMode: boolean;
    Drv:TnrDriverBase;
    fPortBase:word;
    fControlBusy:boolean;
    procedure SetLptPort(const Value: TLptPorts);
    function GetLptname: string;
    function GetPortFree: boolean;
    procedure SetReadModes(const Value: TLptModes);
    procedure SetWriteModes(const Value: TLptModes);
    function GetLptPort: TLptPorts;
    function GetReadModes: TLptModes;
    function GetWriteModes: TLptModes;
    function GetPin(Index: integer): boolean;
    procedure SetPin(Index: integer; const Value: boolean);
    function GetBitsControl: byte;
    function GetBitsStatus: byte;
    function GetDataBits: byte;
    procedure SetBitsControl(const Value: byte);
    procedure SetBitsStatus(const Value: byte);
    procedure SetDataBits(const Value: byte);
    procedure SetDirectMode(const Value: boolean);
    function GetLptIOBase: word;
    function GetLptPortNo: byte;
    procedure SetLptIOBase(const Value: word);
    procedure SetLptPortNo(const Value: byte);
    function GetControlBusy: boolean;
    procedure SetControlBusy(const Value: boolean);
  protected
//    procedure InitAfterOpen; override;
    procedure Open;  override;
//    procedure Close; override;
    function RequestDeviceHandle:THandle; override;
    procedure RequestDeviceHandleClose(aHandle:THandle); override;
//    function GetAllInfo:boolean;
    function GetPortModes:boolean;
    function GetDeviceStatus:TnrLptStatus;
    property Status:TnrLptStatus read GetDeviceStatus;
    function AddLptDevice(aLpt:string; aData,aDataEx:integer):integer;
    procedure DeviceListLoad; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    //procedure GetDeviceList(L:TStrings); override;

    function GetDeviceIndex: integer; override;
    procedure SetDeviceIndex(const Value: integer);  override;

    procedure SetLptModes;

    procedure SendChar(const Ch:Char);    override;
    procedure SendString(const S:AnsiString); override;
    procedure SendData(const Buff:PAnsiChar;const N:cardinal);override;

    function WaitForStatus(const bmSig,bmVal:byte;Ms:cardinal):boolean;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property LptName:string read GetLptname;
    property IsPortFree:boolean read GetPortFree;
    property Pins[Index:integer]:boolean read GetPin write SetPin;
    property BitsData:byte read GetDataBits write SetDataBits;
    property BitsStatus:byte read GetBitsStatus write SetBitsStatus;
    property BitsControl:byte read GetBitsControl write SetBitsControl;

    property ReadModes:TLptModes read GetReadModes write SetReadModes;
    property WriteModes:TLptModes read GetWriteModes write SetWriteModes;

  published
    property LptPort:TLptPorts read GetLptPort write SetLptPort;
    property LptPortNo:byte read GetLptPortNo write SetLptPortNo;
    property LptIOBase:word read GetLptIOBase write SetLptIOBase;
    property DirectMode:boolean read fDirectMode write SetDirectMode;
    property ControlBusy:boolean read GetControlBusy write SetControlBusy; 
    property Active;
    property Log;
    property OnFatalError;
    property Handle;
  end;

  function GetModeNames(M:TLptModes):string;

implementation
uses sysutils, nrwin32di,
   {$IFDEF TRIAL}
        shellapi,
   {$ENDIF}
   {$IFDEF NR_WITH_CONTROLS}
        forms,
   {$ENDIF}
   dialogs;

{$R ..\Res\nrddio.res}

Const

  pcLPT:PChar='\\.\LPTx'#0;
  FILE_DEVICE_PARALLEL_PORT = $16;
  FILE_ANY_ACCESS           = 0;
  FILE_SPECIAL_ACCESS       = FILE_ANY_ACCESS;
  FILE_READ_ACCESS          = 1;
  FILE_WRITE_ACCESS         = 2;
  METHOD_BUFFERED           = 0;
  METHOD_IN_DIRECT          = 1;
  METHOD_OUT_DIRECT         = 2;
  METHOD_NEITHER            = 3;

  IRP_MJ_CREATE             = 0;

  PARALLEL_INIT            =$1;
  PARALLEL_AUTOFEED        =$2;
  PARALLEL_PAPER_EMPTY     =$4;
  PARALLEL_OFF_LINE        =$8;
  PARALLEL_POWER_OFF       =$10;
  PARALLEL_NOT_CONNECTED   =$20;
  PARALLEL_BUSY            =$40;
  PARALLEL_SELECTED        =$80;

  IRP_MJ_READ              =$03;
  IRP_MJ_WRITE             =$04;


  //CTL_CODE( DeviceType, Function, Method, Access ) (
  //  ((DeviceType) << 16) | ((Access) << 14) | ((Function) << 2) | (Method)
 { IOCTL_INTERNAL_GET_PARALLEL_PORT_INFO=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (12 shl 2) or METHOD_BUFFERED);

  IOCTL_INTERNAL_GET_MORE_PARALLEL_PORT_INFO=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (17 shl 2) or METHOD_BUFFERED);

  IOCTL_INTERNAL_GET_PARALLEL_PNP_INFO=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (21 shl 2) or METHOD_BUFFERED);}

  IOCTL_PAR_GET_DEVICE_CAPS =(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (9 shl 2) or METHOD_BUFFERED);

  {$IFDEF TRIAL}

  MsgCapt:{$IFNDEF LINUX}PCHar{$ELSE}WideString{$ENDIF}=
    'nrComm Lib '+nrCommLibVersion;

  MsgText:{$IFNDEF LINUX}PCHar{$ELSE}WideString{$ENDIF}=
    'nrComm Lib '+nrCommLibVersion+' Copyright(C) 1997-2011 DeepSoftware'+Eoln+
    Eoln+'You are using the trial version ! Please register !!!'+
    Eoln+'e-mail:noro@deepsoftware.com'+Eoln+'http://www.deepsoftware.com/'+Eoln+
    'Are you ready to register the nrComm Lib and get the full release now ?';

  {$ENDIF}

  IOCTL_PAR_IS_PORT_FREE =(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (21 shl 2) or METHOD_BUFFERED);

  IOCTL_IEEE1284_GET_MODE =(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (5 shl 2) or METHOD_BUFFERED);

  IOCTL_IEEE1284_NEGOTIATE=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (6 shl 2) or METHOD_BUFFERED);

{  IOCTL_INTERNAL_PARCLASS_CONNECT=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (30 shl 2) or METHOD_BUFFERED);
 }
  IOCTL_PAR_QUERY_INFORMATION=(
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (1 shl 2) or METHOD_BUFFERED);

  IOCTL_PAR_SET_INFORMATION = (
       (FILE_DEVICE_PARALLEL_PORT shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (2 shl 2) or METHOD_BUFFERED);


//Var
//  glLptEnums:TStringList;

Type

  {$IFDEF GEN3}
  PORT_INFO_2 = record
    pPortName: PChar;
    pMonitorName: PChar;
    pDescription: PChar;
    fPortType: DWORD;
    Reserved: DWORD;
  end;
  {$ENDIF}

  PHYSICAL_ADDRESS = int64;

  PARCLASS_INFORMATION = packed record
    Controller:PChar;
    EcrController:PChar;
    SpanOfController:cardinal;
    DetermineIeeeModes:pointer;
    NegotiateIeeeMode:pointer;
    TerminateIeeeMode:pointer;
    IeeeFwdToRevMode:pointer;
    IeeeRevToFwdMode:pointer;
    ParallelRead:pointer;
    ParallelWrite:pointer;
    ParclassContext:pointer;
    HardwareCapabilities:cardinal;
    FifoDepth:cardinal;
    FifoWidth:cardinal;
    ParallelTryselect:pointer;
    ParallelDeSelect:pointer;
  end;
  TPARCLASS_INFORMATION=PARCLASS_INFORMATION;
  PPARCLASS_INFORMATION=^PARCLASS_INFORMATION;

  PARALLEL_PORT_INFORMATION= packed record
    OriginalController:PHYSICAL_ADDRESS;
    Controller:PUCHAR;
    SpanOfController:cardinal;
    TryAllocatePort:pointer;
    FreePort:pointer;
    QueryNumWaiters:pointer;
    Context:integer;
  end;
  PPARALLEL_PORT_INFORMATION=^PARALLEL_PORT_INFORMATION;
  TPARALLEL_PORT_INFORMATION=PARALLEL_PORT_INFORMATION;

  MORE_PARALLEL_PORT_INFORMATION = packed record
    InterfaceType:integer;//     	INTERFACE_TYPE
    BusNumber:cardinal;
    InterruptLevel:cardinal;
    InterruptVector:cardinal;
    InterruptAffinity:cardinal;
    InterruptMode:integer;
  end;
  TMORE_PARALLEL_PORT_INFORMATION=MORE_PARALLEL_PORT_INFORMATION;
  PMORE_PARALLEL_PORT_INFORMATION =^MORE_PARALLEL_PORT_INFORMATION;


  PARALLEL_PNP_INFORMATION = packed record
    OriginalEcpController:PHYSICAL_ADDRESS;
    EcpController:PUCHAR;
    SpanOfEcpController:ULONG;
    PortNumber:ULONG;
    HardwareCapabilities:ULONG;
    TrySetChipMode:pointer;
    ClearChipMode:pointer;
    FifoDepth:ULONG;
    FifoWidth:ULONG;
    EppControllerPhysicalAddress:PHYSICAL_ADDRESS;
    SpanOfEppController:ULONG;
    Ieee1284_3DeviceCount:ULONG;
    TrySelectDevice:pointer;
    DeselectDevice:pointer;
    Context:integer;
    CurrentMode:ULONG;
    PortName:PWChar;// symbolic link name for legacy device object
  end;

  TPARALLEL_PNP_INFORMATION=PARALLEL_PNP_INFORMATION;
  PPARALLEL_PNP_INFORMATION=^PARALLEL_PNP_INFORMATION;

  PARCLASS_NEGOTIATION_MASK = packed record
    usReadMask:TLptModes;
    usWriteMask:TLptModes;
  end;
  TPARCLASS_NEGOTIATION_MASK=PARCLASS_NEGOTIATION_MASK;
  PPARCLASS_NEGOTIATION_MASK=^PARCLASS_NEGOTIATION_MASK;


  TIoRequest = packed record
    port:dword;
    licx:dword;
	  length:dword;
    data : dword;
  end;


Const
  LptModeStrings:array [TLptMode] of string=(
  'CENTRONICS',
  'IEEE_COMPATIBILITY',
  'NIBBLE',
  'CHANNEL_NIBBLE',
  'BYTE_BIDIR',
  'EPP_HW',
  'EPP_SW',
  'BOUNDED_ECP',
  'ECP_HW_NOIRQ',
  'ECP_HW_IRQ',
  'ECP_SW');

  // ===========================
  // nrio.sys declarations ...
  // ---------------------------
  CS_DRV_LPT_DEVICE_NAME = 'nrio';
  CS_DRV_LPT_RESBIN_NAME = 'nriobin';
//  IOCTL_READ_PORT_UCHAR	 = -1673519100; //CTL_CODE(40000, 0x801, METHOD_BUFFERED, FILE_ANY_ACCESS)
//  IOCTL_WRITE_PORT_UCHAR = -1673519096; //CTL_CODE(40000, 0x802, METHOD_BUFFERED, FILE_ANY_ACCESS)

  IOCTL_READ_PORT_UCHAR = (
       (FILE_DEVICE_UNKNOWN shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (($801) shl 2) or
       METHOD_BUFFERED);

  IOCTL_WRITE_PORT_UCHAR = (
       (FILE_DEVICE_UNKNOWN shl 16) or
       (FILE_ANY_ACCESS shl 14)or
       (($802) shl 2) or
       METHOD_BUFFERED);


Type
  TnrLptDriver = class(TnrDriverBase)
  public
    constructor Create; override;
    function Open:THandle;  override;
    procedure Close; override;
    procedure OutByte(aPort:word; aByte:byte); virtual;
    function InByte(aPort:word):byte;         virtual;
  end;

{ TnrLptDriver }

constructor TnrLptDriver.Create;
begin
  inherited Create;
  fDeviceName := CS_DRV_LPT_DEVICE_NAME;
  fResName := CS_DRV_LPT_RESBIN_NAME;
end;
                                             
function TnrLptDriver.Open: THandle;
begin
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS
    then Result := INVALID_HANDLE_VALUE - 1
    else Result := inherited Open;
end;

procedure TnrLptDriver.Close;
begin
  if Win32Platform <> VER_PLATFORM_WIN32_WINDOWS
    then inherited Close;
end;

function TnrLptDriver.InByte(aPort: word): byte;
var Sz:dword;
    req : TIoRequest;
begin
  req.port := aPort;
  req.licx := GetLicx;
  req.length := 1;
  //Data := aPort;
  DeviceIoControl(fHandle,Cardinal(IOCTL_READ_PORT_UCHAR),
                          @req, SizeOf(TIoRequest), @req, SizeOf(TIoRequest), Sz ,nil);
  Result := req.Data;
end;

procedure TnrLptDriver.OutByte(aPort: word; aByte: byte);
var Sz:dword;
    req : TIoRequest;
begin
  req.licx := GetLicx;
  req.length := 1;
  req.port := aPort;
  req.data := aByte;
  DeviceIoControl(fHandle, IOCTL_WRITE_PORT_UCHAR,
                           @req, SizeOf(req), nil, 0, Sz, nil);
end;

{ TnrLPT }

constructor TnrLpt.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fDirectMode := True;
  {$IFDEF TRIAL}
  if (MessageBox(0,MsgText ,MsgCapt,MB_YESNO) <> IDNO) and (not(csDesigning in ComponentState))
     then  ShellExecute(0,'open','http://www.deepsoftware.com/nrcomm/buy.html',nil,nil,SW_SHOWDEFAULT);
  {$ENDIF}
  Drv := TnrLptDriver.Create;//(CS_DRV_DEVICE_NAME,'',CS_DRV_RESBIN_NAME)
  LptPort := lpLPT1;
end;

destructor TnrLpt.Destroy;
begin
  if Active then Close;
  Drv.Free;
  inherited Destroy;
end;

procedure TnrLPT.SetDeviceIndex(const Value: integer);
begin
  if (Value < 0) or (Value >= DeviceCount) then  exit;
  SetLptPortNo(Device[Value].Data);
end;

function TnrLPT.GetDeviceIndex: integer;
begin
  Result := IndexOfDeviceData(LptPortNo);
end;

function TnrLPT.GetLptPort: TLptPorts;
begin
  if fLptPortNo<(Word(lpLPTxx)+1)
     then Result:=TLptPorts(fLptPortNo-1)
     else Result:=lpLPTxx;
end;

procedure TnrLPT.SetLptPort(const Value: TLptPorts);
begin
  if Value <> lpLPTxx then SetLPTPortNo(Word(Value)+1);
end;

procedure TnrLPT.SetLptPortNo(const Value: byte);
var flSave:boolean;
    i:integer;
begin
  flSave:=Active;
  Active:=False;
  fLptPortNo := Value;
  //i := glLptEnums.IndexOf(GetLptname);
  i := IndexOfDeviceData(Value);
  if i>=0 then fPortBase := Device[i].DataEx;//  Integer(glLptEnums.Objects[i]);
  Active:=flSave;
  DoNotify(csDeviceIdChanged);
end;

function TnrLPT.GetLptPortNo: byte;
begin
  Result:=fLptPortNo;
end;

{$IFDEF TRIAL}
var ecx : integer = $6532f4c1;
{$ENDIF}

function TnrLPT.AddLptDevice(aLpt:string; aData,aDataEx:integer): integer;
var Dev : TnrDevice;
begin
  Dev := TnrDevice.Create;
  Dev.NameFriendly := aLpt;
  Dev.NameDeviceDos := aLpt;
  Dev.Data := aData;
  Dev.DataEx := aDataEx;
  Result := AddDevice(Dev);
end;

procedure TnrLPT.DeviceListLoad;
var Buff:pointer;
    Sz,Cnt:dword;
    i,j:integer;
    wpb:word;
    LptInf:^PORT_INFO_2;
    s:string;
    sReg{, s}:string;
    hK2:HKEY;
    slDev:TStringList;
begin
  if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
    //LPT enumeration for Win9x platform ...
    if not EnumPorts(nil,2,nil,0,Sz,Cnt) then
      if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin
        GetMem(Buff, Sz);
        LptInf:=Buff;
        if EnumPorts(nil,2,Buff,Sz,Sz,Cnt) then
          for i:=0 to Integer(Cnt)-1 do begin
            s:='';
            if(LptInf^.fPortType and PORT_TYPE_WRITE)<>0 then s:=s+' w';
            if(LptInf^.fPortType and PORT_TYPE_READ)<>0 then s:=s+' r';
            if(LptInf^.pPortName[0]=pcLPT[4])and
              (LptInf^.pPortName[1]=pcLPT[5])and
              (LptInf^.pPortName[2]=pcLPT[6]) then begin
              //Devices.AddObject(String(LptInf^.pPortName),
              //TObject(Byte(LptInf^.pPortName[3])-$30));
              case (Byte(LptInf^.pPortName[3])-$30) of
                1: wpb:=$378;
                2: wpb:=$278;
                else wpb:=$3BC;
              end;
              //glLptEnums.AddObject(String(LptInf^.pPortName),TObject(wpb));
              AddLptDevice(String(LptInf^.pPortName),Byte(LptInf^.pPortName[3])-$30,wpb);
            end;
            LptInf:=Pointer(Cardinal(LptInf)+SizeOf(PORT_INFO_2));
          end;
        FreeMem(Buff);
      end;
  end else begin
    //LPT enumeration for WinNT platform ...
    GetMem(Buff, 2048);
    slDev := TStringList.Create;
    DiEnumInstalledDevices(@GUID_DEVCLASS_PORTS, True, True, False, slDev);
    for i := 0 to slDev.Count - 1 do begin
      s := TnrDevice(slDev.Objects[i]).PortName;
      if Pos('LPT',s) < 1 then continue;
      //if (AnsiCompareText(sServ, 'Parport') <> 0) and  then continue;
      sReg := TnrDevice(slDev.Objects[i]).RegKey;
      j := StrToIntDef(Copy(s, 4, 1),1);
      //get port base I/O address ...
      wpb := $378;
      if RegOpenKeyEx(HKEY_LOCAL_MACHINE,PChar(RegGetKeyParentName(sReg) + '\LogConf'), 0, KEY_QUERY_VALUE, hK2) = ERROR_SUCCESS then begin
        Sz := 2048;
        if RegQueryValueEx (hK2, 'BootConfig', nil, nil, Buff, @Sz) = ERROR_SUCCESS then begin
          if Sz > $19
            then wpb := PWord(Cardinal(Buff)+$18)^;
        end;
        RegCloseKey(hK2);
      end;
      AddLptDevice(s, j, wpb);
    end;
    FreeMem(Buff);
    slDev.Free;
  end;
end;

function TnrLPT.GetLptName: string;
begin
  Result:='LPT'+Char(LptPortNo+$30);
end;

function TnrLPT.RequestDeviceHandle: THandle;
begin
//  pcLPT[7]:=Char(Byte(fLptPort)+$31);
  if DirectMode
    then Result := Drv.Open
    else Result := CreateFile(PChar('\\.\'+LptName),(GENERIC_READ + GENERIC_WRITE),
          0,nil, OPEN_EXISTING,{FILE_FLAG_OVERLAPPED}0,0);
end;

procedure TnrLPT.RequestDeviceHandleClose(aHandle: THandle);
begin
  if DirectMode
    then Drv.Close
    else inherited RequestDeviceHandleClose(aHandle);
end;

{$IFDEF TRIAL}
function eax:string;
Const
  esi:PAnsiChar=
#$35#$03#$19#$4C#$0D#$1E#$09#$4C#$19#$1F#$05#$02#$0B#$4C#$18#$1E +
#$05#$0D#$00#$4C#$02#$1E#$2F#$03#$01#$01#$20#$05#$0E#$4C#$1A#$09 +
#$1E#$1F#$05#$03#$02#$4D#$61#$66#$3C#$00#$09#$0D#$1F#$09#$4C#$1E +
#$09#$0B#$05#$1F#$18#$09#$1E#$4D;

var i:integer;
begin
  Result := '';
  for i := 0 to 55 do Result := Result + Char(Byte(esi[i]) xor Byte('l'));
  Result := Result + #0;
end;
{$ENDIF}

procedure TnrLPT.Open;
var Md:byte;
    Rslt:dword;
begin
  Drv.Log := Log;

  inherited Open;

  if Handle=INVALID_HANDLE_VALUE then begin
    DoFatalErrors(ECC_LPT,0,GetLptName + ' open is failed.'#13+SysErrorMessage(GetLastError()),False);
    exit;
  end else begin
    if DirectMode then begin
      if fPortBase = 0 then begin
        DoFatalErrors(ECC_LPT,0,GetLptName + ' open in Direct Mode is failed. Base I/O port is NULL',False);
        exit;
      end;

      LoggingFmt(dlSimple ,'Direct mode. Base address: %x',[fPortBase]);

      {case LptPort of
        lpLPT1: fPortBase:=$378;
        lpLPT2: fPortBase:=$278;
        lpLPT3: fPortBase:=$3BC;
        else fPortBase:=$378;
      end;}

    end else begin
      Logging(dlSimple, 'Common mode.');
      Md := PARALLEL_INIT;
      DeviceIoControl(Handle,IOCTL_PAR_SET_INFORMATION,@Md,1,nil,0,Rslt,nil);
    end;
    {$IFDEF TRIAL}
    Inc(ecx);
    {$ENDIF}
//    GetAllInfo;
  end;
end;

function TnrLPT.GetPortFree: boolean;
var ir:boolean;
    Rslt:dword;
begin
  Result := False;
  if Active then begin
    Result := DeviceIoControl(Handle, IOCTL_PAR_IS_PORT_FREE, nil, 0, @ir, 4, Rslt, nil);
    if Result then Result:=ir;
   end;
end;

function TnrLPT.GetPortModes: boolean;
var Modes:PARCLASS_NEGOTIATION_MASK;
    Rslt:dword;
begin
  Result:=DeviceIoControl(Handle,IOCTL_IEEE1284_GET_MODE,
     nil,0, @Modes,SizeOf(PARCLASS_NEGOTIATION_MASK),Rslt,nil);
  fReadModes:=Modes.usReadMask;
  fWriteModes:=Modes.usWriteMask;
end;

procedure TnrLPT.SetReadModes(const Value: TLptModes);
begin
  fReadModes := Value;
end;

procedure TnrLPT.SetWriteModes(const Value: TLptModes);
begin
  fWriteModes := Value;
end;

function GetModeNames(M:TLptModes):string;
begin
  Result:='';
  if pmCENTRONICS in M
    then Result:=Result+' '+LptModeStrings[pmCENTRONICS];
  if pmIEEE in M
    then Result:=Result+' '+LptModeStrings[pmIEEE];
  if pmNIBBLE in M
    then Result:=Result+' '+LptModeStrings[pmNIBBLE];
  if pmCHANNEL_NIBBLE in M
    then Result:=Result+' '+LptModeStrings[pmCHANNEL_NIBBLE];
  if pmBYTE_BIDIR in M
    then Result:=Result+' '+LptModeStrings[pmBYTE_BIDIR];
  if pmEPP_HW in M
    then Result:=Result+' '+LptModeStrings[pmEPP_HW];
  if pmEPP_SW in M
    then Result:=Result+' '+LptModeStrings[pmEPP_SW];
  if pmBOUNDED_ECP in M
    then Result:=Result+' '+LptModeStrings[pmBOUNDED_ECP];
  if pmECP_HW_NOIRQ in M
    then Result:=Result+' '+LptModeStrings[pmECP_HW_NOIRQ];
  if pmECP_HW_IRQ in M
    then Result:=Result+' '+LptModeStrings[pmECP_HW_IRQ];
  if pmECP_SW in M
    then Result:=Result+' '+LptModeStrings[pmECP_SW];
end;

procedure TnrLPT.SetLptModes;
var Modes:PARCLASS_NEGOTIATION_MASK;
    rs:boolean;
    Rslt:dword;
begin
  Modes.usReadMask:=fReadModes;
  Modes.usWriteMask:=fWriteModes;
  Rs:=DeviceIoControl(Handle,IOCTL_IEEE1284_NEGOTIATE,
       @Modes,4,
       @Modes,4,
       Rslt,nil);
  if not Rs then begin
    DoFatalErrors(ECC_LPT,0,'Set modes error '+SysErrorMessage(GetLastError()),False);
    exit;
  end;
  fReadModes:=Modes.usReadMask;
  fWriteModes:=Modes.usWriteMask;
//  GetPortModes;
end;

procedure TnrLPT.SendChar(const Ch: Char);
begin
  if Handle <> INVALID_HANDLE_VALUE then begin
    //LoggingFmt(dlDebug,'Try to send char %s ...',[Ch]);
    if DirectMode then begin
      SetDataBits(Byte(Ch));
      Pins[1] := True;
      Pins[1] := False;
    end else begin
      if WriteASync(Handle,@Ch,1,fOvlWrite) then begin
//      fTotalSent:=fTotalSent+i;
//      if Assigned(fOnSent) then fOnSent(Self);
      end;// else DoCommError(0,GetLastError(),[]);
    end;
  end;
end;

procedure TnrLPT.SendString(const S: AnsiString);
var i,len:cardinal;
begin
  if Handle <> INVALID_HANDLE_VALUE then begin
    len := Length(S);
    if len <= 0 then exit;
    LoggingFmt(dlDebug, 'Try to send string %s ...', [s]);
    for i := 1 to len do begin
      //Wait for clear Busy signal ...
      if (not ControlBusy) or WaitForStatus($80,$80,100)
        then SendChar(Char(S[i]));
    end;
  end;
end;

procedure TnrLPT.SendData(const Buff: PAnsiChar; const N: cardinal);
var i:cardinal;
begin
  if Handle <> INVALID_HANDLE_VALUE then begin
    LoggingFmt(dlDebug, 'Try to send data. Length: %u' , [N]);
    for i := 0 to N - 1 do begin
      //Wait for clear Busy signal ...
      if (not ControlBusy) or WaitForStatus($80,$80,100)
        then SendChar(Char(Buff[i]));
    end;
  end;
end;

function TnrLPT.GetDeviceStatus: TnrLptStatus;
var Rslt:boolean;
    Ch:byte;
    Sz,Buff:dword;
begin
  if not Active then begin
    Result:=[lsPortClosed];
    exit;
  end else begin
    Result:=[];
    Sz:=1;
    Rslt:=DeviceIoControl(Handle,IOCTL_PAR_QUERY_INFORMATION,
      @Ch,Sz,@Ch,Sz,Buff,nil);
    if not Rslt then begin
      DoFatalErrors(ECC_LPT,0,'Get status error '+SysErrorMessage(GetLastError()),False);
      exit;
    end;
    if (Ch and PARALLEL_INIT)<>0
      then Result:=Result+[lsInit];
    if (Ch and PARALLEL_AUTOFEED)<>0
      then Result:=Result+[lsAutoFeed];
    if (Ch and PARALLEL_PAPER_EMPTY)<>0
      then Result:=Result+[lsPaperEmpty];
    if (Ch and PARALLEL_OFF_LINE)<>0
      then Result:=Result+[lsOffLine];
    if (Ch and PARALLEL_POWER_OFF)<>0
      then Result:=Result+[lsPowerOff];
    if (Ch and PARALLEL_NOT_CONNECTED)<>0
      then Result:=Result+[lsNotConnected];
    if (Ch and PARALLEL_BUSY)<>0
      then Result:=Result+[lsBusy];
    if (Ch and PARALLEL_SELECTED)<>0
      then Result:=Result+[lsSelected];
  end;

end;

function TnrLPT.GetReadModes: TLptModes;
begin
  Result:=fReadModes;
end;

function TnrLPT.GetWriteModes: TLptModes;
begin
  Result:=fWriteModes;
end;

function TnrLPT.GetBitsControl: byte;
begin
  Result:=0;
  if DirectMode then Result:=TnrLptDriver(Drv).InByte(fPortBase+2);
end;

function TnrLPT.GetBitsStatus: byte;
begin
  Result:=0;
  if DirectMode then Result:=TnrLptDriver(Drv).InByte(fPortBase+1);
end;

function TnrLPT.GetDataBits: byte;
begin
  Result:=0;
  if DirectMode then Result:=TnrLptDriver(Drv).InByte(fPortBase);
end;

procedure TnrLPT.SetBitsControl(const Value: byte);
begin
  if DirectMode then TnrLptDriver(Drv).OutByte(fPortBase+2,Value);
end;

procedure TnrLPT.SetBitsStatus(const Value: byte);
begin
  if DirectMode then TnrLptDriver(Drv).OutByte(fPortBase+1,Value);
end;

procedure TnrLPT.SetDataBits(const Value: byte);
begin
  if DirectMode then TnrLptDriver(Drv).OutByte(fPortBase,Value);
end;

function TnrLPT.GetPin(Index: integer): boolean;
var Pn:byte;
begin
  Pn:=0;
  case Index of
    2..9: begin                 //DATA pins (BasePort)...
      Pn:=BitsData;
      Index:=Index-2;
    end;
    1,14,16,17:begin            //Control pins (BasePort+2)...
      Pn:=BitsControl;
      Dec(Index);
      if Index>0 then Index:=Index-12;
      if index>1 then Dec(Index);
    end;
    10..13,15:begin             //Status pins (BasePort+1)...
      Pn:=BitsStatus;
      case Index of
        10:Index:=6;
        11:Index:=7;
        12:Index:=5;
        13:Index:=4;
        15:Index:=3;
      end;
    end;
  end;

  {$IFDEF TRIAL}
  if (7 and ecx) = 0
    then OutputDebugString(PChar(eax)); //MessageBox(0, PChar(eax),'',0);
  {$ENDIF}

  Result:=((Pn and (1 shl Index))<>0);
end;

procedure TnrLPT.SetPin(Index: integer; const Value: boolean);
var Pn:byte;
begin
  case Index of
    2..9: begin                 //DATA pins (BasePort)...
      Pn:=BitsData;
      Index:=Index-2;
      if Value then Pn:=Pn or (1 shl Index)
               else Pn:=Pn and (not (1 shl Index));
      BitsData:=Pn;
    end;
    1,14,16,17:begin            //Control pins (BasePort+2)...
      Pn:=BitsControl;
      Dec(Index);
      if Index>0 then Index:=Index-12;
      if index>1 then Dec(Index);
      if Value then Pn:=Pn or (1 shl Index)
               else Pn:=Pn and (not (1 shl Index));
      BitsControl:=Pn;
    end;
    10..13,15:begin             //Status pins (BasePort+1)...
      Pn:=BitsStatus;
      case Index of
        10:Index:=6;
        11:Index:=7;
        12:Index:=5;
        13:Index:=4;
        15:Index:=3;
      end;
      if Value then Pn:=Pn or (1 shl Index)
               else Pn:=Pn and (not (1 shl Index));
      BitsStatus:=Pn;
    end;
  end;
end;

procedure TnrLPT.SetDirectMode(const Value: boolean);
var flAct:boolean;
begin
  if fDirectMode <> Value then begin
    flAct:=Active;
    if Active then Close;
    fDirectMode := Value;
    if flAct then Open;
  end;
end;

function TnrLPT.GetLptIOBase: word;
begin
  Result:=fPortBase;
end;

procedure TnrLPT.SetLptIOBase(const Value: word);
begin
  fPortBase:=Value;
end;

function TnrLPT.WaitForStatus(const bmSig, bmVal: byte;
  Ms: cardinal): boolean;
var Pn:byte;
begin
  Result := False;
  if Handle = INVALID_HANDLE_VALUE then exit;
  Ms := Ms + GetTickCount();
  while Ms >= GetTickCount() do begin
    Pn := BitsStatus;
    Result := Boolean((Pn and bmSig) = bmVal);
    if Result then break;
    sleep(5);
    {$IFDEF NR_WITH_CONTROLS}
    if Assigned(Application) then Application.ProcessMessages;
    {$ENDIF}
  end;
end;

procedure TnrLPT.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Operation = opRemove then begin
    if Assigned(Drv) and (AComponent = Log) then Drv.Log := nil;
  end;
  inherited Notification(AComponent, Operation);
end;

function TnrLPT.GetControlBusy: boolean;
begin
  Result := fControlBusy;
end;

procedure TnrLPT.SetControlBusy(const Value: boolean);
begin
  fControlBusy := Value;
end;

end.
