[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Check if a pin of a parallel port is active.

Posted on 2009-12-21
13
Medium Priority
?
1,026 Views
Last Modified: 2012-05-08
Hello,

I want an example source code in Delphi 7 for this:

I want when the program receives a signal to show that an external switch has been closed for example to pin 2 of the parallel port LPT1(actually it's a relay contact so I could feed it a voltage, high, low e.t.c.) to set true the value of check box.

I want to use it in Windows 2000 server and XP.

Thanks in advance!
0
Comment
Question by:Alex
  • 4
  • 4
  • 3
  • +1
13 Comments
 
LVL 8

Expert Comment

by:thiagoblimeira
ID: 26099478
Use this component, with it you can check all the data pins and works perfectly with Windows 2000 and XP and best of all it's free.

And also my article about using this component is available for free at http://www.blaisepascal.eu/freedownloads/BlaiseUK6SPECIAL100P.zip

The component's source is below with the dcr file needed to work.
Rename this LPTPort.txt to LPTPort.dcr

Hope this helps

unit LPTPort;

interface
Uses
Windows , Classes, SysUtils, Dialogs;

(***********************************************************************************************)
(*  Author  : Shining-Freeman                                                                  *)
(*  Date    : 25/04/2003                                                                       *)
(*  Release : 10/03/2006                                                                       *)
(*  Purpose : contrôler le port parallèle                                                      *)
(***********************************************************************************************)

{
 Historiques :


 10/03/2006 : Ajout de
            SelectPort(Addr   : WORD); équivaut à LPTport := Addr
            SelectPortByIndex(PortIndex : Integer); choisit le port en fonction du combobox
            GetPhysDWORD(Addr : DWORD ; var Return : DWORD):Boolean; Lecture de la Mémoire Physique en DWORD=LongWord
            SetPhysDWORD(Addr : DWORD ; Value : DWORD):Boolean; écriture de la Mémoire Physique
            EnumPorts(Strings : TStrings);overload; énumération des Ports disponibles dans un Combobox;
            EnumPorts;overload; // énumération des Ports dans la List(TCollection)
            MakeMemLoc(Offset : DWORD ; Segment : DWORD): DWORD; transforme une adresse logique en adresse physique [xx:xx]
}


  Const
  Version = 'Bêta 1.3';

  Type

  TPinKind =
  (
  pkD0,
  pkD1,
  pkD2,
  pkD3,
  pkD4,
  pkD5,
  pkD6,
  pkD7
  );
  TPinKinds = Set of TPinKind;

  TPinInfo = record
  Name   : String;
  Kind   : TPinKind;
  Offset : Byte;
  end;

  Const
  { Table d'adressage des PIN's D0..D7
   Nota : sur le port parallele D0 est situé sur le pin 1
  }
  TPinLookUp : array[0..7] of TPinInfo=(
  (Name : 'D0' ; Kind : pkD0 ; Offset : $1),
  (Name : 'D1' ; Kind : pkD1 ; Offset : $2),
  (Name : 'D2' ; Kind : pkD2 ; Offset : $4),
  (Name : 'D3' ; Kind : pkD3 ; Offset : $8),
  (Name : 'D4' ; Kind : pkD4 ; Offset : $10),
  (Name : 'D5' ; Kind : pkD5 ; Offset : $20),
  (Name : 'D6' ; Kind : pkD6 ; Offset : $40),
  (Name : 'D7' ; Kind : pkD7 ; Offset : $80)
  );

  Type

  TOnPinChange = procedure (Sender : TObject ; Info : TPinInfo ; State : Boolean) of Object;


  TLPTList      = class;
  TLPTListItems = class;

  TLPTList = class(TCollection)
  private
    { Déclarations privées }
    FItemIndex : Integer;
    function GetItem (Index : Integer): TLPTListItems;
    procedure SetItem (Index : Integer ; Value : TLPTListItems);
  public
    { Déclarations publiques }
    ItemFind : TLPTListItems;
    Constructor Create;
    Destructor Destroy;override;
    function Add: TLPTListItems;
    function ItemExist (ItemName : String): Boolean;
    function ItemOf (ItemName : String): TLPTListItems;
    property Items[Index : Integer] : TLPTListItems read GetItem write SetItem; default;
    property ItemIndex : integer read FItemIndex write FItemIndex;
  published
  end;

  
  TLPTListItems = class(TCollectionItem)
  private
    { Déclarations privées }
    FName : String;
    FPort : WORD;
  protected
    { Déclarations protégées }
    Parent : TLPTList;
  public
    { Déclarations publiques }
    Constructor Create (Collection : TCollection);override;
    Destructor  Destroy;override;
    procedure   Assign (Source : TPersistent);override;
  published
    property    Name : String  read FName write FName;
    property    Port : WORD    read FPort write FPort;
  end;

  TLPTPort = class(TComponent)
  private
    FInitialized : Boolean;
    FDLLHandle   : THandle;
    FPort        : Word;
    { calcule des sommes pour les pins D0..D7}
    FPinHash     : Integer;
    FLS          : array[0..7] of Boolean;//Led State
    FOnPinChange : TOnPinChange;
    FInpOffset   : Integer;
    FUpdate      : Boolean;
    FPorts       : TLPTList;
    procedure   NotifyPinChange(Name : String ; State : Boolean);
    procedure   LoadSysDrivers;
    procedure   FreeSysDrivers;
    function    GetBytePort  (Addr : Word): Byte;
    function    GetDWordPort (Addr : Word): DWord;
    function    GetWordPort  (Addr : Word): Word;
    procedure   SetBytePort  (Addr : Word; const Value: Byte);
    procedure   SetDWordPort (Addr : Word; const Value: DWord);
    procedure   SetWordPort  (Addr : Word; const Value: Word);
    procedure   SetD0(const Value: Boolean);
    procedure   SetD1(const Value: Boolean);
    procedure   SetD2(const Value: Boolean);
    procedure   SetD3(const Value: Boolean);
    procedure   SetD4(const Value: Boolean);
    procedure   SetD5(const Value: Boolean);
    procedure   SetD6(const Value: Boolean);
    procedure   SetD7(const Value: Boolean);
    function    GetD0: Boolean;
    function    GetD1: Boolean;
    function    GetD2: Boolean;
    function    GetD3: Boolean;
    function    GetD4: Boolean;
    function    GetD5: Boolean;
    function    GetD6: Boolean;
    function    GetD7: Boolean;
    procedure   SetPorts(const Value : TLPTList);
  protected
    procedure   InitializeDrivers;
    procedure   FinalizeDrivers;
  public
    Constructor Create(AOwner : TComponent);override;
    Destructor  Destroy;override;
    procedure   BeginUpdate;
    procedure   EndUpdate;

    function    Open:Boolean;
    function    Close:Boolean;
    procedure   ClearPins;

    procedure   SetPin  (Name  : String; State : Boolean = true);
    procedure   SetPins (Names : array of String);

    procedure   SelectPort(Addr   : WORD);
    procedure   SelectPortByIndex(PortIndex : Integer);
    function    GetPhysDWORD(Addr : DWORD ; var Return : DWORD):Boolean;
    function    SetPhysDWORD(Addr : DWORD ; Value : DWORD):Boolean;

    procedure   EnumPorts(Strings : TStrings);overload;
    procedure   EnumPorts;overload;

    { fonction de sortie
      Out utiliser LPTPort pour l'accès
      OutP permet de spécifié un port
    }
    function    Out (Value : Byte):Boolean;overload;
    function    Out (Value : Word):Boolean;overload;
    function    Out (Value : DWord):Boolean;overload;

    function    Inp   : Byte;
    function    InpW  : Word;
    function    InpDW : DWord;

    function    OutP (Addr : Word; Value : Byte):Boolean;overload;
    function    OutP (Addr : Word; Value : Word):Boolean;overload;
    function    OutP (Addr : Word; Value : DWord):Boolean;overload;

    function    InpP  (Addr : Word) : Byte;
    function    InpWP (Addr : Word) : Word;
    function    InpDWP(Addr : Word) : DWord;

    property    Port   [Addr : Word] : Byte  read GetBytePort  write SetBytePort;
    property    PortW  [Addr : Word] : Word  read GetWordPort  write SetWordPort;
    property    PortDW [Addr : Word] : DWord read GetDWordPort write SetDWordPort;

    property    D0 : Boolean read GetD0 write SetD0;
    property    D1 : Boolean read GetD1 write SetD1;
    property    D2 : Boolean read GetD2 write SetD2;
    property    D3 : Boolean read GetD3 write SetD3;
    property    D4 : Boolean read GetD4 write SetD4;
    property    D5 : Boolean read GetD5 write SetD5;
    property    D6 : Boolean read GetD6 write SetD6;
    property    D7 : Boolean read GetD7 write SetD7;

    property    Initialized : Boolean   read FInitialized;
    property    Ports       : TLPTList  read FPorts write SetPorts;
  published
    property    LPTPort     : Word         read FPort        write FPort;

    {
     Inp normalement Inp = Base + 1 pour lire l'état
     donc inp vaut 1 par défaut, lors de l'appel à la fonction Inp, celle-ci renvoie inp(Port + LptInp);
    }
    property    InpOffset   : Integer      read FInpOffset   write FInpOffset default 1;

    property    OnPinChange : TOnPinChange read FOnPinChange write FOnPinChange;
  end;

{$R LPTPort.dcr}

function PinNameToPinInfo(Name  : String; var Info : TPinInfo):Boolean;
function PinValToPinKinds(Value : Byte):TPinKinds;
function GetDir:String;// revient au même que ExtractFilePath mais sans utiliser Application.ExeName(dans Forms)
function DecToBin(Value : Integer ; nBits : Integer = 8): String;
function HexToBin(Value : String  ; nBits : Integer = 8):String;
function IsNumeric(Value : String):Boolean;

{
 Make Memory Location
 permet d'avoir l'équivalent de la fonction TurboPascal MemW[xx:xx]
 Seulement cette fonction ne fait que calculer l'adresse physique à partir de l'adresse logique, et ne fournis aucun accès à celle-ci
 Exemple
 l'adresse logique [0040:0008] contient l'adresse du port de LPT1
 et donc son adresse physique est $408;

 autre exemple
 [$2135:$4A] correspond à l'adresse Physique $2139A
}

function MakeMemLoc(Offset : DWORD ; Segment : DWORD): DWORD;


procedure Register;

implementation

procedure Register;
begin
    RegisterComponents('SFC I/O' , [TLPTPort]);
end;

   Type
   TDriverInfo = record
   Name    : String;
   ResName : String;
   end;

   Const
   TDrivers : array [0..2] of TDriverInfo = (
   (Name : 'WinIO.dll' ; ResName : 'WIDL'), // noyau  Sys <> OS
   (Name : 'WinIO.sys' ; ResName : 'WISY'), //  pour Win2000,XP,NT
   (Name : 'WinIO.vxd' ; ResName : 'WIVX')  //  pour Win95,98
   );

  {
   Déclaration de la DLL WinIO.dll
  }
   var
   InitializeWinIo     : function : Boolean;stdcall;
   ShutdownWinIo       : function : Boolean;stdcall;
   MapPhysToLin        : function (var pbPhysAddr: Byte; dwPhysSize : Integer; var pPhysicalMemoryHandle : THandle):PByte;
   UnmapPhysicalMemory : function (PhysicalMemoryHandle : THandle; var pbLinAddr: Byte): Boolean;
   GetPhysLong         : function (pbPhysAddr : DWORD;  var pdwPhysVal  : DWORD): Boolean;stdcall;
   SetPhysLong         : function (pbPhysAddr : DWORD; dwPhysVal  : DWORD): Boolean;stdcall;
   GetPortVal          : function (wPortAddr : Word; var pdwPortVal : Integer; bSize: Byte): Boolean;stdcall;
   SetPortVal          : function (wPortAddr : Word; dwPortVal: Integer; bSize: Byte): Boolean;stdcall;
   InstallWinIoDriver  : function (pszWinIoDriverPath: PChar; IsDemandLoaded : Boolean = False): Boolean;stdcall;
   RemoveWinIoDriver   : function  : Boolean;stdcall;
   StartWinIoDriver    : function  : Boolean;stdcall;
   StopWinIoDriver     : function  : Boolean;stdcall;

function  PinNameToPinInfo(Name : String; var Info : TPinInfo):Boolean;
var
I : Integer;
begin
    result := False;
    for i := Low(TPinLookUp) To High(TPinLookUp) do
    begin
        if SameText(Name , TPinLookUp[i].Name) then
        begin
            Info := TPinLookUp[i];
            result := True;
            Break;
        end;
    end;
end;

function PinValToPinKinds(Value : Byte):TPinKinds;
var
i   : Integer;
Pin : TPinInfo;
begin
    result := [];
    for i := Low(TPinLookUp) to High(TPinLookUp) do
    begin
        Pin := TPinLookup[i];
        if (Value and Pin.Offset) = Pin.Offset then
        result := result + [Pin.Kind];
    end;
end;

function GetDir:String;
begin
    result := GetCurrentDir + '\';
end;

function DecToBin(Value : Integer ; nBits : Integer = 8): String;
var
  i : Integer;
  C : Char;
begin
    Result := '';
    for i := nBits-1 downto 0 do
    begin
        C := '0';
        if  (Value and (1 shl i)<>0)  then C := '1';
        result := result + C;
    end;
end;

function HexToBin(Value : String ; nBits : Integer = 8):String;
begin
    result := DecToBin(StrToInt('$' + Value), nBits);
end;

function IsNumeric(Value : String):Boolean;
var
P : PChar;
begin
    result := False;
    P := PChar(Value);
    while (P^<>#0) do
    begin
        if P^ in ['0'..'9', 'A'..'F', 'a'..'f'] then
        result := true else
        begin
            result := false;
            break;
        end;
        inc(P);
    end;
end;

function MakeMemLoc(Offset : DWORD ; Segment : DWORD): DWORD;
begin
    Offset  := (Offset shl 4) and $FFFFFFFF;
    Segment := Segment  and $FFFFFFFF;
    result  := Offset + Segment;
end;
{ TLPTPort }

function TLPTPort.Close: Boolean;
begin
    result := ShutDownWinIO;
end;

constructor TLPTPort.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FInitialized := False;
    FDLLHandle   := 0;
    FPort        := $378; // Base
    FInpOffset   := 1;    // Base + 1 = Status register
    FUpdate      := False;
    FPorts       := TLPTList.Create; 
    LoadSysDrivers;
    InitializeDrivers;
end;

destructor TLPTPort.Destroy;
begin
    FinalizeDrivers;
    FreeSysDrivers;
    FPorts.Free; 
    inherited Destroy;
end;

function TLPTPort.GetBytePort(Addr: Word): Byte;
begin
    result := InpP(Addr);
end;

function TLPTPort.GetDWordPort(Addr: Word): DWord;
begin
    result := InpDWP(Addr);
end;

function TLPTPort.GetWordPort(Addr: Word): Word;
begin
    result := InpWP(Addr);
end;

function TLPTPort.Inp : Byte;
var
Ret : Integer;
begin
    result := 0;
    if GetPortVal(FPort  + FInpOffset , Ret , 1) then
    result := (Ret and $FF);
end;

function TLPTPort.InpW : Word;
var
Ret : Integer;
begin
    result := 0;
    if GetPortVal(FPort + FInpOffset , Ret , 2) then
    result := (Ret and $FFFF);
end;

procedure TLPTPort.InitializeDrivers;
begin
    FDLLHandle           := LoadLibrary(PChar(TDrivers[0].Name));
    @InitializeWinIo     := GetProcAddress(FDLLHandle,'InitializeWinIo');
    @ShutdownWinIo       := GetProcAddress(FDLLHandle,'ShutdownWinIo');
    @MapPhysToLin        := GetProcAddress(FDLLHandle,'MapPhysToLin');
    @UnmapPhysicalMemory := GetProcAddress(FDLLHandle,'UnmapPhysicalMemory');
    @GetPhysLong         := GetProcAddress(FDLLHandle,'GetPhysLong');
    @SetPhysLong         := GetProcAddress(FDLLHandle,'SetPhysLong');
    @GetPortVal          := GetProcAddress(FDLLHandle,'GetPortVal');
    @SetPortVal          := GetProcAddress(FDLLHandle,'SetPortVal');
    @InstallWinIoDriver  := GetProcAddress(FDLLHandle,'InstallWinIoDriver');
    @RemoveWinIoDriver   := GetProcAddress(FDLLHandle,'RemoveWinIoDriver');
    @StartWinIoDriver    := GetProcAddress(FDLLHandle,'StartWinIoDriver');
    @StopWinIoDriver     := GetProcAddress(FDLLHandle,'StopWinIoDriver');
end;

function TLPTPort.InpDW: DWord;
var
Ret : Integer;
begin
    result := 0;
    if  GetPortVal(FPort + FInpOffset , Ret , 4) then
    result := (Ret and $FFFFFFFF);
end;

function TLPTPort.Open: Boolean;
begin
    FInitialized := InitializeWinIo;
    result       := FInitialized;
end;

function TLPTPort.Out(Value: Byte): Boolean;
begin
    result := SetPortVal(FPort , Value, 1);
end;

function TLPTPort.Out(Value: Word): Boolean;
begin
    result := SetPortVal(FPort , Value, 2);
end;

function TLPTPort.Out(Value: DWord): Boolean;
begin
    result := SetPortVal(FPort , Value, 4);
end;

procedure TLPTPort.SetBytePort(Addr: Word; const Value: Byte);
begin
    OutP(Addr, Value);
end;

procedure TLPTPort.SetDWordPort(Addr: Word; const Value: DWord);
begin
    OutP(Addr, Value);
end;

procedure TLPTPort.SetWordPort(Addr: Word; const Value: Word);
begin
    OutP(Addr, Value);
end;

procedure TLPTPort.FreeSysDrivers;
var
i : integer;
begin
    for i := Low(TDrivers) to High(TDrivers) do
    DeleteFile(GetDir + TDrivers[i].Name);
end;

procedure TLPTPort.LoadSysDrivers;
var
I   : Integer;
Res : TResourceStream;
FileName : String;
begin
    { Extraction du Driver depuis le ressource LPTPort.dcr }
    res := nil;
    for i := Low(TDrivers) to High(TDrivers) do
    begin
        FileName := GetDir + TDrivers[i].Name;
        if FileExists(FileName)=False then
        begin
            try
            Res := TResourceStream.Create(hInstance , TDrivers[i].ResName , 'WINIO');
            Res.SaveToFile (FileName);
            { fichier caché }
            SetFileAttributes(PChar(FileName), FILE_ATTRIBUTE_SYSTEM + FILE_ATTRIBUTE_HIDDEN);
            finally
            Res.Free;
            end;
        end;//File doesn't exists
    end;//i++
end;

procedure TLPTPort.FinalizeDrivers;
begin
    FreeLibrary(FDLLHandle);
end;

procedure TLPTPort.SetPin(Name: String; State: Boolean = true);
var
Info : TPinInfo;
begin
    if PinNameToPinInfo(Name, Info) then
    begin
        Case Info.Kind of
        pkD0 : D0 := State;
        pkD1 : D1 := State;
        pkD2 : D2 := State;
        pkD3 : D3 := State;
        pkD4 : D4 := State;
        pkD5 : D5 := State;
        pkD6 : D6 := State;
        pkD7 : D7 := State;
        end;
    end;
end;

procedure TLPTPort.SetD0(const Value: Boolean);
begin
    if FLS[0] <> Value then
    begin
        FLS[0] := Value;
        NotifyPinChange('D0' , Value);
    end;
end;

procedure TLPTPort.NotifyPinChange(Name: String; State: Boolean);
var
Info : TPinInfo;
begin
    if PinNameToPinInfo(Name , Info) then
    begin
        if Assigned(FOnPinChange) then FOnPinChange(Self , Info , State);

        case State of
        True  :
        begin
            Inc(FPinHash , Info.Offset);
        end;

        False :
        begin
            Dec(FPinHash , Info.Offset);
        end;

        end;
        if FUpdate = False then
        Out(FPinHash);
    end;//Pin Found
end;

procedure TLPTPort.SetD1(const Value: Boolean);
begin
    if FLS[1] <> Value then
    begin
        FLS[1] := Value;
        NotifyPinChange('D1' , Value);
    end;
end;

procedure TLPTPort.SetD2(const Value: Boolean);
begin
    if FLS[2] <> Value then
    begin
        FLS[2] := Value;
        NotifyPinChange('D2' , Value);
    end;
end;

procedure TLPTPort.SetD3(const Value: Boolean);
begin
    if FLs[3] <> Value then
    begin
        FLS[3] := Value;
        NotifyPinChange('D3' , Value);
    end;
end;

procedure TLPTPort.SetD4(const Value: Boolean);
begin
    if FLS[4] <> Value then
    begin
        FLS[4] := Value;
        NotifyPinChange('D4' , Value);
    end;
end;

procedure TLPTPort.SetD5(const Value: Boolean);
begin
    if FLS[5] <> Value then
    begin
        FLS[5] := Value;
        NotifyPinChange('D5' , Value);
    end;
end;

procedure TLPTPort.SetD6(const Value: Boolean);
begin
    if FLS[6] <> Value then
    begin
        FLS[6] := Value;
        NotifyPinChange('D6' , Value);
    end;
end;

procedure TLPTPort.SetD7(const Value: Boolean);
begin
    if FLS[7] <> Value then
    begin
        FLS[7] := Value;
        NotifyPinChange('D7' , Value);
    end;
end;

function TLPTPort.GetD0: Boolean;
begin
    result := (Inp and $1) = $1; 
end;

function TLPTPort.GetD1: Boolean;
begin
    result := (Inp and $2) = $2;
end;

function TLPTPort.GetD2: Boolean;
begin
    result := (Inp and $4) = $4;
end;

function TLPTPort.GetD3: Boolean;
begin
    result := (Inp and $8) = $8;
end;

function TLPTPort.GetD4: Boolean;
begin
    result := (Inp and $10) = $10;
end;

function TLPTPort.GetD5: Boolean;
begin
    result := (Inp and $20) = $20;
end;

function TLPTPort.GetD6: Boolean;
begin
    result := (Inp and $40) = $40;
end;

function TLPTPort.GetD7: Boolean;
begin
    result := (Inp and $80) = $80;
end;


function TLPTPort.OutP(Addr: Word; Value: Byte): Boolean;
begin
    result := SetPortVal(Addr , Value, 1);
end;

function TLPTPort.OutP(Addr, Value: Word): Boolean;
begin
    result := SetPortVal(Addr , Value, 2);
end;

function TLPTPort.OutP(Addr: Word; Value: DWord): Boolean;
begin
    result := SetPortVal(Addr , Value, 4);
end;

function TLPTPort.InpDWP(Addr: Word): DWord;
var
Ret : Integer;
begin
    result := 0;
    if  GetPortVal(Addr + FInpOffset , Ret , 4) then
    result := (Ret and $FFFFFFFF);
end;

function TLPTPort.InpP(Addr: Word): Byte;
var
Ret : Integer;
begin
    result := 0;
    if GetPortVal(Addr + FInpOffset , Ret , 1) then
    result := (Ret and $FF);
end;

function TLPTPort.InpWP(Addr : Word): Word;
var
Ret : Integer;
begin
    result := 0;
    if GetPortVal(Addr + FInpOffset , Ret , 2) then
    result := (Ret and $FFFF);
end;

procedure TLPTPort.BeginUpdate;
begin
    FUpdate := True;
    
end;

procedure TLPTPort.EndUpdate;
begin
    if FUpdate then
    begin
        FUpdate := False;
        Out(FPinHash);
    end;
end;

procedure TLPTPort.SetPins(Names: array of String);
var
i     : Integer;
Info  : TPinInfo;
State : Boolean;
begin
    BeginUpdate;
    ClearPins;
    for i := Low(Names) to High(Names) do
    begin
        PinNameToPinInfo(Names[i] , Info);
        State := True;
        Case Info.Kind of
        pkD0 : D0 := State;
        pkD1 : D1 := State;
        pkD2 : D2 := State;
        pkD3 : D3 := State;
        pkD4 : D4 := State;
        pkD5 : D5 := State;
        pkD6 : D6 := State;
        pkD7 : D7 := State;
        end;//Case
    end;//i++
    EndUpdate;
end;

procedure TLPTPort.ClearPins;
begin
    D0 := False;
    D1 := False;
    D2 := False;
    D3 := False;
    D4 := False;
    D5 := False;
    D6 := False;
    D7 := False;
end;

function TLPTPort.GetPhysDWORD(Addr : DWORD; var Return : DWORD): Boolean;
begin
    Addr := Addr and $FFFFFFFF;
    result := GetPhysLong( Addr , Return );
    if result then Return := (Return and $FFFFFFFF);
end;

function TLPTPort.SetPhysDWORD(Addr, Value: DWORD): Boolean;
begin
    Addr   := (Addr  and $FFFFFFFF);
    Value  := (Value and $FFFFFFFF);
    result := SetPhysLong(Addr , Value);
end;

procedure TLPTPort.EnumPorts;
var
I          : Integer;
SearchBase : DWORD;
PortFind   : DWORD;
begin
    SearchBase := $408; // [$40:$008]
    Ports.Clear;
    for i := 1 to 3 do // LPT1 ... LPT3
    begin
        if GetPhysDWORD(SearchBase , PortFind) then
        begin
            PortFind := (PortFind and $FFFF);
            if (PortFind > 0) then
            begin
                with Ports.Add do
                begin
                    Name := Format('LPT%u' , [i]);
                    Port := PortFind;
                end;//with Ports.Add
            end;
        end;//if GetPhysique
        inc(SearchBase , 2);
    end;// i ++
end;

{ implementation of TLPTList }

function TLPTList.GetItem (Index : Integer): TLPTListItems;
begin
    result := TLPTListItems(inherited GetItem(Index));
end;

procedure TLPTList.SetItem (Index : Integer ; Value : TLPTListItems);
begin
    inherited SetItem(Index, Value);
end;

Constructor TLPTList.Create;
begin
    inherited Create(TLPTListItems);
end;

Destructor TLPTList.Destroy;
begin
    inherited Destroy;
end;

function TLPTList.Add: TLPTListItems;
begin
    result := TLPTListItems(inherited Add);
end;

function TLPTList.ItemExist (ItemName : String): Boolean;
var
I : Integer;
begin
    result := False;
    ItemIndex := -1;
    for i :=0 to Count -1 do
    begin
        if SameText(ItemName, Items[i].Name)  Then
         begin
             ItemIndex  := I;
             ItemFind   := Items[i];
             result     := True;
             Break;
         end;//Trouver
    end;//Fin de la boucle I
end;

function TLPTList.ItemOf (ItemName : String): TLPTListItems;
begin
    result := nil;
    if ItemExist(ItemName) Then
    result := Items[ItemIndex];
end;
  
  
{ implementation of TLPTListItems }

Constructor TLPTListItems.Create (Collection : TCollection);
begin
    inherited Create(Collection);
    Parent          := TLPTList(Collection);
    FPort           := 0;
end;

Destructor TLPTListItems.Destroy;
begin
    inherited Destroy;
end;

procedure TLPTListItems.Assign (Source : TPersistent);
begin
    if Source is TLPTListItems Then
    begin
        FName    := TLPTListItems(Source).FName;
        FPort    := TLPTListItems(Source).FPort;
    end else
    inherited;
end;

procedure TLPTPort.SetPorts(const Value: TLPTList);
begin
    FPorts.Assign(Value); 
end;

procedure TLPTPort.EnumPorts(Strings: TStrings);
var
i : Integer;
begin
    Strings.Clear;
    EnumPorts;    
    for i := 0 to Ports.Count -1 do
    Strings.Add(Ports[i].Name);
end;

procedure TLPTPort.SelectPort(Addr: WORD);
begin
    LPTPort := Addr; 
end;

procedure TLPTPort.SelectPortByIndex(PortIndex: Integer);
begin
    LPTPort := Ports[PortIndex].Port;
end;

end.

Open in new window

LPTPort.txt
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 26099503
First, you will need a device driver to allow the ports to be read, and if you desire, written to under any of the NT versions of Windows, which includes 2000 and XP. If you were running Windows 95 or 98 or ME, I could easily provide you with simple functions. But again that will not work in any NT version.

There are component libraries with the device driver needed to allow reading and writing to hardware ports, (i.e. printer port), and with those components are source code and examples on how to use it.

An example would be

http://www.torry.net/vcl/system/portaccess/zlportio.zip
http://www.zealsoftstudio.com/ntport
http://www.wideman-one.com/gw/tech/Delphi/iopm/index.htm  (good stuff here)

John
0
 
LVL 9

Author Comment

by:Alex
ID: 26099726
Hello thiagoblimeira and Johnjces and thank you for your quick replies.


thiagoblimeira:
I can not read the pdf file now for several reasons.Do you have a source code example for me and could you send it?


Johnjces:
I had show those links but none of them could help me.

The first link with the source code example when i run it send that the rdtsc.dcu is missing.

The other links hasn't clear solutions about my problem.



0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 18

Expert Comment

by:Johnjces
ID: 26099812
You must install the delphi component you choose.

The third link has good info and a wrapper fro their .sys file which is the device driver you need.

Link 2 even has a demo. You just have to download the component and sample sources and you'll have what you need.

In order to work with this and to even test it, you have to install the component and device driver on your system and on your client system.

Maybe we are confused.

John
0
 
LVL 8

Accepted Solution

by:
thiagoblimeira earned 2000 total points
ID: 26099874
Just take the .txt, compile and test
LPTControl.dpr.txt
uMain.dfm.txt
uMain.pas.txt
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 26102620
It would be much easier to do this via a serial port (no need for device drivers), is that an option?
0
 
LVL 9

Author Comment

by:Alex
ID: 26103358
Johnjces i don't want to install drivers and use files i want something like thiagoblimeira gave me.

thiagoblimeira, i had download the 3 files (i rename them as you said) , also i download the component  LPTPort.txt and i rename it to dcr.Now, have i all the files i need? Did i need any other file or anything else?

Hi MerijnB, i have a circuit for parallel port but if you want to tell me i am interesting about how could i do this with serial port ;-)
0
 
LVL 8

Expert Comment

by:thiagoblimeira
ID: 26103513
You need to install the LPTPort component to th Delphi IDE using the code I sent you saved as LPTPort.pas and the LPTPort.dcr, this way you can use the example I've sent you. One of the advantages of the LPTPort is that you don't need to distribute any kind of driver because the component is the driver itself.
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 26104668
All of the links have demo code for you to use and learn from.

But if you want it to work, you MUST install the device driver FIRST! It is a must do.
0
 
LVL 19

Expert Comment

by:MerijnB
ID: 26105112
what kind of circuit do you mean?
0
 
LVL 18

Expert Comment

by:Johnjces
ID: 26105258
In your interface to the printer port, I would recommend buffering the inputs with non inverting buffer ICs and at the very least use pull up 1K ohm, resistors on your printer port input pins. This will ensure that you see a correct True or False, 1 or 0. Using pull ups, your circuit will show True. When grounded, the circuit will show false.

Of course you can use inverting buffers to alter or opposite your results.

Google interfacing PC Printer Port and you will find a wealth of circuits and furthe rinformation on what you want to do.

John
0
 
LVL 9

Author Comment

by:Alex
ID: 26133765
Hello my friends,

I didn't forget to post back but i have some problems to solve before i try all your suggestions.When i find how to solve them i will post here the results of your advices and i hope you could help me if i need further informations :-)

My best wishes for all of you!
0
 
LVL 9

Author Comment

by:Alex
ID: 26155200
I want to thank all of you guys for your suggestions!

thiagoblimeira, thank you a lot for the nice component it was exactly what i want!

I wish to all of you happy new year!
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Whether it be Exchange Server Crash Issues, Dirty Shutdown Errors or Failed to mount error, Stellar Phoenix Mailbox Exchange Recovery has always got your back. With the help of its easy to understand user interface and 3 simple steps recovery proced…
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question