【VB声明】
  Private Declare Function AddMonitor Lib "winspool.drv" Alias "AddMonitorA" (ByVal pName As String, ByVal Level As Long, pMonitors As Byte) As Long【别名】
  AddMonitorA【说明】
  为系统添加一个打印机监视器 【返回值】
  Long,非零表示成功,零表示失败。会设置GetLastError 【参数表】
  pName ----------  String,欲在其中安装监视器的一个服务器的名字。对于本地(本机)监视器,请设置成vbNullString  Level ----------  Long,设为2  pMonitors ------  Byte,指定一个结构中的第一个字节。那个结构又包含了一个MONITOR_INFO_2结构

解决方案 »

  1.   

    'Code generously provided by Merrion Computing
    'Visit their website at http://www.merrioncomputing.com/
    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 Integer
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
    End Type
    Private Type PRINTER_INFO_2
       pServerName As String
       pPrinterName As String
       pShareName As String
       pPortName As String
       pDriverName As String
       pComment As String
       pLocation As String
       pDevMode As Long
       pSepFile As String
       pPrintProcessor As String
       pDatatype As String
       pParameters As String
       pSecurityDescriptor As Long
       Attributes As Long
       Priority As Long
       DefaultPriority As Long
       StartTime As Long
       UntilTime As Long
       Status As Long
       JobsCount As Long
       AveragePPM As Long
    End Type
    Private Type PRINTER_DEFAULTS
      pDatatype As String
      pDevMode As DEVMODE
      DesiredAccess As Long
    End Type
    Public Enum Printer_Status
       PRINTER_STATUS_READY = &H0
       PRINTER_STATUS_PAUSED = &H1
       PRINTER_STATUS_ERROR = &H2
       PRINTER_STATUS_PENDING_DELETION = &H4
       PRINTER_STATUS_PAPER_JAM = &H8
       PRINTER_STATUS_PAPER_OUT = &H10
       PRINTER_STATUS_MANUAL_FEED = &H20
       PRINTER_STATUS_PAPER_PROBLEM = &H40
       PRINTER_STATUS_OFFLINE = &H80
       PRINTER_STATUS_IO_ACTIVE = &H100
       PRINTER_STATUS_BUSY = &H200
       PRINTER_STATUS_PRINTING = &H400
       PRINTER_STATUS_OUTPUT_BIN_FULL = &H800
       PRINTER_STATUS_NOT_AVAILABLE = &H1000
       PRINTER_STATUS_WAITING = &H2000
       PRINTER_STATUS_PROCESSING = &H4000
       PRINTER_STATUS_INITIALIZING = &H8000
       PRINTER_STATUS_WARMING_UP = &H10000
       PRINTER_STATUS_TONER_LOW = &H20000
       PRINTER_STATUS_NO_TONER = &H40000
       PRINTER_STATUS_PAGE_PUNT = &H80000
       PRINTER_STATUS_USER_INTERVENTION = &H100000
       PRINTER_STATUS_OUT_OF_MEMORY = &H200000
       PRINTER_STATUS_DOOR_OPEN = &H400000
       PRINTER_STATUS_SERVER_UNKNOWN = &H800000
       PRINTER_STATUS_POWER_SAVE = &H1000000
    End Enum
    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 GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long
    Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
    Public 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 IsBadStringPtrByLong(lpString, lMaxLength) Then
            ' An error has occured - do not attempt to use this pointer
            StringFromPointer = ""
            Exit Function
        End If
        ' Pre-initialise the return string...
        sRet = Space$(lMaxLength)
        CopyMemory ByVal sRet, ByVal lpString, ByVal Len(sRet)
        If Err.LastDllError = 0 Then
            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 Form_Load()
        Dim SizeNeeded As Long, buffer() As Long
        Dim pDef As PRINTER_DEFAULTS
        'Get a handle to the printer
        lret = OpenPrinter(Printer.DeviceName, mhPrinter, pDef)
        'Initialize the buffer
        ReDim Preserve buffer(0 To 0) As Long
        'Retrieve the required size (in bytes)
        lret = GetPrinter(mhPrinter, 2, buffer(0), UBound(buffer), SizeNeeded)
        'Resize the buffer... Note that a Long is four bytes
        ReDim Preserve buffer(0 To (SizeNeeded / 4) + 3) As Long
        'Retrieve the Printer information
        lret = GetPrinter(mhPrinter, 2, buffer(0), UBound(buffer) * 4, SizeNeeded)
        'The data stored in 'buffer' corresponds with the data of a PRINTER_INFO_2 structure
        ClosePrinter mhPrinter
        'Show the data
        PrintData "Server name", StringFromPointer(buffer(0), 255)
        PrintData "Printer name", StringFromPointer(buffer(1), 255)
        PrintData "Share name", StringFromPointer(buffer(2), 255)
        PrintData "Port name", StringFromPointer(buffer(3), 255)
        PrintData "Driver name", StringFromPointer(buffer(4), 255)
        PrintData "Comment", StringFromPointer(buffer(5), 255)
        PrintData "Location", StringFromPointer(buffer(6), 255)
        Unload Me
    End Sub
    Sub PrintData(Name As String, Data As String)
        If LenB(Data) > 0 Then
            Debug.Print Name + ": " + Data
        End If
    End Sub