Hardware Portansteuerung

[jwhm]

Hallo,

ich möchte gern die E/A-Pins des LPT1-Ports aus Delphi 5 ansteuern, leider sind die Befehle aus Turbo nichtmehr die Richtigen, kann mir jemand mit seiner Erfahrung helfen??? - Danke

[Luckie]

Auf was für einen Betriebssystem soll das laufen? Unter Windows2000 und höher brauchen wir gar nicht weiterreden, da brauchst du einen Treiber, der sich mit Delphi nicht schreiben lößt. Da müßtest du dann auf Komponenten bei Torry umsteigen.

[jwhm]

Ist kein Problem, muss nur unter 98 laufen.

Johannes

[sakura]

Zitat:

Zitat von Luckie

Auf was für einen Betriebssystem soll das laufen? Unter Windows2000 und höher brauchen wir gar nicht weiterreden, da brauchst du einen Treiber, der sich mit Delphi nicht schreiben lößt.

Langsam reichts, wieso liest man diese Aussage eigentlich immer wieder. Es gab sogar mal ein Buch zu genau diesem Thema und Delphi... Habe es leider nicht mehr gefunden (bewi Amazon), aber immerhin folgender Link führt zu einer Seite, welche Software zur Entwicklung von Treibern für Windows mit Delphi anbietet, wenn auch kostenpflichtig :D

http://www.jungo.com/windriver.html

...:cat:...

[Luckie]

Und wie ist das bitte sehr zu verstehen?

Zitat:

Delphi ist ein Tool, dass dahingehend optimiert und entwickelt wurde, um schnellstmöglich Anwendungen für den Benutzermodus in Win32 (bevorzugt GUI) zu entwickeln.

Probleme:
- im Kernelmodus herrschen ganz andere Spielregeln,
- das Layout des resultierenden Images (PE/COFF-Format, kurz .exe und .dll) läßt sich beim Object Pascal Compiler/Linker nicht genügend beinflussen, um überhaupt erfolgreich vom Kernel akzeptiert zu werden
- Visual C++ ist die _einzige_ unterstützte Entwicklungsplattform für Anwendungen im Kernel-Modus...
- es gibt also folglich keine Units dafür und Du kannst bei 0 (nichts, nada, nil) mit reinem Assembler anfangen (sonst bekommst Du nichtmal die Init-Callback-Funktion hin), kein Speicher-Manager, keine Compiler-Magic, _keine_ Win32 API-Funktionen...
- ...selbst wenn sich jemand die Arbeit macht das Device Driver Kit (DDK) nach Object Pascal zu 'übersetzen', wird er feststellen, das selbige Sprache einige Features nicht hat, die dort ausgiebig benutzt werden ( z.B. Makros, 'fastcall' (Microsoft-spezifische Aufrufkonvention, vergleichbar mit 'register' in Pascal) und Unions (bedingt übersetzbar) ... )

Das waren nur die gröbsten technischen Probleme.
Alleine die Einarbeitung in das Thema Treiberentwicklung erfordert einen nicht zu unterschätzenden Aufwand. [...]

...insofern rate ich davon ab, zu versuchen mit Delphi (mal eben) einen Treiber zu schreiben.
Das haben andere schon getan, es reicht aber nicht zu mehr als: 'hm, geht mit viel Arbeit + HexEditor, aber macht irgendwie keinen Sinn'.

Ich hoffe das war deutlich genug. Dem interessierten Entwickler sei passende Lektüre (mind. DDK) empfohlen.

NicoDE

Nur so viel, ich kenne den Autor persönlich und ich weiß, dass er Ahnung hat. Er sagt zwar auch, dass es geht, aber auch dass es keinen Sinn macht. Und ich bleibe bei dem Standpunkt, mit Delphi Treiber zu programmieren ist so, als wolle ich mit einem Moped einen Pflug über den Acker ziehen.

[sakura]

Hi,

ich kenne NicoDE auch noch ;) 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.

...:cat:...

[Luckie]

OK ich glaube, da kommen wir zu einer Einigung. Es ist nicht unmöglich, aber mehr als blödsinning es zu machen. Desweiteren dürfte man als otto-normal Programmierer keine Chance haben es zu schaffen.

[eddy]

Hallo jwhm,

zum Parallel-Port kann ich nichts sagen, aber vielleicht kannst Du Dein Problem ja durch Nutzung der seriellen Schnittstelle lösen. Eine Kassenschublade läßt sich zumindest durch direktes Anspechen des COM-Ports öffnen.

mfg
eddy

[jwhm]

Danke, aber nach der Diskussion habe ich mich entschieden, doch wieder das gute alte Turbo unter Dos zu verwenden, da kenn ich alle Ansteuerungen, das passt auf eine Diskette und kann auf jedem PC laufen.

Johannes

[jbg]

Für den Parallelport habe ich eine Unit.

Delphi-Quellcode:

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.