pbprintersmonitoru.pas

Monitor local printer activities

{== PBPrintersMonitorU ================================================}
{: This unit implements a component that can be used to monitor print
  jobs send to all installed printers.
@author Dr. Peter Below
@desc   Version 1.0 created 2003-04-20<br/>
        Last modified       2003-04-20<p/>
The component uses a set of background threads to monitor the installed
printers via FindFirstPrinterChangeNotification. It fires events when
a new job is added, when a job completed, or when a jobs status has
changed in some other manner. <p/>
The component does not use the Delphi Synchronize mechanism, it can be
used without problems in a DLL in D6 and above. The component is not
Kylix-compatible, since it depends completely in Windows API functions
for irs functionality. It has only been tested with Delphi 7 on
Win2K SP3.<p/>
NOTE: <br/>
Define the symbol DEBUG to allow the component to show error
messages when it cannot get information for a printer to monitor. <p/>
Define the symbol NO_MESSAGELOOP if the application using the compoent
has no message loop. In this case the internal thread synchronization
will use SendMessageTimeout instead of PostMessage.                    }
{======================================================================}
{$BOOLEVAL OFF}{Unit depends on shortcut boolean evaluation}
Unit PBPrintersMonitorU;
{$I JEDI.INC}

Interface

Uses
  Messages, Windows, SysUtils, Classes, Printers, COntnrs;

Type
  {: This enumeration describes a jobs status
  @enum jsNone no status has been assigned yet
  @enum jsNew the job has just been added to the printers queue
  @enum jsProcessing the job is being processed
  @enum jsPaused the jobs execution has been paused
  @enum jsResumed the jobs execution has been resumed, cannot detect that
  @enum jsAborted the job has been aborted, cannot detect that either
  @enum jsCompleted the job has successfully completed
  @enum jsError the job has run into an error condition
  @Desc Resumed and aborted jobs cannot be detected during the
    notification process, since this would require comparison with
    a previous state. }
  TPBJobStatus =
    (jsNone, jsNew, jsProcessing, jsPaused, jsResumed, jsAborted,
     jsCompleted, jsError );

  {: This is a simple object used to transfer data about a job and
     the printer it is executing on to an event. }
  TPBJobInformation = class
  private
    FPrinterIndex: Integer;   // index of printer in Printer.Printers
    FPrinterName : String ;   // printers devicename
    FPrinterPort : String ;   // printers port name
    FPrinterServer: String;   // server name in case of network printer
    FPrinterShare: String;    // share name in case of a network printer
    FComputer    : String;    // computer that originated the job
    FUser        : String;    // user that originated the job
    FDocument    : String;    // jobs document name
    FPages       : Integer;   // pages printed so far
    FTotalPages  : Integer;   // total pages in job
    FBytesPrinted: Cardinal;  // bytes printed up to now
    FTotalbytes  : Cardinal;  // size of the job in bytes
    FJobID       : Cardinal;  // the ID of the job
    FStatus      : TPBJobStatus; // the jobs status
    FCopies      : Cardinal;  // number of copies requested for job
    FOrientiation: TPrinterOrientation;  // poLandscape or poPortrait
  public
    {: Create an instance and set its data values. }
    Constructor Create( aPrinterIndex: Integer;
                  const aPrinterName, aPrinterPort, aPrinterServer,
                        aPrinterShare: String );

    {: Returns a deep copy of this object. }
    Function Clone: TPBJobInformation;
    property PrinterIndex : Integer read FPrinterIndex;
    property PrinterName  : String read FPrinterName;
    property PrinterPort  : String read FPrinterPort;
    property PrinterServer: String read FPrinterServer;
    property PrinterShare : String read FPrinterShare;
    property Computer     : String read FComputer;
    property User         : String read FUser;
    property Document     : String read FDocument;
    property Pages        : Integer read FPages;
    property TotalPages   : Integer read FTotalPages;
    property BytesPrinted : Cardinal read FBytesPrinted;
    property TotalBytes   : Cardinal read FTotalbytes;
    property JobID        : Cardinal read FJobID;
    property Status       : TPBJobStatus read FStatus;
    property Copies       : Cardinal read FCopies;
    property Orientation  : TPrinterOrientation read FOrientiation;
  End;

  {: Prototype of an event used to pass job information to a client
     if TPBPrintersMonitor.
    @param aJobInformation holds the information about the job. This
      object remains property of the caller, the event handler must
      not free it! }
  TPBJobEvent = Procedure( const aJobinformation: TPBJobInformation ) of Object;

  {: This class offers job monitoring functionality to clients. As it is
    now the object monitors all installed printers automatically, and there
    is no way to limit this to one particular printer. The client has
    to filter out the events of interest itself. Monitoring can be
    suspended and resumed via the Active property and is not done at
    design-time. }
  TPBPrintersMonitor = class(TComponent)
  private
    FInternalSyncHelper: HWND; // helper window used to sync to main thread
    FPendingNotifications: TThreadList; // queue of notifications to process
    FNotifiers: TObjectList;           // list of notifier thread objects
    FActive: Boolean;          // monitoring state
    FNewJobEvent: TPBJobEvent; // atached event handlers
    FJobChangeEvent: TPBJobEvent;
    FJobCompleteEvent: TPBJobEvent;

    Procedure SetActive(const Value: Boolean);
    Procedure CreateNotifiers;
  protected
    {: Window function for the helper window, executes in the printer
       monitors thread, usually the main thread. }
    Procedure WndProc( Var msg: TMessage );

    {: Event handler for the notifier threads, will execute in the
       calling threads context.
      @param aJobInformation contains the job information. The method
        makes a copy of this object for the internal use of the monitor. }
    Procedure JobNotification( const aJobinformation: TPBJobInformation );

    {: Processes all pending notifications in the context of the
      printer monitors thread.  }
    Procedure ProcessNotifications;

    {: Fires the OnNewJob event, if a handler for it has been assigned. }
    Procedure DoNewJob( const aJobinformation: TPBJobInformation ); virtual;

    {: Fires the OnJobChange event, if a handler for it has been assigned. }
    Procedure DoJobChange( const aJobinformation: TPBJobInformation ); virtual;

    {: Fires the OnJobComplete event, if a handler for it has been assigned. }
    Procedure DoJobComplete( const aJobinformation: TPBJobInformation ); virtual;
  public
    Constructor Create( aOwner: TComponent ); override;
    Destructor Destroy; override;
  published
    property Active: Boolean read FActive write SetActive;
    property OnNewJob: TPBJobEvent read FNewJobEvent write FNewJobEvent;
    property OnJobChange: TPBJobEvent read FJobChangeEvent write FJobChangeEvent;
    property OnJobComplete: TPBJobEvent read FJobCompleteEvent write FJobCompleteEvent;
  end;

  {: Exception class used to report monitor errors }
  EPBPrinterMonitorError = class( Exception );

Procedure Register;

Implementation

Uses WinSpool, SyncObjs
    {$IFNDEF DELPHI6_UP} , Forms {$ENDIF}
     ;

Procedure Register;
  Begin
    RegisterComponents('PBGoodies', [TPBPrintersMonitor]);
  End;

{$IFDEF DELPHI6_UP} // To remove deprecated warning
Procedure RaiseLastWin32Error;
  Begin
    RaiseLastOSError;
  End;
{$ENDIF}      

Type
  {: This thread class will monitor the job queue of a single printer.
    On changes to a job or the queue an event is fired. The events
    handler has to make sure the processing it does is thread-safe. }
  TPBPrintMonitor = class( TThread )
  private
    FJobInformation: TPBJobInformation;
       // contains info on monitored printer and last job change
    FPrinterHandle : THandle;      // the printers API handle
    FWakeupEvent   : TSimpleEvent; // used to wake thread when it is destroyed
    FRunning       : Boolean;      // flag set when thread reaches Execute
    FJobChangeEvent: TPBJobEvent;
    procedure HandleNotification(findhandle: THandle);  // attached event handler
  protected
    Procedure Execute; override;
    Constructor InternalCreate;
    Procedure DoJobChange; virtual;
    Procedure Wakeup;
  public
    {: Do not use this constructor!
     @raises EPBPrinterMonitorError when called }
    Constructor Create( CreateSuspended: Boolean );

    {: This class function is used to create an instance of the
      class to monitor a specific printer.
     @param index is the index of the printer to monitor in Printer.Printers
     @param onChangeJob is the callback to receive job notifications.
     @precondition 0 <= index < Printer.Printers.count
     @returns the created object, or Nil, if the printer information could
       not be obtained from the API.  }
    class Function CreateMonitor( index: Integer; onChangeJob: TPBJobEvent ): TPBPrintMonitor;

    {: Wakes the thread from the wait state, closes the printer handle. }
    Destructor Destroy; override;

    property OnJobChange: TPBJobEvent read FJobChangeEvent write FJobChangeEvent;
  End;

{ TPBPrintMonitor 棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗梷

Constructor TPBPrintMonitor.Create(CreateSuspended: Boolean);
  Begin
    raise EPBPrinterMonitorError.Create(
           'Do not use this constructor to create instances of '+
           'TPBPrintMonitor, use the CreateMonitor method instead!' );
  End;

{-- GetCurrentPrinterHandle -------------------------------------------}
{: Retrieves the handle of the current printer
@Returns an API printer handle for the current printer
@Desc Uses WinSpool.OpenPrinter to get a printer handle. The caller
  takes ownership of the handle and <b>must</b> call ClosePrinter on it
  once the handle is no longer needed. Failing to do that creates a
  serious resource leak! <P>
  Requires Printers and WinSpool in the Uses clause.
@Raises EWin32Error if the OpenPrinter call fails.
}{ Created 30.9.2000 by P. Below
-----------------------------------------------------------------------}
Function GetCurrentPrinterHandle: THandle;
  Const
    Defaults: TPrinterDefaults = (
      pDatatype : nil;
      pDevMode  : nil;
      DesiredAccess : PRINTER_ACCESS_USE or PRINTER_ACCESS_ADMINISTER );
  Var
    Device, Driver, Port : array[0..255] of char;
    hDeviceMode: THandle;
  Begin { GetCurrentPrinterHandle }
    Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
    If not OpenPrinter(@Device, Result, @Defaults) Then
      RaiseLastWin32Error;
  End; { GetCurrentPrinterHandle }

{: Selects the printer by the passed index and tries to obtains its
  API handle and a number of information items on it. If this succeeds
  the thread is created, fed the obtained data, and its reference is
  returned. The thread is suspended. <br/>
  We trap any exceptions on the way and do not allow them to escape
  the function, instead Nil is returned as result. If the symbol DEBUG
  is defined a message box with the exception message will be shown,
  but program flow will still continue after that. <p/>
  WARNING! This function has a side effect! It will change the selected
  printer! The routine calling CreateMonitor is responsible for saving
  and restoring the previously selected printer, if that is required.
  This is an optimization, since in typical use CreateMonitor will
  be called for every printer in the list. }
class Function TPBPrintMonitor.CreateMonitor(index: Integer;
    onChangeJob: TPBJobEvent): TPBPrintMonitor;
  Var
    printerhandle: THandle;
    pInfo: PPrinterInfo2;
    bytesNeeded: DWORD;
  Begin
    If (index < 0) or (index >= Printer.Printers.Count) Then
      raise EPBPrinterMonitorError.CreateFmt(
             'TPBPrintMonitor.CreateMonitor: index %d is out of range. '+
             'Valid indices are %d..%d.',
             [index, 0, Printer.Printers.Count] );

    Result := nil;
    printerhandle := 0;
    Try
      Printer.PrinterIndex := index;
      printerhandle := GetCurrentPrinterhandle;
      Winspool.GetPrinter( printerhandle, 2, Nil, 0, @bytesNeeded );
      If GetLastError <> ERROR_INSUFFICIENT_BUFFER Then
        RaiseLastWin32Error;
      pInfo := AllocMem( bytesNeeded );
      Try
        If not Winspool.GetPrinter( printerhandle, 2, pInfo, bytesNeeded, @bytesNeeded )
        Then
          RaiseLastWin32Error;
        Result := TPBPrintMonitor.InternalCreate;
        Try
          Result.FPrinterHandle := printerhandle;
          Result.FJobInformation :=
            TPBJobInformation.Create(
              index,
              pInfo^.pPrinterName,
              pInfo^.pPortName,
              pInfo^.pServerName,
              pInfo^.pShareName );
          Result.FJobChangeEvent := OnChangeJob;
        Except
          Result.FPrinterHandle := 0;  // prevents ClosePrinter to be called twice
          FreeAndNil( Result );
          raise;
        End; { Except }
      Finally
        FreeMem( pInfo );
      End;
    Except
      On E: Exception Do Begin
        If printerhandle <> 0 Then
          ClosePrinter( printerhandle );
        {$IFDEF DEBUG}
                (*
          If not (E Is EAbort) Then Begin
                    S:= Format(
                          'TPBPrintMonitor.CreateMonitor raised an exception.'#13#10+
                          'Exception class %s'#13#10'%s',
                          [E.classname, E.Message] );
                    Windows.MessageBox( 0, Pchar(S), 'Error', MB_OK or MB_ICONSTOP );
                  End; { If }  
        *)
        {$ENDIF}
      End; { On }
    End; { Except }
  End;

Destructor TPBPrintMonitor.Destroy;
  Begin
    If not Terminated Then Terminate;
    Wakeup;
    If FRunning and Suspended Then Resume;
    inherited;  // will wait until the thread has died
    ClosePrinter( FPrinterHandle );
    FJobInformation.Free;
    FWakeupEvent.Free;
  End;

Procedure TPBPrintMonitor.DoJobChange;
  Begin
    If Assigned( FJobChangeEvent ) Then
      FJobChangeEvent( FJobInformation );
  End;

Procedure TPBPrintMonitor.HandleNotification( findhandle: THandle );
  Var
    pni: PPrinterNotifyInfo;
    ChangeReason: Cardinal;

  Function ReasonWas( flag: Cardinal ): Boolean;
    Begin
      Result := (flag and ChangeReason) <> 0;
    End; { ReasonWas }

  Function FindJobStatus: TPBJobStatus;
    Var
      i: Integer;
      status: Cardinal;

    Function StatusIs( flag: Cardinal ): Boolean;
      Begin
        Result := (flag and status) <> 0;
      End; { StatusIs }

    Begin { FindJobStatus }
      Result := jsNone;
      If Assigned( pni ) Then
      For i:=0 To pni^.Count-1 Do