请问哪位有会编打印机监控程序，满分全送！

[sky521]

请问哪位有会编打印机监控程序，满分全送！希望给出源代码！

[SoHo_Andy]

很少有用VB来做的
一大堆的API

[lihonggen0]

需要很多api，呵呵

如获取打印作业：

Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
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 Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Sub Form_Load()

Dim hPrinter As Long, lNeeded As Long, lReturned As Long
Dim lJobCount As Long
OpenPrinter Printer.DeviceName, hPrinter, ByVal 0&
EnumJobs hPrinter, 0, 99, 1, ByVal 0&, 0, lNeeded, lReturned
If lNeeded > 0 Then
ReDim byteJobsBuffer(lNeeded - 1) As Byte
EnumJobs hPrinter, 0, 99, 1, byteJobsBuffer(0), lNeeded, lNeeded, lReturned
If lReturned > 0 Then
lJobCount = lReturned
Else
lJobCount = 0
End If
Else
lJobCount = 0
End If
ClosePrinter hPrinter
MsgBox "Jobs in printer queue: " + CStr(lJobCount), vbInformation
End Sub

[lihonggen0]

http://www.partware.com/ebooks/api/ref/funcc.html#printers

http://www.ccw.com.cn/applic/prog/htm2003/20031015_115P3.asp

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_9qnm.asp

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/gdi/prntspol_9qnm.asp

http://www.activevb.de/rubriken/apikatalog/deklarationen/openprinter.html

[online]

希望有帮助
Option Explicit

Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrn As Long, pDefault As Any) As Long
Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, pBuf As Any, ByVal cdBuf As Long, pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long

Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

Private 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
Private Type DOC_INFO_1
pDocName As String
pOutputFile As String
pDatatype As String
End Type
Private Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As DEVMODE
DesiredAccess As Long
End Type

Dim IErrorL As Long

' 寻找并列出系统中的打印机
Private Sub SelectDefaultPrinter(Lst As ComboBox)
Dim sRet As String
Dim nRet As Integer
Dim i As Integer

sRet = Space(255)
nRet = GetProfileString("Windows", ByVal "device", "", sRet, Len(sRet))
If nRet Then
sRet = UCase(Left(sRet, InStr(sRet, ",") - 1))
For i = 0 To Lst.ListCount
If Left(UCase(Lst.List(i)), Len(sRet)) = sRet Then
Lst.ListIndex = i
Exit For
End If
Next i
End If
End Sub

Private Sub SpoolFile(sFile As String, PrnName As String, Optional AppName As String = "")
Dim hPrn As Long
Dim Buffer() As Byte
Dim hFile As Integer
Dim Written As Long
Dim DI As DOC_INFO_1
Dim i As Long
Const BufSize As Long = &H4000
Dim PrnD As PRINTER_DEFAULTS

' 为DI结构赋值
If InStr(sFile, "\") Then
For i = Len(sFile) To 1 Step -1
If Mid(sFile, i, 1) = "\" Then Exit For
DI.pDocName = Mid(sFile, i, 1) & DI.pDocName
Next i
Else
DI.pDocName = sFile
End If
If Len(AppName) Then
DI.pDocName = AppName & ": " & DI.pDocName
End If
DI.pOutputFile = vbNullString
DI.pDatatype = "RAW"

' 为PrnD结构赋值
PrnD.pDatatype = vbNullString
PrnD.pDevMode.dmSize = Len(PrnD.pDevMode)
PrnD.DesiredAccess = PRINTER_ACCESS_USE

' 打开打印机，启动一个文档并开始一个页面
IErrorL = OpenPrinter(PrnName, hPrn, PrnD)
IErrorL = StartDocPrinter(hPrn, 1, DI)
IErrorL = StartPagePrinter(hPrn)

' 打开文件并写入到将数据写入打印机
hFile = FreeFile
Open sFile For Binary Access Read As hFile
ReDim Buffer(1 To BufSize) As Byte
For i = 1 To LOF(hFile) \ BufSize
Get #hFile, , Buffer
Call WritePrinter(hPrn, Buffer(1), BufSize, Written)
Next i
If LOF(hFile) Mod BufSize Then
ReDim Buffer(1 To (LOF(hFile) Mod BufSize)) As Byte
Get #hFile, , Buffer
IErrorL = WritePrinter(hPrn, Buffer(1), UBound(Buffer), Written)
End If
Close #hFile

' 结束页，文档并关闭打印机
Call EndPagePrinter(hPrn)
Call EndDocPrinter(hPrn)
Call ClosePrinter(hPrn)
End Sub

Private Sub cmdClose_Click()
'
' All Done
'
Unload Me
End Sub

' 打开文档
Private Sub cmdFile_Click()
With CommonDialog1
.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
.Filter = "Print Files (*.prn)|*.PRN|AllFiles (*.*)|*.*"
On Error Resume Next
.ShowOpen
If Err = 0 Then
txtFile = .FileName
End If
End With
End Sub

' 发送脱机打印任务
Private Sub cmdPrint_Click()
Dim Submit As String
Dim prn As Printer

Submit = UCase(Trim(txtFile))
For Each prn In Printers
If InStr(Combo1, prn.DeviceName) = 1 _
And Right(Combo1, Len(prn.Port)) = prn.Port Then
Call SpoolFile(Submit, prn.DeviceName)
Exit For
End If
Next prn
End Sub

' 确认系统中存在打印机
Private Sub Form_Initialize()
If Printers.Count = 0 Then
MsgBox "No printers are installed. Can't continue.", _
vbCritical, "Fatal Error"
End
End If
End Sub

' 初始化窗体
Private Sub Form_Load()
Dim prn As Printer

For Each prn In Printers
Combo1.AddItem prn.DeviceName & " on " & prn.Port
Next prn
SelectDefaultPrinter Combo1
txtFile = ""
End Sub