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