又一例利用Visual Basic检测打印机状态的代码

在一个模块中粘贴如下代码:  
  Option   Explicit  
  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   GetPrinter   Lib   "winspool.drv"   Alias   "GetPrinterA"   _  
  (ByVal   hPrinter   As   Long,   _  
  ByVal   Level   As   Long,   _  
  pPrinter   As   Byte,   _  
  ByVal   cbBuf   As   Long,   _  
  pcbNeeded   As   Long)   _  
  As   Long  
   
  Public   Declare   Function   ClosePrinter   Lib   "winspool.drv"   _  
  (ByVal   hPrinter   As   Long)   _  
  As   Long  
   
  Public   Declare   Sub   CopyMemory   Lib   "kernel32"   Alias   "RtlMoveMemory"   _  
  (Destination   As   Any,   _  
  Source   As   Any,   _  
  ByVal   Length   As   Long)  
   
  'PRINTER_DEFAULTS打印机常量
  Public   Const   STANDARD_RIGHTS_REQUIRED   =   &HF0000  
  Public   Const   PRINTER_ACCESS_ADMINISTER   =   &H4  
  Public   Const   PRINTER_ACCESS_USE   =   &H8  
  Public   Const   PRINTER_ALL_ACCESS   =   (STANDARD_RIGHTS_REQUIRED   Or   _  
  PRINTER_ACCESS_ADMINISTER   Or   PRINTER_ACCESS_USE)  
   
  '   constants   for   DEVMODE   structure  
  Public   Const   CCHDEVICENAME   =   32  
  Public   Const   CCHFORMNAME   =   32  
   
  Public   Type   PRINTER_DEFAULTS  
  pDatatype   As   String  
  pDevMode   As   Long  
  DesiredAccess   As   Long  
  End   Type  
   
  Type   PRINTER_INFO_2  
  pServerName   As   Long  
  pPrinterName   As   Long  
  pShareName   As   Long  
  pPortName   As   Long  
  pDriverName   As   Long  
  pComment   As   Long  
  pLocation   As   Long  
  pDevMode   As   Long  
  pSepFile   As   Long  
  pPrintProcessor   As   Long  
  pDatatype   As   Long  
  pParameters   As   Long  
  pSecurityDescriptor   As   Long  
  Attributes   As   Long  
  Priority   As   Long  
  DefaultPriority   As   Long  
  StartTime   As   Long  
  UntilTime   As   Long  
  Status   As   Long  
  cJobs   As   Long  
  AveragePPM   As   Long  
  End   Type  
   
  Public   Const   ERROR_INSUFFICIENT_BUFFER   =   122  
  Public   Const   PRINTER_STATUS_BUSY   =   &H200  
  Public   Const   PRINTER_STATUS_DOOR_OPEN   =   &H400000  
  Public   Const   PRINTER_STATUS_ERROR   =   &H2  
  Public   Const   PRINTER_STATUS_INITIALIZING   =   &H8000  
  Public   Const   PRINTER_STATUS_IO_ACTIVE   =   &H100  
  Public   Const   PRINTER_STATUS_MANUAL_FEED   =   &H20  
  Public   Const   PRINTER_STATUS_NO_TONER   =   &H40000  
  Public   Const   PRINTER_STATUS_NOT_AVAILABLE   =   &H1000  
  Public   Const   PRINTER_STATUS_OFFLINE   =   &H80  
  Public   Const   PRINTER_STATUS_OUT_OF_MEMORY   =   &H200000  
  Public   Const   PRINTER_STATUS_OUTPUT_BIN_FULL   =   &H800  
  Public   Const   PRINTER_STATUS_PAGE_PUNT   =   &H80000  
  Public   Const   PRINTER_STATUS_PAPER_JAM   =   &H8  
  Public   Const   PRINTER_STATUS_PAPER_OUT   =   &H10  
  Public   Const   PRINTER_STATUS_PAPER_PROBLEM   =   &H40  
  Public   Const   PRINTER_STATUS_PAUSED   =   &H1  
  Public   Const   PRINTER_STATUS_PENDING_DELETION   =   &H4  
  Public   Const   PRINTER_STATUS_PRINTING   =   &H400  
  Public   Const   PRINTER_STATUS_PROCESSING   =   &H4000  
  Public   Const   PRINTER_STATUS_TONER_LOW   =   &H20000  
  Public   Const   PRINTER_STATUS_USER_INTERVENTION   =   &H100000  
  Public   Const   PRINTER_STATUS_WAITING   =   &H2000  
  Public   Const   PRINTER_STATUS_WARMING_UP   =   &H10000  
   
   
  Function   CheckPrinterStatus(PrinterName   As   String)   As   String   
  Dim   hPrinter   As   Long  
  Dim   ByteBuf   As   Long,   BytesNeeded   As   Long  
  Dim   PI2   As   PRINTER_INFO_2   
  Dim   PrinterInfo()   As   Byte   
  Dim   result   As   Long,   LastError   As   Long  
  Dim   PrinterName   As   String,   tempStr   As   String  
  Dim   NumJI2   As   Long  
  Dim   pDefaults   As   PRINTER_DEFAULTS  
   
  CheckPrinterStatus   =   ""  
   
  pDefaults.DesiredAccess   =   PRINTER_ALL_ACCESS  
   
  'Call   API   to   get   a   handle   to   the   printer  
  result   =   OpenPrinter(PrinterName,   hPrinter,   pDefaults)  
  If   result   =   0   Then  
  'If   an   error   occured,   display   an   error   and   exit   sub  
  MsgBox   "Cannot   open   printer   "   &   PrinterName   &   ",   Error:   "   _  
  &   Err.LastDllError  
  Exit   Function  
  End   If  
   
  'Init   BytesNeeded  
  BytesNeeded   =   0  
   
  'Clear   the   error   object   of   any   errors  
  Err.Clear  
   
  'Determine   the   buffer   size   needed   to   get   printer   info  
  result   =   GetPrinter(hPrinter,   2,   0&,   0&,   BytesNeeded)  
   
  'Check   for   error   calling   GetPrinter  
  If   Err.LastDllError   <>   ERROR_INSUFFICIENT_BUFFER   Then  
  ClosePrinter   hPrinter  
  Exit   Function  
  End   If  
   
  'Due   to   a   problem   with   GetPrinter,   we   must   allocate   a   buffer   as  
  'much   as   3   times   larger   than   the   value   returned   by   the   initial  
  'call   to   GetPrinter.  
  ReDim   PrinterInfo(1   To   BytesNeeded   *   3)  
   
  ByteBuf   =   BytesNeeded  
   
  'Call   GetPrinter   to   get   the   status  
  result   =   GetPrinter(hPrinter,   2,   PrinterInfo(1),   ByteBuf,   _  
  BytesNeeded   *   3)  
   
  'Check   for   errors  
  If   result   =   0   Then  
  'Determine   the   error   that   occured  
  LastError   =   Err.LastDllError()  
  ClosePrinter   hPrinter  
  Exit   Function  
  End   If  
   
  'Copy   contents   of   printer   status   byte   array   into   a  
  'PRINTER_INFO_2   structure   to   separate   the   individual   elements  
  CopyMemory   PI2,   PrinterInfo(1),   Len(PI2)  
   
  'Check   if   printer   is   in   ready   state  
  If   PI2.Status   =   0   Then  
  CheckPrinterStatus   =   "Ready"  
  Else  
  CheckPrinterStatus   =   PI2.Status  
  End   If  
   
  'Close   the   printer   handle  
  ClosePrinter   hPrinter  
  End   Function

HOW TO: Determine Printer Status and Print Job Status from Visual Basic

Tags:visual basic  打印  状态  代码  

0 Comment so far



Leave a reply