Power-Programmierung/CD1.mdf/lan/netcraft/netprint.pas

Pascal/Delphi Source File | 1988-06-10 | 4KB | 192 lines

{*********************************************************************

  NETPRINT - A unit of NetWare Application Program Interfaces
             Relating to Network Print Services
             for Turbo Pascal 4.0 and Advanced NetWare (any verison)

  Copyright (c) 1988, Richard S. Sadowsky
  All rights reserved

  version .7 6/10/88 by Richard S. Sadowsky

**********************************************************************}
Unit NetPrint;
{$I-,V-,S+,R+}

interface

uses DOS;

type
  PrinterDevice    = (LPT_1,LPT_2,LPT_3); { enum type to hold LPT number }

var
  NovRegs          : Registers; { register type for DOS/Novell calls }

function CancelLPTCapture : Word;
{ abort capture of default LPT device }

function EndLPTCapture : Word;
{ end the capture of default LPT device (like ENDSPOOL) }

function FlushLPTCapture : Word;
{ Flush capture of default LPT device (like running SPOOL again while
  spooling
}

function GetDefaultLocalPrinter : PrinterDevice;
{ Get LPT device currently used as default by network for capture }

procedure SetDefaultLocalPrinter(LPTNo : PrinterDevice);
{ Sets LPT device used as default by network for capture }

function StartLPTCapture : Word;
{ Start Capture of default LPT device (Like running SPOOL) }

function LPTCaptureActive(var QueServer : Byte) : Boolean;
{ Is spooling occurring now for specified QueServer? }

procedure GetPrinterStatus(var PrinterNo,FormType : Byte;
          var OffLine,Stopped : Boolean);
{ return assorted information about the default network printer }

function GetBannerUser : String;
{ returns the user name that is printed on the banner page }

implementation

function CancelLPTCapture : Word;


begin
  with NovRegs do begin
    AX := $DF00;
    DX := $02;
    MsDos(NovRegs);
    CancelLPTCapture := AL
  end;
end;

function EndLPTCapture : Word;

begin
  with NovRegs do begin
    AX := $DF00;
    DX := $01;
    MsDos(NovRegs);
    EndLPTCapture := AL;
  end
end;

function FlushLPTCapture : Word;

begin
  with NovRegs do begin
    AX := $DF00;
    DX := $03;
    MsDos(NovRegs);
    FlushLPTCapture := AL
  end
end;

function GetDefaultLocalPrinter : PrinterDevice;

begin
  with NovRegs do begin
    AX := $B800;
    DX := $04;
    MsDos(NovRegs);
    GetDefaultLocalPrinter := PrinterDevice(DH MOD 3) { force in range 0..2 }
  end
end;

function StartLPTCapture : Word;

begin
  with NovRegs do begin
    AX := $DF00;
    DX := $00;
    MsDos(NovRegs);
    StartLPTCapture := AL
  end
end;

function LPTCaptureActive(var QueServer : Byte) : Boolean;

begin
  with NovRegs do begin
    AH:= $F0;
    AL := $03;
    MsDos(NovRegs);
    LPTCaptureActive := $FF = AH;
    QueServer := AL;
  end;
end;

procedure GetPrinterStatus(var PrinterNo,FormType : Byte;
          var OffLine,Stopped : Boolean);

var
  Request          : record
                       BufLen : Word; { 2 }
                       SubF,          { $06 }
                       Num    : Byte;
                     end;
  Reply            : record
                       BufLen : Word; { 4 }
                       Bytes  : Array[1..4] of Byte;
                     end;

begin
  with Request do begin
    BufLen := 2;
    SubF   := $06;
    Num    := PrinterNo;
  end;
  Reply.BufLen := 4;
  with NovRegs do begin
    AX := $E000;
    DS := Seg(Request);
    SI := Ofs(Request);
    ES := Seg(Reply);
    DI := Ofs(Reply);
  end;
  MsDos(NovRegs);
  with Reply do begin
    Stopped   := Bytes[1] = $FF;
    OffLine   := Bytes[2] = $01;
    FormType  := Bytes[3];
    PrinterNo := Bytes[4];
  end;
end;

procedure SetDefaultLocalPrinter(LPTNo : PrinterDevice);

begin
  with NovRegs do begin
    AX := $DF00;
    DL := $05;
    DH := Ord(LPTNo);
  end;
  MsDos(NovRegs);
end;

function GetBannerUser : String;
{ returns the user name that is printed on the banner page }

var
  Buf              : String;

begin
  with NovRegs do begin
    AX := $B808;
    ES := Seg(Buf);
    BX := Ofs(Buf);
    MsDos(NovRegs)
  end;
  { process buf }
  GetBannerUser := Buf;
end;

end.