Private Sub Command1_Click()
MsgBox "Количество запущенных заданий: " &
GetPrinterQueue(Printer.DeviceName)
End Sub
'КОД МОДУЛЯ
Option Explicit
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As DEVMODE
DesiredAccess As Long
End Type
Public 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
Public Type JOB_INFO_1_API
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 Type JOB_INFO_1
JobId As Long
pPrinterName As String
pMachineName As String
pUserName As String
pDocument As String
pDatatype As String
pStatus As String
Status As Long
Priority As Long
Position As Long
TotalPages As Long
PagesPrinted As Long
Submitted As SYSTEMTIME
End Type
Public Declare Function OpenPrinter Lib "winspool.drv" Alias
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As
PRINTER_DEFAULTS) As Long
Public Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA"
(ByVal HPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As
Long, ByVal pJob As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As
Long
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory"
(pTo As Any, uFrom As Any, ByVal lSize As Long)
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long)
As Long
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As
Long
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long,
ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal
dwFlags As Long, lpMem As Any) As Long
Public JobsDesc(0 To 127) As JOB_INFO_1
Public Function TrimStr(strName As String) As String
'Finds a null then trims the string
Dim x As Integer
x = InStr(strName, vbNullChar)
If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function
Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long
'Get number of characters in string
lngLength = lstrlenW(lngPointer) * 2
'Initialize string so we have something to copy the string into
LPSTRtoSTRING = String(lngLength, 0)
'Copy the string
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
'Convert to Unicode
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function
'Get the number of Jobs in the specified Printer Queue (max 128)... the PrinterName can be
a network path: "\\MYSERVER\MYPRINTER"
Function GetPrinterQueue(PrinterName As String) As Long
Dim PrinterStruct As PRINTER_DEFAULTS
Dim HPrinter As Long
Dim ret As Boolean
Dim Jobs(0 To 127) As JOB_INFO_1_API
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim i As Integer
Dim TempBuff As Long
'Initialize the Printer structure
PrinterStruct.pDatatype = vbNullString
PrinterStruct.pDevMode.dmSize = Len(PrinterStruct.pDevMode)
PrinterStruct.DesiredAccess = PRINTER_ACCESS_USE
'Get the printer Handle
ret = OpenPrinter(PrinterName, HPrinter, PrinterStruct)
'Get the Printer active jobs
ret = EnumJobs(HPrinter, 0, 127, 1, TempBuff, 0, pcbNeeded, pcReturned)
If pcbNeeded = 0 Then
GetPrinterQueue = 0
Else
'Allocate the Buffer
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
ret = EnumJobs(HPrinter, 0, 127, 1, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
CopyMem Jobs(0), ByVal TempBuff, pcbNeeded
For i = 0 To pcReturned - 1
JobsDesc(i).pPrinterName = LPSTRtoSTRING(Jobs(i).pPrinterName)
JobsDesc(i).pMachineName = LPSTRtoSTRING(Jobs(i).pMachineName)
JobsDesc(i).pUserName = LPSTRtoSTRING(Jobs(i).pUserName)
JobsDesc(i).pDocument = LPSTRtoSTRING(Jobs(i).pDocument)
JobsDesc(i).pDatatype = LPSTRtoSTRING(Jobs(i).pDatatype)
JobsDesc(i).pStatus = LPSTRtoSTRING(Jobs(i).pStatus)
JobsDesc(i).JobId = Jobs(i).JobId
JobsDesc(i).Status = Jobs(i).Status
JobsDesc(i).Priority = Jobs(i).Priority
JobsDesc(i).Position = Jobs(i).Position
JobsDesc(i).TotalPages = Jobs(i).TotalPages
JobsDesc(i).PagesPrinted = Jobs(i).PagesPrinted
JobsDesc(i).Submitted = Jobs(i).Submitted
Next
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
GetPrinterQueue = pcReturned
End If
ret = CloseHandle(HPrinter)
End Function