Option Explicit
'\\ API declarations
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
Private mhPrinter As Long
Private Type JOB_INFO_1
JobId As Long
lpPrinterName As String
lpMachinename As String
lpUserName As String
lpDocumentName As String
lpDataType As String
lpStatus As String
Status As PrintJobStatuses
Priority As Long
Position As Long
TotalPages As Long
PagesPrinted As Long
Submitted As SYSTEMTIME
End Type
Private Declare Function GetJob Lib "winspool.drv" Alias "GetJobA" _
(ByVal hPrinter As Long, _
ByVal JobId As Long, _
ByVal Level As Long, _
buffer As Long, _
ByVal pbSize As Long, _
pbSizeNeeded As Long) As Long
Private Declare Function SetJob Lib "winspool.drv" Alias _
"SetJobA" (ByVal hPrinter As Long, _
ByVal JobId As Long, _
ByVal Level As Long, _
pJob As Long, _
ByVal Command As Long) As Long
'\\ When changing information other than the position for JOB_INFO_1 and
'\\ JOB_INFO_2 you must set the Position member to JOB_POSITION_UNSPECIFIED
Private Const JOB_POSITION_UNSPECIFIED = 0
Private mJOB_INFO_1 As JOB_INFO_1
Private buffer() As Long
Private Sub RefreshJobInfo()
Dim lret As Long
Dim SizeNeeded As Long
ReDim Preserve buffer(0 To 1) As Long
lret = GetJob(mhPrinter, mJobId, 1, buffer(0), UBound(buffer), SizeNeeded)
If SizeNeeded > 0 Then
ReDim Preserve buffer(0 To (SizeNeeded / 4) + 3) As Long
lret = GetJob(mhPrinter, mJobId, 1, buffer(0), UBound(buffer) * 4, SizeNeeded)
With mJOB_INFO_1
.JobId = buffer(0)
.lpPrinterName = StringFromPointer(buffer(1), 1024)
.lpMachinename = StringFromPointer(buffer(2), 1024)
.lpUserName = StringFromPointer(buffer(3), 1024)
.lpDocumentName = StringFromPointer(buffer(4), 1024)
.lpDataType = StringFromPointer(buffer(5), 1024)
.lpStatus = StringFromPointer(buffer(6), 1024)
.Status = buffer(7)
.Priority = buffer(8)
.Position = buffer(9)
.TotalPages = buffer(10)
.PagesPrinted = buffer(11)
'Submitted is also here...
With .Submitted
.wYear = LoWord(buffer(12))
.wMonth = HiWord(buffer(12))
.wDayOfWeek = LoWord(buffer(13))
.wDay = HiWord(buffer(13))
.wHour = LoWord(buffer(14))
.wMinute = HiWord(buffer(14))
.wSecond = LoWord(buffer(15))
.wMilliseconds = HiWord(buffer(15))
End With
End With
End If
End Sub
Private Sub SavePrintJobInfo()
Dim lret As Long
With mJOB_INFO_1
buffer(0) = .JobId '\\ This cannot change and is ignored
buffer(1) = LPCSTR(.lpPrinterName) '\\ This is ignored and cannot be changed
buffer(2) = LPCSTR(.lpMachinename) '\\ also ignored
buffer(3) = LPCSTR(.lpUserName)
buffer(4) = LPCSTR(.lpDocumentName)
buffer(5) = LPCSTR(.lpDataType)
buffer(6) = LPCSTR(.lpStatus)
buffer(7) = .Status
buffer(8) = .Priority
buffer(9) = .Position
buffer(10) = .TotalPages
buffer(11) = .PagesPrinted
With .Submitted '\\ Also ignored
buffer(12) = MakeLong(.wYear, .wMonth)
buffer(13) = MakeLong(.wDayOfWeek, .wDay)
buffer(14) = MakeLong(.wHour, .wMinute)
buffer(15) = MakeLong(.wSecond, .wMilliseconds)
End With
End With
lret = SetJob(mhPrinter, mJobId, Level, buffer(0), 0)
End Sub
