![]() |
|||
| HSG |
|
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.

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;
....