mise à jour importante désormais c'est un composant permettant le dialogue avec le port parallèle LPT, cette mise à jour inclus notamment la prise en charge des OS Windows 9x/NT/2000 and XP et ce grâce au driver WinIO de chez
http://www.internals.com
on m'a demander récemment comment faire pour avoir l'adresse du Port LPT, effectivement ce n'est pas aussi simple car d'habitude il faut aller voir le BIOS...
maintenant c'est une histoire ancienne le composant va chercher les Ports en lisant la mémoire physique, en effet les valeurs des Ports sont stockés à l'adresse [$0040:$0008] seulement voilà là il sagit d'une adresse logique, j'ai donc dû rajouter une fonction qui calcule l'adresse Physique à partir de l'adresse Logique "MakeMemLoc", bon le nom n'est peut être pas assez explicite :)
maintenant on peut aussi énuméré les Ports LPT
Source / Exemple :
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.
Conclusion :
l'utilisation du composant est très simple, d'ailleur vous n'êtes pas obliger d'installer le composant, vous pouvez le créé dynamiquement.
ce composant à été tester sur Windows 98 & XP Pro avec succès.
important !!!
si dans une de vos application vous devez lire la broche "busy", n'oubliez pas de mettre InpOffset = 1 si toute fois vous avez changer sa valeur
ensuite c'est simple la valeur du poids de busy est 128 une simple routine logique permet d'en lire l'état
exemple
InpOffset := 1;
if (Lpt.Inp and 128)=128 then ....
je rappel que Busy est activer à l'état 0
pas de bug pour le moment...
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.