frmprintjoblist.frm

RECORDING PRINTER JOB FOR MARK MONEY

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form frmPrintJobs 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Form1"
   ClientHeight    =   4305
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7860
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4305
   ScaleWidth      =   7860
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.ComboBox cmbPrinters 
      Height          =   315
      Left            =   960
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   120
      Width           =   6855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "&Refresh"
      Default         =   -1  'True
      Height          =   495
      Left            =   6360
      TabIndex        =   2
      Top             =   3720
      Width           =   1455
   End
   Begin ComctlLib.ListView lvwPrintJobs 
      Height          =   3135
      Left            =   120
      TabIndex        =   0
      Top             =   480
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   5530
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   5
      BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "a"
         Object.Width           =   254000
      EndProperty
      BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   1
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "b"
         Object.Width           =   254000
      EndProperty
      BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   2
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "c"
         Object.Width           =   254000
      EndProperty
      BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   3
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "d"
         Object.Width           =   254000
      EndProperty
      BeginProperty ColumnHeader(5) {0713E8C7-850A-101B-AFC0-4210102A8DA7} 
         SubItemIndex    =   4
         Key             =   ""
         Object.Tag             =   ""
         Text            =   ""
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Label Label1 
      Caption         =   "Printer : "
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   735
   End
End
Attribute VB_Name = "frmPrintJobs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'\\ API Declarations
Private 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 Long, _
                        ByVal cdBuf As Long, _
                        pcbNeeded As Long, _
                        pcReturned As Long) As Long


Private Type PRINTER_DEFAULTS
    pDatatype As String
    pDevMode As Long
    DesiredAccess As Long
End Type


Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
                         (ByVal pPrinterName As String, _
                         phPrinter As Long, _
                         pDefault As PRINTER_DEFAULTS) As Long
                         
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

'\\ Declarations for StringFromPointer
Private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long

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

'\\ --[RefreshJobList]----------------------------------------------
'\\ Fills the listview control with information on the currently
'\\ active print jobs
'\\ ----------------------------------------------------------------
Public Sub RefreshJobList(ByVal PrinterName As String)

Dim mPrintHandle As Long, lRet As Long
Dim pDEf As PRINTER_DEFAULTS

Dim pcBytesRequired As Long, pcRecordsReturned As Long
Dim pBuff() As Long
Dim nJob As Long, pJobOffset As Long

'\\ Obtain a handle to the named printer
lRet = OpenPrinter(PrinterName, mPrintHandle, pDEf)
If Err.LastDllError = 0 Then
    '\\ Clear any existing listed jobs...
    lvwPrintJobs.ListItems.Clear
    If mPrintHandle <> 0 Then
        '\\ Get size of buffer required to hold printer jobs info
        ReDim Preserve pBuff(0) As Long
        lRet = EnumJobs(mPrintHandle, 0, 255, 1, pBuff(0), UBound(pBuff) * 4, pcBytesRequired, pcRecordsReturned)
        If pcBytesRequired > 0 Then
            ReDim Preserve pBuff(0 To (pcBytesRequired / 4) + 3) As Long
            lRet = EnumJobs(mPrintHandle, 0, 255, 1, pBuff(0), UBound(pBuff) * 4, pcBytesRequired, pcRecordsReturned)
        End If
        If pcRecordsReturned > 0 Then
            '\\ For each job, decode its records....
            For nJob = 0 To (pcRecordsReturned - 1)
                '\\ Each record is 16 longs...
                pJobOffset = nJob * 16
                '\\ add the current job to the list
                lvwPrintJobs.ListItems.Add , "JOB" & nJob, pBuff(pJobOffset)
                '\\ Username is in Offset+3
                lvwPrintJobs.ListItems.Item(lvwPrintJobs.ListItems.Count).SubItems(1) = StringFromPointer(pBuff(pJobOffset + 3), 1024)
                '\\ Document is in Offset+4
                lvwPrintJobs.ListItems.Item(lvwPrintJobs.ListItems.Count).SubItems(2) = StringFromPointer(pBuff(pJobOffset + 4), 1024)
                '\\ DataType is in Offset+5
                lvwPrintJobs.ListItems.Item(lvwPrintJobs.ListItems.Count).SubItems(3) = StringFromPointer(pBuff(pJobOffset + 5), 1024)
            Next nJob
        End If
    
        '\\ Release the named printer's handle
        lRet = ClosePrinter(mPrintHandle)
    End If
End If

End Sub

Private Function StringFromPointer(lpString As Long, lMaxlength As Long) As String

Dim sRet As String
Dim lRet As Long

If lpString = 0 Then
    StringFromPointer = ""
    Exit Function
End If

If Not IsBadStringPtrByLong(lpString, lMaxlength) Then
    '\\ Set aside space to copy string to
    sRet = String$(lMaxlength, 0)
    CopyMemory ByVal sRet, ByVal lpString, ByVal Len(sRet)
    If InStr(sRet, Chr$(0)) > 0 Then
        sRet = Left$(sRet, InStr(sRet, Chr$(0)) - 1)
    End If
End If

StringFromPointer = sRet

End Function


Private Sub cmbPrinters_Click()

Call RefreshJobList(cmbPrinters.Text)

End Sub


Private Sub Command1_Click()

Call RefreshJobList(cmbPrinters.Text)

End Sub

Private Sub Form_Load()

'\\ List all the printers into the combo box...
Dim prtThis As Printer

cmbPrinters.Clear
For Each prtThis In Printers
    cmbPrinters.AddItem prtThis.DeviceName
Next prtThis
'\\ Set printer list to current printer
cmbPrinters.Text = Printer.DeviceName


'\\ Set the columns of the listview
With lvwPrintJobs.ColumnHeaders
    .Clear
    .Add , "JOB_ID", "Job Id", 1440
    .Add , "USER", "User", 1440
    .Add , "DOCUMENT", "Document", 1440
    .Add , "DATATYPE", "Data Type", 1440
End With

End Sub