Binaryworld - How to monitor Printer Queue using printer API ... [ VB -> Printing ]

This article will show you how you can use OpenPrinter, EnumJobs and ClosePrinter API to monitor selected printer's queue.

To implement Quick Demo perform the following steps

- Create a standard exe project
- Add module1
- Place 1 commandbutton, 1 textbox, 1 combobox 1 timer and 1 ListView control

Note : ListView control require reference to Microsoft Windows Common Control Library.

You can add that using Project->Controls

Place the following code in form1's code window

form1.frm

Click here to copy the following block

Option Explicit

Private strPrinterName As String

Private Sub LoadPrintersList()
  Dim prn As Printer
  Combo1.Clear

  For Each prn In Printers
    Combo1.AddItem prn.DeviceName
  Next
End Sub

Private Sub ShowStatus(strText As String)
  Me.Caption = "Printer Queue on [" & strPrinterName & "] - " & strText
End Sub

Private Function CheckStatus(ByVal strStatus As String, intStatus As Long, _
               intStatusFlag As Long, strStatusString As String) As String
  If intStatus And intStatusFlag Then
    If Trim$(strStatus) <> "" Then strStatus = strStatus & " - "
    strStatus = strStatus & strStatusString
  End If
  CheckStatus = strStatus
End Function

Private Sub RefreshPrinterQueue()
  Dim hPrinter As Long
  Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
  Dim lngJobsNeeded As Long, lngJobsReturned As Long
  Dim byteJobsBuffer() As Byte, arrJobs() As JOB_INFO_1
  Dim lngJobsCount As Long
  Dim lngResult As Long

  Dim byteBuffer(64) As Byte
  Dim strDocument As String, strStatus As String, strOwnerName As String

  Dim itmX As ListItem

  ShowStatus "Refreshing ..."

  ListView1.ListItems.Clear

  lngResult = OpenPrinter(strPrinterName, hPrinter, ByVal vbNullString)

  lngJobsFirstJob = 0  ' zero-based position within the print queue of the first print job to enumerate

  lngJobsEnumJob = 99  ' total number of print jobs to enumerate

  lngJobsLevel = 1  ' Specifies whether the function should use JOB_INFO_1
  ' or JOB_INFO_2 structures to store data for the enumerated jobs

  lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
      lngJobsLevel, ByVal vbNullString, 0, _
      lngJobsNeeded, lngJobsReturned)

  ' Check out the number of jobs hypothetically will be returned
  If lngJobsNeeded > 0 Then

    ReDim byteJobsBuffer(lngJobsNeeded - 1)
    ReDim arrJobs(lngJobsNeeded - 1)

    lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
        lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
        lngJobsNeeded, lngJobsReturned)

    ' Check out the number of jobs returned
    If lngJobsReturned > 0 Then

      MoveMemory arrJobs(0), byteJobsBuffer(0), Len(arrJobs(0)) * lngJobsReturned

      For lngJobsCount = 0 To lngJobsReturned - 1
        With arrJobs(lngJobsCount)

          ' Get the document name
          lngResult = lstrcpy(byteBuffer(0), ByVal .pDocument)

          strDocument = StrConv(byteBuffer(), vbUnicode)
          ' Document name has been returned as null terminated-string
          strDocument = Left$(strDocument, InStr(strDocument, vbNullChar) - 1)

          ' Get the document's owner name
          lngResult = lstrcpy(byteBuffer(0), ByVal .pUserName)

          strOwnerName = StrConv(byteBuffer(), vbUnicode)
          ' Document's owner name has been returned as null-terminated string
          strOwnerName = Left$(strOwnerName, InStr(strOwnerName, vbNullChar) - 1)

          ' Translate status
          strStatus = ""

          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_DELETING, "Deleting")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_ERROR, "Error")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_OFFLINE, "Offline")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_PAPEROUT, "Out of paper")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_PAUSED, "Paused")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_PRINTED, "Printed")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_PRINTING, "Printing")
          strStatus = CheckStatus(strStatus, .Status, JOB_STATUS_SPOOLING, "Spooling")

          ' Show it in listview
          Set itmX = ListView1.ListItems.Add(, "JOB_ID_" & .JobId, strDocument)
          itmX.SubItems(1) = strStatus
          itmX.SubItems(2) = strOwnerName
          itmX.SubItems(3) = .PagesPrinted & " of " & (.TotalPages + .PagesPrinted)
          itmX.SubItems(4) = ""
        End With
      Next lngJobsCount
    Else
      ' number of jobs returned = 0 (no jobs)
      lngJobsCount = 0
    End If
  Else
    ' number of jobs = 0 (no jobs)
    lngJobsCount = 0
  End If
  lngResult = ClosePrinter(hPrinter)

  ShowStatus lngJobsCount & " document(s)"

End Sub

Private Sub Combo1_Click()
  strPrinterName = Combo1.Text
End Sub

Private Sub Command1_Click()
  Timer1.Interval = Text1
  RefreshPrinterQueue
End Sub

Private Sub Form_Load()
  On Error GoTo errhandler
  Dim Index As Long

  Call InitControls
  Call LoadPrintersList

  '//Select default printer in combobox

  If Combo1.ListCount >= 0 Then
    Combo1.Text = Printer.DeviceName
  Else
    MsgBox "No default printer installed...", vbInformation
  End If

  Exit Sub
errhandler:
  MsgBox Err.Description, vbCritical
End Sub

Sub InitControls()
  Text1 = 500
  Command1.Caption = "Refresh"
  Timer1.Enabled = True
  Timer1.Interval = 500

  '//Set ListView header columns
  With ListView1
    .View = lvwReport
    .ColumnHeaders.Add , , "Document Name"
    .ColumnHeaders.Add , , "Status"
    .ColumnHeaders.Add , , "Owner"
    .ColumnHeaders.Add , , "Page"
    .ColumnHeaders.Add , , "Size"
  End With
End Sub

Private Sub Timer1_Timer()
  RefreshPrinterQueue
End Sub

And now place the following code in Module1

Module1.bas

Click here to copy the following block

Option Explicit
'OpenPrinter, ClosePrinter, EnumJobs, MoveMemory, lstrcpy
Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
    (ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long

Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" _
    (ByVal hPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, _
    ByVal Level As Long, pJob As Any, ByVal cdBuf As Long, _
    pcbNeeded As Long, pcReturned As Long) As Long

Type SYSTEMTIME
  wYear     As Integer
  wMonth    As Integer
  wDayOfWeek  As Integer
  wDay     As Integer
  wHour     As Integer
  wMinute    As Integer
  wSecond    As Integer
  wMilliseconds As Integer
End Type

Type JOB_INFO_1
  JobId    As Long
  pPrinterName As Long
  pMachineName As Long
  pUserName  As Long
  pDocument  As Long
  pDatatype  As Long
  pStatus   As Long
  Status    As Long
  Priority   As Long
  Position   As Long
  TotalPages As Long
  PagesPrinted As Long
  Submitted  As SYSTEMTIME
End Type

Public Const JOB_STATUS_PAUSED = &H1
Public Const JOB_STATUS_ERROR = &H2
Public Const JOB_STATUS_DELETING = &H4
Public Const JOB_STATUS_SPOOLING = &H8
Public Const JOB_STATUS_PRINTING = &H10
Public Const JOB_STATUS_OFFLINE = &H20
Public Const JOB_STATUS_PAPEROUT = &H40
Public Const JOB_STATUS_PRINTED = &H80
Public Const JOB_STATUS_DELETED = &H100
Public Const JOB_STATUS_BLOCKED_DEVQ = &H200
Public Const JOB_STATUS_USER_INTERVENTION = &H400  ' Windows 95 Only

Public Const NO_PRIORITY = 0
Public Const MAX_PRIORITY = 99
Public Const MIN_PRIORITY = 1
Public Const DEF_PRIORITY = 1

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
    (lpString1 As Any, _
    lpString2 As Any) As Long

Public Function IsPrinterQueueEmpty(strPrinter As String) As Boolean
  IsPrinterQueueEmpty = GetPrinterJobsCount(strPrinter) = 0
End Function

Public Function GetPrinterJobsCount(strPrinter As String) As Long
  Dim hPrinter As Long
  Dim lngJobsFirstJob As Long, lngJobsEnumJob As Long, lngJobsLevel As Long
  Dim lngJobsNeeded As Long, lngJobsReturned As Long
  Dim udtJobInfo1() As JOB_INFO_1
  Dim lngJobsCount As Long
  Dim lngResult As Long

  lngResult = OpenPrinter(strPrinter, hPrinter, ByVal vbNullString)

  lngJobsFirstJob = 0  ' zero-based position within the print queue of the first print job to enumerate

  lngJobsEnumJob = 99  ' total number of print jobs to enumerate

  lngJobsLevel = 1  ' Specifies whether the function should use JOB_INFO_1
  ' or JOB_INFO_2 structures to store data for the enumerated jobs

  lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
      lngJobsLevel, ByVal vbNullString, 0, _
      lngJobsNeeded, lngJobsReturned)

  ' Check out the number of jobs hypothetically will be returned
  If lngJobsNeeded > 0 Then

    ReDim byteJobsBuffer(lngJobsNeeded - 1)
    ReDim udtJobInfo1(lngJobsNeeded - 1)

    lngResult = EnumJobs(hPrinter, lngJobsFirstJob, lngJobsEnumJob, _
        lngJobsLevel, byteJobsBuffer(0), lngJobsNeeded, _
        lngJobsNeeded, lngJobsReturned)

    ' Check out the number of jobs returned
    If lngJobsReturned > 0 Then
      lngJobsCount = lngJobsReturned
    Else
      ' number of jobs returned = 0 (no jobs)
      lngJobsCount = 0
    End If
  Else
    ' number of jobs = 0 (no jobs)
    lngJobsCount = 0
  End If
  lngResult = ClosePrinter(hPrinter)

  GetPrinterJobsCount = lngJobsCount
End Function

Now Press F5 to run the project