Using the LPT port in the 64 bit application

Using the LPT port in the 64 bit application.
An example of the use of dynamic libraries inpout32.dll in 64 bit and 32 bit application. Tested on Windows XP SP3 Pro 32bit, Windows 7 Pro 64bit and 32bit, Windows Server 2008 R2, Windows 8 Enterprise 64bit, Windows Server 2012.

{*------------------------------------------------------------------------
 *  Aleksandr Nazaruk 
 *  http://freehand.com.ua
 *------------------------------------------------------------------------*}

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.UITypes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, IniFiles,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.ComCtrls;

{$ifdef Win64}
  const
    iodll = 'inpoutx64.dll';
{$Else}
  const
    iodll = 'inpout32.dll';
{$EndIf}

type
  Bit = 0..1;

type
  TBitSet = array[0..7] of Bit;


type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    GroupBox5: TGroupBox;
    StatusBar1: TStatusBar;
    Edit1: TEdit;
    Button9: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Button11: TButton;
    t_LPTMon: TTimer;
    ComboBox1: TComboBox;
    Label5: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    N4: TMenuItem;
    Button10: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Label8: TLabel;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Button17: TButton;
    Button18: TButton;
    Button19: TButton;
    Button20: TButton;
    Label10: TLabel;
    GroupBox6: TGroupBox;
    Label11: TLabel;
    Label12: TLabel;
    Edit7: TEdit;
    Button16: TButton;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Button21: TButton;
    Edit11: TEdit;
    Label13: TLabel;
    procedure Button8Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    Function isInpout32Load: boolean;
    procedure t_LPTMonTimer(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    Function IOINIPortToDec(port : string):word;
    procedure Button11Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Edit4Enter(Sender: TObject);
    procedure Edit4Exit(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Edit7Change(Sender: TObject);
    procedure Button17Click(Sender: TObject);
    procedure Button19Click(Sender: TObject);
    procedure Edit10Change(Sender: TObject);
    procedure Edit8Change(Sender: TObject);
    procedure Button21Click(Sender: TObject);
    procedure Button16Click(Sender: TObject);
    procedure Edit11Change(Sender: TObject);
  private
    { Private declarations }
  public
    InpOut32Handle      : THandle;
    Inp32               : function(PortAdr: word): byte; stdcall;
    Out32               : function(PortAdr: word; Data: byte): byte; stdcall;
    IsInpOutDriverOpen  : function()  : boolean;  stdcall;
    IsXP64Bit           : function()   : boolean;  stdcall;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetNBit (X, N: byte): Bit;
begin
  Result := x shr N and 1;
end;

function GetBits (X: byte): TBitSet;
var
  N: integer;
begin
  for N := 0 to 7 do
    Result[N] := GetNBit(X, N);
end;

function MakeByte (BitSet: TBitSet): byte;
var
  i: integer;
begin
  Result := 0;
  for i := 7 downto 0 do
    Result := Result shl 1 + (BitSet[i] and 1);
end;

Function TForm1.isInpout32Load: boolean;
begin
  result:=false;
  try
    if inpout32Handle <> 0 then
    begin
      result:=IsInpOutDriverOpen;
    end;
  except
    result:=false
  end;
end;




procedure TForm1.N4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.t_LPTMonTimer(Sender: TObject);
var
  port : integer;
begin
  if assigned(Inp32) then
  begin
    // Data
    port:=strtoint(edit6.Text);
    edit1.Text:=inttostr(Inp32(port));
    // Status
    inc(port,1);
    edit11.Text:=inttostr(Inp32(port));

    // Control
    inc(port,1);
    edit7.Text:=inttostr(Inp32(port));
  end;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
  if assigned(Out32) then
  begin
    try
      Out32(strtoint(edit6.Text), strtoint(edit4.Text));
    except
      on E : Exception do
      begin
        MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
      end;
    end;
  end;
end;

procedure TForm1.Button16Click(Sender: TObject);
var
  port : integer;
begin
  if assigned(Out32) then
  begin
    try
      port:=strtoint(edit6.Text);
      inc(port, 2);
      Out32(port, strtoint(edit8.Text));
    except
      on E : Exception do
      begin
        MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
      end;
    end;
  end;

end;

procedure TForm1.Button17Click(Sender: TObject);
var
  BitSet : TBitSet;
  b : Bit;
  b1: byte;
  port : integer;
begin
  try
    if (Sender as TButton).Caption='1' then b:=1 else b:=0;
    b1 := strtoint(edit7.Text)
  finally
    BitSet:=GetBits(b1);
    BitSet[(Sender as TButton).Tag]:=b;
    if assigned(Out32) then
    begin
      try
        port:=strtoint(edit6.Text);
        inc(port,2);

        Out32(port, Makebyte(BitSet));
      except
        on E : Exception do
        begin
          MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
        end;
      end;
    end;
  end;

end;

procedure TForm1.Button19Click(Sender: TObject);
var
  BitSet : TBitSet;
  b : Bit;
  b1: byte;
  port : integer;
begin
  try
    if (Sender as TButton).Caption='1' then b:=0 else b:=1;
    b1 := strtoint(edit7.Text)
  finally
    BitSet:=GetBits(b1);
    BitSet[(Sender as TButton).Tag]:=b;
    if assigned(Out32) then
    begin
      try
        port:=strtoint(edit6.Text);
        inc(port,2);

        Out32(port, Makebyte(BitSet));
      except
        on E : Exception do
        begin
          MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
        end;
      end;
    end;
  end;


end;

procedure TForm1.Button21Click(Sender: TObject);
var
  port : integer;
begin
  if assigned(Out32) then
  begin
    try
      port:=strtoint(edit6.Text);
      inc(port, 2);
      Out32(port, strtoint(edit10.Text));
    except
      on E : Exception do
      begin
        MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
      end;
    end;
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
var
  BitSet : TBitSet;
  b : Bit;
  b1: byte;
begin
  try
    if (Sender as TButton).Caption='1' then b:=0 else b:=1;
    b1 := strtoint(edit1.Text)
  finally
    BitSet:=GetBits(b1);
    BitSet[(Sender as TButton).Tag]:=b;
    if assigned(Out32) then
    begin
      try
        Out32(strtoint(edit6.Text), Makebyte(BitSet));
      except
        on E : Exception do
        begin
          MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
        end;
      end;
    end;
  end;
end;



procedure TForm1.Button9Click(Sender: TObject);
begin

  if assigned(Out32) then
  begin
    try
      Out32(strtoint(edit6.Text), strtoint(edit2.Text));
    except
      on E : Exception do
      begin
        MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
      end;
    end;
  end;
end;

Function TForm1.IOINIPortToDec(port : string):word;
const section = 'LPT';
var
IniFile : TIniFile;
fileConfig : string;
begin
  result:=0;
  try
    fillchar(result,sizeof(result),#0);
    fileConfig := ExtractFilePath(ParamStr(0))+'io.ini';
    IniFile := TIniFile.Create(fileconfig);
    try
      try
        result:=IniFile.ReadInteger(section,port,0);
      except
        result:=0;
      end;

    finally
      IniFile.Free;
    end;

  except
    ;
  end;
end;



procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  try
    edit6.Text:=inttostr(IOINIPortToDec(combobox1.Items.Strings[combobox1.ItemIndex]));
    edit5.Text:='$'+IntToHex(strtoint(edit6.Text),2);
  except
    edit6.Text:='0';
    edit5.Text:='$00';
  end;

end;

procedure TForm1.Edit10Change(Sender: TObject);
begin
 if edit8.Tag=1 then exit;
  try
    edit8.Text:='$'+IntToHex(strtoint(edit10.Text),2);
  except
   ;
  end;
end;

procedure TForm1.Edit11Change(Sender: TObject);
var
  b : byte;
  BitSet : TBitSet;
begin
  try
    b := strtoint(edit11.Text);
  finally
    BitSet:=GetBits(b);

    button10.Caption:=inttostr(abs(BitSet[3]));
    button12.Caption:=inttostr(abs(BitSet[4]));
    button13.Caption:=inttostr(BitSet[5]);
    button14.Caption:=inttostr(abs(BitSet[6]));
    button15.Caption:=inttostr(abs(BitSet[7]-1));
  end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
  b : byte;
  BitSet : TBitSet;
begin
  try
    b := strtoint(edit1.Text);
  finally
    edit3.Text:='$'+IntToHex(b,2);
    BitSet:=GetBits(b);
    button8.Caption:=inttostr(BitSet[0]);
    button7.Caption:=inttostr(BitSet[1]);
    button6.Caption:=inttostr(BitSet[2]);
    button5.Caption:=inttostr(BitSet[3]);
    button4.Caption:=inttostr(BitSet[4]);
    button3.Caption:=inttostr(BitSet[5]);
    button2.Caption:=inttostr(BitSet[6]);
    button1.Caption:=inttostr(BitSet[7]);
  end;

end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  if edit4.Tag=1 then exit;
  try
    edit4.Text:=inttostr(strtoint(edit2.Text));
  except
    edit4.Text:='';
  end;
end;

procedure TForm1.Edit4Change(Sender: TObject);
begin
  if edit2.Tag=1 then exit;
  try
    edit2.Text:='$'+IntToHex(strtoint(edit4.Text),2);
  except
   ;
  end;
end;

procedure TForm1.Edit4Enter(Sender: TObject);
begin
  (Sender as TEdit).Tag:=1;
end;

procedure TForm1.Edit4Exit(Sender: TObject);
begin
  (Sender as TEdit).Tag:=0;
end;

procedure TForm1.Edit7Change(Sender: TObject);
var
  b : byte;
  BitSet : TBitSet;
begin
  try
    b := strtoint(edit7.Text);
  finally
    edit9.Text:='$'+IntToHex(b,2);
    BitSet:=GetBits(b);

    button17.Caption:=inttostr(abs(BitSet[0]-1));
    button18.Caption:=inttostr(abs(BitSet[1]-1));
    button19.Caption:=inttostr(BitSet[2]);
    button20.Caption:=inttostr(abs(BitSet[3]-1));

  end;
end;

procedure TForm1.Edit8Change(Sender: TObject);
begin
  if edit10.Tag=1 then exit;
  try
    edit10.Text:=inttostr(strtoint(edit8.Text));
  except
    edit10.Text:='';
  end;
end;

Procedure TForm1.FormCreate(Sender: TObject);
var
  i : integer;
  LPTHandl: THandle;
  b:byte;
  b1 : PByte;
begin
  button1.Tag:=7;
  button2.Tag:=6;
  button3.Tag:=5;
  button4.Tag:=4;
  button5.Tag:=3;
  button6.Tag:=2;
  button7.Tag:=1;
  button8.Tag:=0;
  button20.Tag:=3;
  button19.Tag:=2;
  button18.Tag:=1;
  button17.Tag:=0;
  t_LPTMon.Enabled:=false;
  button1.Enabled:=false;
  button2.Enabled:=false;
  button3.Enabled:=false;
  button4.Enabled:=false;
  button5.Enabled:=false;
  button6.Enabled:=false;
  button7.Enabled:=false;
  button8.Enabled:=false;
  button9.Enabled:=false;
  button11.Enabled:=false;
  button17.Enabled:=false;
  button18.Enabled:=false;
  button19.Enabled:=false;
  button20.Enabled:=false;
  button21.Enabled:=false;
  button16.Enabled:=false;
  edit2.Enabled:=false;
  edit4.Enabled:=false;
  edit8.Enabled:=false;
  edit10.Enabled:=false;
  combobox1.Enabled:=false;


  try
    inpout32Handle := loadLibrary(PWChar(WideString(iodll)));
    if inpout32Handle <> 0 then
    begin
      @Inp32               :=nil;
      @Out32               :=nil;
      @IsInpOutDriverOpen  :=nil;
      @IsXP64Bit           :=nil;
      @IsInpOutDriverOpen := getProcAddress(inpout32Handle, 'IsInpOutDriverOpen');
      @Out32 := getProcAddress(inpout32Handle, 'Out32');
      @Inp32 := getProcAddress(inpout32Handle, 'Inp32');
      @IsXP64Bit := getProcAddress(inpout32Handle, 'IsXP64Bit');
      if not assigned(Inp32) then
      begin
        MessageDlg(Format('getProcAddress(%d, Inp32) failed',[inpout32Handle]),mtError, mbOKCancel, 0);
      end;
      if not assigned(IsXP64Bit) then
      begin
        MessageDlg(Format('getProcAddress(%d, IsXP64Bit) failed',[inpout32Handle]),mtError, mbOKCancel, 0);
      end;
      if not assigned(Out32)then
      begin
        MessageDlg(Format('getProcAddress(%d, Out32) failed',[inpout32Handle]),mtError, mbOKCancel, 0);
      end;
      if not assigned(IsInpOutDriverOpen) then
      begin
        MessageDlg(Format('getProcAddress(%d, IsInpOutDriverOpen) failed',[inpout32Handle]),mtError, mbOKCancel, 0);
      end;
    end else
    begin
      MessageDlg(Format('loadLibrary(%s) failed',[iodll]),mtError, mbOKCancel, 0);
    end;
   except
    on E : Exception do
    begin
      MessageDlg(Format('Internal error %s',[E.Message]),mtError, mbOKCancel, 0);
    end;
   end;

  {$ifdef Win64}
    form1.Caption:='NT6.x LPT 64bit Demo Code FreeHand.com.ua 2013';
  {$Else}
    form1.Caption:='NT6.x LPT 32bit Demo Code FreeHand.com.ua 2013';
  {$EndIf}

  combobox1.Items.Clear;
  for i := 0 to 10 do
  begin
    LPTHandl := CreateFile(PWChar(WideString('LPT' + inttostr(i + 1))),
      GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING,
      FILE_FLAG_OVERLAPPED, 0);
    try
      if LPTHandl <> INVALID_HANDLE_VALUE then
      begin
        combobox1.Items.Add('LPT' + inttostr(i + 1));
        combobox1.ItemIndex:=0;
        button1.Enabled:=true;
        button2.Enabled:=true;
        button3.Enabled:=true;
        button4.Enabled:=true;
        button5.Enabled:=true;
        button6.Enabled:=true;
        button7.Enabled:=true;
        button8.Enabled:=true;
        button9.Enabled:=true;
        button11.Enabled:=true;
        button17.Enabled:=true;
        button18.Enabled:=true;
        button19.Enabled:=true;
        button20.Enabled:=true;
        button16.Enabled:=true;
        button21.Enabled:=true;
        combobox1.Enabled:=true;
        edit2.Enabled:=true;
        edit4.Enabled:=true;
        edit8.Enabled:=true;
        edit10.Enabled:=true;
        t_LPTMon.Enabled:=true;
      end;
    finally
      CloseHandle(LPTHandl);
    end;
  end;

  ComboBox1Change(self);
end;

end.

Stand: 

• Windows 8 Enterprise 64Bit Eng
• Delphi XE3

Links: 

• A versatile Dynamic Link Library for parallel port interfacing
• nt6lpt 32bit binary
• nt6lpt 64bit binary
• nt6lpt source project