unit LPTPort;
{.$define WINIO} // WinIo nutzen um auf den ParPort zuzugreifen
{.$define USERPORT} // UserPort.sys nutzen um auf den ParPort zuzugreifen
{$ifdef WINIO}
{$ifdef USERPORT}
Es kann nur ein Kernel Mode Treiber genutzt werden
{$endif}
{$endif}
{$ifdef USERPORT}
{$ifdef WINIO}
Es kann nur ein Kernel Mode Treiber genutzt werden
{$endif}
{$endif}
{ Beschreibung: Parallel Port Objekt mit direktem Hardwarezugriff }
interface
uses Windows, SysUtils, Classes
{$ifdef WINIO}, WinIo
{$endif};
const
PortNames:
array [0..2]
of string = ('
None', '
LPT1', '
LPT2');
PortAddress:
array[0..2]
of Word = (0, $378, $278);
STB = $01;
AUTOFD = $02;
INITL = $04;
SLCI = $08;
IRQEN = $10;
ERR = $08;
SLCO = $10;
PE = $20;
ACK = $40;
BSY = $80;
type
TPortNumber = (portNone, portLPT1, portLPT2);
TParPort =
class(TObject)
private
FPort: TPortNumber;
FPortAddress: Word;
PortHandle: THandle;
FData, FControl, FStatus: Byte;
FStrobe, FAutoFd, FInit, FSlctIn, FError, FSlct, FPaperEnd: Boolean;
FAcknlg, FBusy: Boolean;
procedure SetPort(Value: TPortNumber);
function GetData: Byte;
procedure SetData(Value: Byte);
function GetControl: Byte;
procedure SetControl(Value: Byte);
function GetStatus: Byte;
function GetStrobe: Boolean;
procedure SetStrobe(Value: Boolean);
function GetAutoFd: Boolean;
procedure SetAutoFd(Value: Boolean);
function GetInit: Boolean;
procedure SetInit(Value: Boolean);
function GetSlctIn: Boolean;
procedure SetSlctIn(Value: Boolean);
function GetError: Boolean;
function GetSlct: Boolean;
function GetPaperEnd: Boolean;
function GetAcknlg: Boolean;
function GetBusy: Boolean;
public
constructor Create;
destructor Destroy;
override;
function OpenPort(PortNo: Byte): Boolean;
function ClosePort: Boolean;
property Control: Byte
read GetControl
write SetControl;
public
property Port: TPortNumber
read FPort
write SetPort;
property BaseAddress: word
read FPortAddress;
property Status: Byte
read GetStatus;
property Data: Byte
read GetData
write SetData;
property Strobe: Boolean
read GetStrobe
write SetStrobe;
property AutoFeed: Boolean
read GetAutofd
write SetAutofd;
property Initialize: Boolean
read GetInit
write SetInit;
property SlctIn: Boolean
read GetSlctIn
write SetSlctIn;
property Error: Boolean
read GetError;
property Slct: Boolean
read GetSlct;
property PaperEnd: Boolean
read GetPaperEnd;
property Acknlg: Boolean
read GetAcknlg;
property Busy: Boolean
read GetBusy;
end;
implementation
{ ************************************************************************* }
{ Get a Byte from the port }
function InPort(PortAddr: Word): Byte;
stdcall;
begin
{$ifdef WINIO}
Result := WinIo_GetPort(PortAddr)
{$else}
try
asm
mov dx, PortAddr
in al, dx
mov Result, al
end;
except
Result := 0;
end;
{$endif}
end;
{ ************************************************************************* }
{ Write a Byte to the port }
procedure OutPort(PortAddr: Word; DataByte: Byte);
stdcall;
begin
{$ifdef WINIO}
WinIo_SetPort(PortAddr, DataByte)
{$else}
try
asm
mov al, DataByte
mov dx, PortAddr
out dx, al
end;
except
end;
{$endif}
end;
{ ************************************************************************* }
{ Do (Action) to b(Bit) of (PortAddr) }
procedure SetBitState(PortAddr: Word; Action: Boolean; Bit: Byte);
begin
if Action = True
then OutPort(PortAddr, InPort(PortAddr)
or Bit)
else OutPort(PortAddr, InPort(PortAddr)
and not Bit);
end;
{ ************************************************************************* }
{ Return status of b(Bit) of (PortAddr) }
function GetBitState(PortAddr: Word; Bit: Byte): Boolean;
begin
Result := (InPort(PortAddr)
and Bit) <> 0;
end;
{---------- TParPort ----------}
{ ************************************************************************* }
constructor TParPort.Create;
begin
inherited Create;
FPort := portNone;
FPortAddress := 0;
PortHandle := 0;
end;
{ ************************************************************************* }
destructor TParPort.Destroy;
begin
ClosePort;
inherited Destroy;
end;
{ ************************************************************************* }
function TParPort.OpenPort(PortNo: Byte): Boolean;
var s:
string;
begin
ClosePort;
s := '
';
Result := False;
if (PortNo < 1)
or (PortNo > 2)
then exit;
s := '
\\.\LPT' + IntToStr(PortNo);
PortHandle := CreateFile(PChar(s),
GENERIC_READ
or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
0, 0);
if PortHandle = INVALID_HANDLE_VALUE
then PortHandle := 0;
if PortHandle <> 0
then begin
case PortNo
of
1: FPort := portLPT1;
2: FPort := portLPT2;
end;
FPortAddress := PortAddress[PortNo];
{ Output data = 0 }
OutPort(FPortAddress, 0);
{ Control reg = 0c }
OutPort(FPortAddress + 2, (InPort(FPortAddress + 2)
and $F0)
or $0C);
Result := True;
end;
end;
{ ************************************************************************* }
procedure TParPort.SetPort(Value: TPortNumber);
begin
if Value <> FPort
then begin
{ Set default output data }
OpenPort(Ord(Value));
end;
end;
{ ************************************************************************* }
function TParPort.GetData: Byte;
begin
{ Get a Byte from the data port }
if PortHandle <> 0
then FData := InPort(FPortAddress)
else FData := 0;
Result := FData;
end;
{ ************************************************************************* }
procedure TParPort.SetData(Value: Byte);
begin
{ Send a Byte to the data port }
if PortHandle <> 0
then OutPort(FPortAddress, Value);
end;
{ ************************************************************************* }
function TParPort.GetControl: Byte;
begin
{ Get a Byte from the control port }
if PortHandle <> 0
then FControl := InPort(FPortAddress + 2)
else FControl := 0;
Result := FControl;
end;
{ ************************************************************************* }
procedure TParPort.SetControl(Value: Byte);
begin
{ Send a Byte to the control port }
if PortHandle <> 0
then
OutPort(FPortAddress + 2, (InPort(FPortAddress + 2)
and $F0)
or (Value
and $0F));
end;
{ ************************************************************************* }
function TParPort.GetStatus: Byte;
begin
{ Read port status, inverting B7 (busy) }
if PortHandle <> 0
then FStatus := InPort(FPortAddress + 1)
else FStatus := 0;
Result := FStatus;
end;
{ ************************************************************************* }
function TParPort.GetStrobe: Boolean;
begin
{ Read the STROBE output level }
if PortHandle <> 0
then
FStrobe :=
not GetBitState(FPortAddress + 2, STB)
else
FStrobe := False;
Result := FStrobe;
end;
{ ************************************************************************* }
procedure TParPort.SetStrobe(Value: Boolean);
begin
{ Condition the STROBE output }
if PortHandle <> 0
then
SetBitState(FPortAddress + 2,
not Value, STB);
end;
{ ************************************************************************* }
function TParPort.GetAutoFd: Boolean;
begin
{ Read the AUTOFD output level }
if PortHandle <> 0
then FAutoFd :=
not GetBitState(FPortAddress + 2, AUTOFD)
else FAutoFd := False;
Result := FAutoFd;
end;
{ ************************************************************************* }
procedure TParPort.SetAutoFd(Value: Boolean);
begin
{ Condition the STROBE output }
if PortHandle <> 0
then
SetBitState(FPortAddress + 2,
not Value, AUTOFD);
end;
{ ************************************************************************* }
function TParPort.GetInit: Boolean;
begin
{ Read the INITIALIZE output level }
if PortHandle <> 0
then FInit := GetBitState(FPortAddress + 2, INITL)
else FInit := False;
Result := FInit;
end;
{ ************************************************************************* }
procedure TParPort.SetInit(Value: Boolean);
begin
{ Condition the INITIALIZE output }
if PortHandle <> 0
then
SetBitState(FPortAddress + 2, Value, INITL);
end;
{ ************************************************************************* }
function TParPort.GetSlctIn: Boolean;
begin
{ Read the SLCTIN output level }
if PortHandle <> 0
then FSlctIn :=
not GetBitState(FPortAddress + 2, SLCI)
else FSlctIn := False;
Result := FSlctIn;
end;
{ ************************************************************************* }
procedure TParPort.SetSlctIn(Value: Boolean);
begin
{ Condition the SLCTIN output }
if PortHandle <> 0
then
SetBitState(FPortAddress + 2,
not Value, SLCI);
end;
{ ************************************************************************* }
function TParPort.GetError: Boolean;
begin
{ Read the ERROR input level }
if PortHandle <> 0
then FError := GetBitState(FPortAddress + 1, ERR)
else FError := False;
Result := FError;
end;
{ ************************************************************************* }
function TParPort.GetSlct: Boolean;
begin
{ Read the SLCT input level }
if PortHandle <> 0
then FSlct := GetBitState(FPortAddress + 1, SLCO)
else FSlct := False;
Result := FSlct;
end;
{ ************************************************************************* }
function TParPort.GetPaperEnd: Boolean;
begin
{ Read the PE input level }
if PortHandle <> 0
then FPaperEnd := GetBitState(FPortAddress + 1,
PE)
else FPaperEnd := False;
Result := FPaperEnd;
end;
{ ************************************************************************* }
function TParPort.GetAcknlg: Boolean;
begin
{ Read the ACK input level }
if PortHandle <> 0
then FAcknlg := GetBitState(FPortAddress + 1, ACK)
else FAcknlg := False;
Result := FAcknlg;
end;
{ ************************************************************************* }
function TParPort.GetBusy: Boolean;
begin
{ Read the inverted BUSY input level }
if PortHandle <> 0
then FBusy :=
not GetBitState(FPortAddress + 1, BSY)
else FBusy := False;
Result := FBusy;
end;
{ ************************************************************************* }
function TParPort.ClosePort: Boolean;
begin
{ Close currently open LPT }
if PortHandle <> 0
then begin
{ Output data = 0 }
OutPort(FPortAddress, 0);
{ Control reg b0..3 = $0C }
OutPort(FPortAddress + 2, (InPort(FPortAddress + 2)
and $F0)
or $0C);
Result := CloseHandle(PortHandle);
end else Result := False;
PortHandle := 0;
FPort := portNone;
FPortAddress := 0;
end;
{$ifdef USERPORT}
procedure StartUserPortDriver;
var hUserPort : THandle;
begin
hUserPort := CreateFile('
\\.\UserPort',
GENERIC_READ,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0
);
CloseHandle(hUserPort);
// Activate the driver
Sleep(100);
// We must make a process switch
end;
function IsWinNT: Boolean;
var OSVersionInfo: TOSVersionInfo;
begin
OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(OSVersionInfo);
Result := OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;
end;
initialization
if IsWinNT
then StartUserPortDriver;
{$endif}
{$ifdef WINIO}
initialization
WinIo_InstallAndStart;
finalization
WinIo_ShutDown;
{$endif}
end.
Antwort
3. Feb 2003, 20:54
Zitat
Zitat von Luckie:
http://www.jungo.com/windriver.html
...
Ich stimme zu, dass Delphi bestimmt nicht das optimale Tools zur Erstellung von Treibern ist, aber ich bleibe bei der Aussage, dass es nicht unmöglich ist.
Linear-Darstellung
