Informatik - Messen, Steuern, Regeln - Ansteuerung der parallelen Schnittstelle

MSR

Strichcode
Pfad: Startseite / Fächer / Informatik / MSR / parallele Schnittstelle

Autor: mk
22.10.2009 16:03
6729

parallele Schnittstelle

Ansteuerung der parallelen Schnittstelle unter Python

pyParallel

Ansteuerung der parallelen Schnittstelle unter Delphi

Seit Windows NT ist es nicht mehr möglich, direkt auf die parallele Schnittstelle zuzugreifen. Es ist zumindest unter Administratorrechten ein Kernel0-Treiber zu installieren.

Im Internet findet man bei Yariv Kaplan frei verfügbar den Treiber 'winio.sys' und die 'winio.dll'. Mit Hilfe der Unit 'winio.pas' kann man Treiber und DLL unter Delphi verfügbar machen. Soll die DLL auch unter Nicht-Administrator-Rechten genutzt werden, so muss der Treiber zuvor unter Administrator-Rechten installiert werden. Die winio.pas, sowie ein kleines Testprogramm kann unter WinIOTest.zip heruntergeladen werden. In der Testinstallation wurden 'winio.sys' und 'winio.dll' (gepackt in miniWinIO.zip) nach c:\winnt\system32 kopiert, wo sie von Delphi7 gefunden wurden. Man ist auf der sicheren Seite, wenn man die beiden Dateien in das Projekt-Verzeichnis kopiert.

Das kleine Testprogramm

GUI

uses
  .., winio,...
....
const
  port = $378; // lpt1

procedure TForm1.bInstallClick(Sender: TObject);
begin
  if InstallWinIoDriver('c:\winnt\system32\winio.sys',false)
  then
    lMeldung1.Caption := 'OK'
  else
    lMeldung1.Caption := 'Fehler!';
end;

procedure TForm1.bBit0einClick(Sender: TObject);
begin
  if not SetPortVal(port,1,1) // port,<byte>,1
  then
    windows.Beep(1000,300);
end;

procedure TForm1.bBit0ausClick(Sender: TObject);
begin
  if not SetPortVal(port,0,1)
  then
    windows.Beep(1000,300);
end;

procedure TForm1.bInitializeClick(Sender: TObject);
begin
  if InitializeWinIo
  then
    lMeldung2.Caption := 'OK'
  else
    lMeldung2.Caption := 'Fehler!';
end;

procedure TForm1.bShutDownClick(Sender: TObject);
begin
  ShutDownWinIo;
end;

procedure TForm1.bRemoveDriverClick(Sender: TObject);
begin
  if RemoveWinIoDriver
  then
    lMeldung4.Caption := 'OK'
  else
    lMeldung4.Caption := 'Fehler!';
end;

procedure TForm1.cbStrobeClick(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port+2,@b,1);
  if cbStrobe.checked
  then
    b := b or 1     // Bit0 setzen
  else
    b := b and 254; // Bit0 zurücksetzen, 255-1
  SetPortVal(port+2,b,1);
end;

procedure TForm1.cbData0Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData0.checked
  then
    b := b or 1     // Bit0 setzen
  else
    b := b and 254; // Bit0 zurücksetzen, 255-1
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData1Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData1.checked
  then
    b := b or 2     // Bit1 setzen
  else
    b := b and 253; // Bit1 zurücksetzen, 255-2
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData2Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData2.checked
  then
    b := b or 4     // Bit2 setzen
  else
    b := b and 251; // Bit2 zurücksetzen, 255-4
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData3Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData3.checked
  then
    b := b or 8     // Bit3 setzen
  else
    b := b and 247; // Bit3 zurücksetzen, 255-8
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData4Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData4.checked
  then
    b := b or 16    // Bit4 setzen
  else
    b := b and 239; // Bit4 zurücksetzen, 255-16
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData5Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData5.checked
  then
    b := b or 32    // Bit5 setzen
  else
    b := b and 223; // Bit5 zurücksetzen, 255-32
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData6Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData6.checked
  then
    b := b or 64    // Bit6 setzen
  else
    b := b and 191; // Bit6 zurücksetzen, 255-64
  SetPortVal(port,b,1);
end;

procedure TForm1.cbData7Click(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port,@b,1);
  if cbData7.checked
  then
    b := b or 128   // Bit7 setzen
  else
    b := b and 127; // Bit7 zurücksetzen, 255-128
  SetPortVal(port,b,1);
end;

procedure TForm1.cbAutoFeedClick(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port+2,@b,1);
  if cbAutoFeed.checked
  then
    b := b or 2     // Bit1 setzen
  else
    b := b and 253; // Bit1 zurücksetzen, 255-2
  SetPortVal(port+2,b,1);
end;

procedure TForm1.cbInitClick(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port+2,@b,1);
  if cbInit.checked
  then
    b := b or 4     // Bit2 setzen
  else
    b := b and 251; // Bit2 zurücksetzen, 255-4
  SetPortVal(port+2,b,1);
end;

procedure TForm1.cbSelInClick(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port+2,@b,1);
  if cbSelIn.checked
  then
    b := b or 8     // Bit3 setzen
  else
    b := b and 247; // Bit3 zurücksetzen, 255-8
  SetPortVal(port+2,b,1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  b : byte;
begin
  GetPortVal(port+1,@b,1);
  if (b and 64) > 0      // Bit6 gesetzt?
  then
    shAck.Brush.Color := clRed
  else
    shAck.Brush.Color := clWhite;
  if (b and 128) > 0      // Bit7 gesetzt?
  then
    shBusy.Brush.Color := clRed
  else
    shBusy.Brush.Color := clWhite;
  if (b and 32) > 0       // Bit5 gesetzt?
  then
    shPE.Brush.Color := clRed
  else
    shPE.Brush.Color := clWhite;
  if (b and 16) > 0       // Bit4 gesetzt?
  then
    shSelect.Brush.Color := clRed
  else
    shSelect.Brush.Color := clWhite;
  if (b and 8) > 0        // Bit3 gesetzt?
  then
    shError.Brush.Color := clRed
  else
    shError.Brush.Color := clWhite;
end;
....

Links

Ansteuerung der parallelen Schnittstelle unter Python

Ansteuerung der parallelen Schnittstelle unter Delphi

Das kleine Testprogramm

Links