pbprintersmonitoru.pas

Monitor local printer activities

        If pni^.aData[i].Field = JOB_NOTIFY_FIELD_STATUS Then Begin
          status := pni^.aData[i].NotifyData.adwData[0];
          If StatusIs( JOB_STATUS_PRINTED ) Then
            Result := jsCompleted
          Else If StatusIs( JOB_STATUS_DELETING ) Then
            Result := jsNone
            // we skip this case because we will get another notification for that
          Else If StatusIs( JOB_STATUS_SPOOLING or JOB_STATUS_PRINTING )
          Then
            Result := jsProcessing
          Else If StatusIs( JOB_STATUS_ERROR or JOB_STATUS_OFFLINE or
                            JOB_STATUS_PAPEROUT )
          Then
            Result := jsError
          Else If StatusIs( JOB_STATUS_PAUSED ) Then
            Result := jsPaused;
          Break;
        End; { If }
    End; { FindJobStatus }

  Procedure GetJobInformation;
    Function DataString( index: Integer ): String;
      Begin
        Result := Pchar( pni^.aData[index].NotifyData.Data.pBuf )
      End;
    Function DataValue( index: Integer ): Cardinal;
      Begin
        Result := pni^.aData[index].NotifyData.adwData[0];
      End;
    Function GetPrinterNumCopies(index: Integer):Cardinal;
      Begin
        result:=PDeviceMode( pni^.aData[index].NotifyData.Data.pBuf)^.dmCopies;
      End;
    Function GetPrinterOrientation(index: Integer):TPrinterOrientation;
      var Orientation: smallint;
      Begin
        Orientation:=
          PDeviceMode(pni^.aData[index].NotifyData.Data.pBuf)^.dmOrientation;
       Case orientation Of
         DMORIENT_PORTRAIT : result:=poPortrait;
         DMORIENT_LANDSCAPE: result:=poLandscape;
       Else
         result := poPortrait;
         Assert( false, 'Unknown value in dmOrientation');
       End;
      End;

    Var
      i: Integer;
    Begin { GetJobInformation }
      If not Assigned( pni) or (pni^.Count = 0) Then Exit;
      FJobInformation.FJobID := pni^.aData[0].Id;
      For i:=0 To pni^.Count-1 Do
        Case pni^.aData[i].Field Of
          JOB_NOTIFY_FIELD_MACHINE_NAME:
            FJobInformation.FComputer := Datastring(i);
          JOB_NOTIFY_FIELD_USER_NAME:
            FJobInformation.FUser := Datastring(i);
          JOB_NOTIFY_FIELD_DOCUMENT:
            FJobInformation.FDocument := Datastring(i);
          JOB_NOTIFY_FIELD_TOTAL_PAGES:
            FJobInformation.FTotalPages := Datavalue(i);
          JOB_NOTIFY_FIELD_TOTAL_BYTES:
            FJobInformation.FTotalbytes := Datavalue(i);
          JOB_NOTIFY_FIELD_BYTES_PRINTED:
            FJobInformation.FBytesPrinted := Datavalue(i);
          JOB_NOTIFY_FIELD_PAGES_PRINTED:
            FJobInformation.FPages := Datavalue(i);
          JOB_NOTIFY_FIELD_DEVMODE: Begin
              FJobInformation.FCopies:= GetPrinterNumCopies(i);
              FJobInformation.FOrientiation := GetPrinterOrientation(i);
            End;
        End; { Case }
    End; { GetJobInformation }

  Begin { HandleNotification }
    If FindNextPrinterChangeNotification(
         findhandle, ChangeReason, nil, Pointer(pni) )
    Then Try
      If ReasonWas( PRINTER_CHANGE_ADD_JOB ) Then
        FJobInformation.FStatus := jsNew
      Else If ReasonWas( PRINTER_CHANGE_DELETE_JOB ) Then
        FJobInformation.FStatus := jsCompleted
      Else If ReasonWas( PRINTER_CHANGE_SET_JOB ) Then
        FJobInformation.FStatus := FindJobStatus
      Else If ReasonWas( PRINTER_CHANGE_WRITE_JOB ) Then
        FJobInformation.FStatus := jsProcessing
      Else
        FJobInformation.FStatus := jsNone;

      If FJobInformation.FStatus <> jsNone Then Begin
        GetJobInformation;
        DoJobChange;
      End; { If }
    Finally
      FreePrinterNotifyInfo( pni );
    End; { Finally }
  End; { TPBPrintMonitor.HandleNotification }

Procedure TPBPrintMonitor.Execute;
  Const
    jobfields : Array [1..9] of Word =
      (
        JOB_NOTIFY_FIELD_MACHINE_NAME,
        JOB_NOTIFY_FIELD_USER_NAME,
        JOB_NOTIFY_FIELD_DOCUMENT,
        JOB_NOTIFY_FIELD_TOTAL_PAGES,
        JOB_NOTIFY_FIELD_TOTAL_BYTES,
        JOB_NOTIFY_FIELD_BYTES_PRINTED,
        JOB_NOTIFY_FIELD_PAGES_PRINTED,
        JOB_NOTIFY_FIELD_STATUS,
        JOB_NOTIFY_FIELD_DEVMODE );
  Var
    handles: packed Record
        findhandle, wakehandle: THandle;
      end;
    notifyOptions: PRINTER_NOTIFY_OPTIONS;
    notifyType: PRINTER_NOTIFY_OPTIONS_TYPE;
    retval: DWORD;
  Begin
    FRunning := True;
    If Terminated Then Exit;
    notifyOptions.Version := 2;
    notifyOptions.Count   := 1;
    notifyOptions.Flags   := PRINTER_NOTIFY_OPTIONS_REFRESH;
    notifyOptions.pTypes  := @notifyType;
    FillChar( notifyType, sizeof( notifyType ), 0 );
    notifyType.wType      := JOB_NOTIFY_TYPE;
    notifyType.pFields    := @jobfields;
    notifyType.Count      := High( jobfields )- Low( jobfields ) + 1;
    handles.wakehandle := FWakeupEvent.Handle;
    handles.findhandle :=
      FindFirstPrinterChangeNotification(
        Fprinterhandle,
        PRINTER_CHANGE_JOB, // we are only interested in job-related changes
        0, @notifyoptions );
    If handles.findhandle <> INVALID_HANDLE_VALUE Then Begin
      While not Terminated Do Begin
        retval := WaitForMultipleObjects( 2, @handles, false, INFINITE );
        If not Terminated Then
          If retval = WAIT_OBJECT_0 Then
            try
              HandleNotification( handles.findhandle )
            except
              // HandleNotifiaction will only ever raise assertions,
              // which the IDE debugger will trap for us
            end
          Else
            Break;
      End; { While }
      FindClosePrinterChangeNotification( handles.findhandle );
    End { If }
    Else Begin
      {$IFDEF DEBUG}
            (*
        S:= 'FindFirstPrinterChangeNotification failed for printer '+
                  FJobInformation.FPrinterName+', the system error is'#13#10+
                  SysErrorMessage( GetLastError );
              Windows.MessageBox( 0, Pchar(S), 'Error', MB_OK or MB_ICONSTOP );  
      *)
      {$ENDIF}
    End; { Else }
  End;

{: Create the thread suspended, create the wakeup event. }
Constructor TPBPrintMonitor.InternalCreate;
  Begin
    inherited Create( true );
    FWakeupEvent := TSimpleEvent.Create;
  End;

Procedure TPBPrintMonitor.Wakeup;
  Begin
    FWakeupEvent.SetEvent;
  End;

{ TPBJobInformation 棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗梷

Function TPBJobInformation.Clone: TPBJobInformation;
  Begin
    Result := TPBJobInformation.Create(
                 PrinterIndex, PrinterName, PrinterPort,
                 PrinterServer, PrinterShare );
    Result.FComputer := Computer;
    Result.FUser     := User;
    Result.FDocument := Document;
    Result.FPages    := Pages;
    Result.FTotalPages := TotalPages;
    Result.FbytesPrinted := BytesPrinted;
    Result.FTotalbytes   := Totalbytes;
    Result.FJobID  := JobID;
    Result.FStatus := Status;
  End;

Constructor TPBJobInformation.Create(aPrinterIndex: Integer;
    const aPrinterName, aPrinterPort, aPrinterServer, aPrinterShare: String );
  Begin
    inherited Create;
    FPrinterIndex := aPrinterIndex;
    FPrinterName := aPrinterName;
    FPrinterPort := aPrinterPort;
    FPrinterServer := aPrinterServer;
    FPrinterShare := aPrinterShare;
  End;

{ TPBPrintersMonitor 棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗棗梷

Const
  UM_JOBNOTIFICATION = WM_APP;

Constructor TPBPrintersMonitor.Create(aOwner: TComponent);
  Begin
    inherited;
    If not (csDesigning In ComponentState) Then Begin
  {$IFDEF DELPHI6_UP}
      FInternalSyncHelper := Classes.AllocateHWnd( WndProc );
  {$ELSE}
      FInternalSyncHelper := Forms.AllocateHWnd( WndProc );
  {$ENDIF}
      FPendingNotifications :=  TThreadList.Create;
      FNotifiers := TObjectList.Create( true ); // Owns the objects
      CreateNotifiers;
    End; { If }
  End;

Procedure TPBPrintersMonitor.CreateNotifiers;
  Var
    aNotifier: TPBPrintMonitor;
    i: Integer;
    oldIndex: Integer;
  Begin
    If Printer.Printers.Count > 0 Then
    Try
      oldindex := Printer.PrinterIndex;
      Try
        For i:= 0 To Printer.Printers.Count-1 Do Begin
          aNotifier := TPBPrintMonitor.CreateMonitor( i, JobNotification );
          If Assigned( aNotifier ) Then
            FNotifiers.Add( aNotifier );
        End; { For }
      Finally
        Printer.PrinterIndex := oldIndex;
      End; { Finally }
    Except
      // this is a crutch. If no default printer is defined accessing
      // PrinterIndex can cause an exception
    End; { Except }
  End;

Destructor TPBPrintersMonitor.Destroy;
  Begin
    FNotifiers.Free;
    FPendingNotifications.Free;
  {$IFDEF DELPHI6_UP}
    Classes.DeallocateHWnd( FInternalSyncHelper );
  {$ELSE}
    Forms.DeallocateHWnd( FInternalSyncHelper );
  {$ENDIF}
    inherited;
  End;

Procedure TPBPrintersMonitor.DoJobChange(
    const aJobinformation: TPBJobInformation);
  Begin
    If Assigned( FJobChangeEvent ) Then
      FJobChangeEvent( aJobinformation );
  End;

Procedure TPBPrintersMonitor.DoJobComplete(
    const aJobinformation: TPBJobInformation);
  Begin
    If Assigned( FJobCompleteEvent ) Then
      FJobCompleteEvent( aJobinformation );
  End;

Procedure TPBPrintersMonitor.DoNewJob(
    const aJobinformation: TPBJobInformation);
  Begin
    If Assigned( FNewJobEvent ) Then
      FNewJobEvent( aJobinformation );
  End;

Procedure TPBPrintersMonitor.JobNotification(
    const aJobinformation: TPBJobInformation);
  {$IFDEF NO_MESSAGELOOP}
  Var
    res: Cardinal;
 {$ENDIF}
  Begin
    FPendingNotifications.Add( aJobinformation.Clone );
    {$IFDEF NO_MESSAGELOOP}
    SendMessageTimeout( FInternalSyncHelper,
                        UM_JOBNOTIFICATION,
                        0, 0,
                        SMTO_NORMAL or SMTO_ABORTIFHUNG,
                        1000, res );
    {$ELSE}
    PostMessage( FInternalSyncHelper, UM_JOBNOTIFICATION, 0, 0 );
    {$ENDIF}
  End;

Procedure TPBPrintersMonitor.ProcessNotifications;
  Var
    items: TObjectList;
    list: TList;
    i: Integer;
    jobinfo: TPBJobInformation;
  Begin
    items := nil;
    list:= FPendingNotifications.LockList;
    Try
      If list.count > 0 Then Begin
        items:= TOBjectlist.Create;  // owns its objects
        For i:=0 To list.Count-1 Do
          items.add( TObject( list[i] ));
        list.Clear;
      End; { If }
    Finally
      FPendingNotifications.UnlockList;
    End; { Finally }
    If Assigned( items ) Then
    Try
      For i:= 0 To items.count-1 Do Begin
        jobinfo:= TPBJobInformation( items[i] );
        Case jobinfo.Status Of
          jsNew       : DoNewJob( jobinfo );
          jsCompleted : DoJobComplete( jobinfo );
        Else
          DoJobChange( jobinfo );
        End; { Case }
      End; { For }
    Finally
      items.Free
    End; { Finally }
  End;

Procedure TPBPrintersMonitor.SetActive(const Value: Boolean);
  Var
    i: Integer;
  Begin
    If FActive <> Value Then Begin
      FActive := Value;
      If not (csDesigning In ComponentState) Then
        For i:= 0 to FNotifiers.Count-1 Do
          If Value Then
            TPBPrintMonitor( FNotifiers[i] ).Resume
          Else
            TPBPrintMonitor( FNotifiers[i] ).Suspend;
    End; { If }
  End;

Procedure TPBPrintersMonitor.WndProc(var msg: TMessage);
  Begin
    If msg.Msg = UM_JOBNOTIFICATION Then
      ProcessNotifications
    Else
      msg.Result := DefWindowProc( FInternalSyncHelper,
                                   msg.Msg,
                                   msg.WParam,
                                   msg.LParam );
  End;


end.