以下程序可供参考:
Option Explicit
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" ( _
ByVal hPrinter As Long) As Long
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As LongPrivate Const DC_PAPERNAMES = 16 ' Value obtained from wingdi.hSub GetPaperList()
' Display a message box with the name of the active printer and a list
' of papers it supports. Dim lPaperCount As Long
Dim lCounter As Long
Dim hPrinter As Long
Dim sDeviceName As String
Dim sDevicePort As String
Dim sPaperNamesList As String
Dim sNextString As String
Dim sTextString As String
Dim iNumPaper() As Integer
GetPrinterNameAndPort sDeviceName, sDevicePort
If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then ' Get count of paper names supported by active printer.
lPaperCount = DeviceCapabilities(sDeviceName, _
sDevicePort, _
DC_PAPERNAMES, _
ByVal vbNullString, 0)
ReDim iNumPaper(1 To lPaperCount)
sPaperNamesList = String(64 * lPaperCount, 0) ' Get paper names supported by active printer.
lPaperCount = DeviceCapabilities(sDeviceName, _
sDevicePort, _
DC_PAPERNAMES, _
ByVal sPaperNamesList, 0)
' List available paper names.
sTextString = "Paper available for " & ActivePrinter
For lCounter = 1 To lPaperCount
' Get a paper name.
sNextString = Mid(sPaperNamesList, _
64 * (lCounter - 1) + 1, 64)
sNextString = Left(sNextString, _
InStr(1, sNextString, Chr(0)) - 1) ' Have one paper name.
sNextString = String(6 - Len(CStr(iNumPaper(lCounter))), _
" ") & sNextString
' Add paper name to text string for message box.
sTextString = sTextString & Chr(13) & sNextString
Next lCounter
ClosePrinter (hPrinter)
' Show paper names in message box.
MsgBox sTextString
Else
MsgBox ActivePrinter & " <Unavailable>"
End IfEnd SubPrivate Sub GetPrinterNameAndPort(printerName As String, _
printerPort As String)
' ActivePrinter yields a name of the form "Printer XYZ on LPT1" while the
' DeviceCapabilities function requires a printer name and port.
'
' Out:
' printerName Printer name derived from ActivePrinter property
' printerPort Printer port derived from ActivePrinter property Dim sString As String
Const searchText As String = " on "
sString = ActivePrinter
printerName = Left(sString, InStr(1, sString, searchText) - 1)
printerPort = Right(sString, _
Len(sString) - Len(printerName) - Len(searchText))End Sub
Option ExplicitPrivate Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As LongPrivate Const DC_BINS = 6
Private Const DC_BINNAMES = 12Private Sub Command1_Click()
Dim prn As Printer
Dim dwbins As Long
Dim ct As Long
Dim nameslist As String
Dim nextString As String
Dim numBin() As Integer Text1.Font.Name = "Courier New"
Text1.Font.Size = 12
Text1.Text = ""
For Each prn In Printers
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINS, ByVal vbNullString, 0)
ReDim numBin(1 To dwbins)
nameslist = String(24 * dwbins, 0)
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINS, numBin(1), 0)
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINNAMES, ByVal nameslist, 0)
If Text1.Text <> "" Then
Text1.Text = Text1.Text & vbCrLf & vbCrLf
End If
Text1.Text = Text1.Text & prn.DeviceName
For ct = 1 To dwbins
nextString = Mid(nameslist, 24 * (ct - 1) + 1, 24)
nextString = Left(nextString, InStr(1, nextString, _
Chr(0)) - 1)
nextString = String(6 - Len(CStr(numBin(ct))), " ") & _
numBin(ct) & " " & nextString
Text1.Text = Text1.Text & vbCrLf & nextString
Next ct
Next prn
End SubPrivate Sub Form_Load()
' Size and position the Form and controls
Me.Height = 7000
Me.Width = 7000
Text1.Top = 100
Text1.Left = 100
Text1.Height = 6450
Text1.Width = 5000
Text1.Text = "" ' Clear the TextBox
Command1.Left = 5300
Command1.Top = 1000
Command1.Width = 1500
Command1.Caption = "List Bins"
End Sub
****************************************************************
Welcome to www.easthot.net (Programer's web)
****************************************************************
Option Explicit
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
ByVal pDefault As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" ( _
ByVal hPrinter As Long) As Long
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As LongPrivate Const DC_PAPERNAMES = 16 ' Value obtained from wingdi.hSub GetPaperList()
' Display a message box with the name of the active printer and a list
' of papers it supports. Dim lPaperCount As Long
Dim lCounter As Long
Dim hPrinter As Long
Dim sDeviceName As String
Dim sDevicePort As String
Dim sPaperNamesList As String
Dim sNextString As String
Dim sTextString As String
Dim iNumPaper() As Integer
GetPrinterNameAndPort sDeviceName, sDevicePort
If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then ' Get count of paper names supported by active printer.
lPaperCount = DeviceCapabilities(sDeviceName, _
sDevicePort, _
DC_PAPERNAMES, _
ByVal vbNullString, 0)
ReDim iNumPaper(1 To lPaperCount)
sPaperNamesList = String(64 * lPaperCount, 0) ' Get paper names supported by active printer.
lPaperCount = DeviceCapabilities(sDeviceName, _
sDevicePort, _
DC_PAPERNAMES, _
ByVal sPaperNamesList, 0)
' List available paper names.
sTextString = "Paper available for " & ActivePrinter
For lCounter = 1 To lPaperCount
' Get a paper name.
sNextString = Mid(sPaperNamesList, _
64 * (lCounter - 1) + 1, 64)
sNextString = Left(sNextString, _
InStr(1, sNextString, Chr(0)) - 1) ' Have one paper name.
sNextString = String(6 - Len(CStr(iNumPaper(lCounter))), _
" ") & sNextString
' Add paper name to text string for message box.
sTextString = sTextString & Chr(13) & sNextString
Next lCounter
ClosePrinter (hPrinter)
' Show paper names in message box.
MsgBox sTextString
Else
MsgBox ActivePrinter & " <Unavailable>"
End IfEnd SubPrivate Sub GetPrinterNameAndPort(printerName As String, _
printerPort As String)
' ActivePrinter yields a name of the form "Printer XYZ on LPT1" while the
' DeviceCapabilities function requires a printer name and port.
'
' Out:
' printerName Printer name derived from ActivePrinter property
' printerPort Printer port derived from ActivePrinter property Dim sString As String
Const searchText As String = " on "
sString = ActivePrinter
printerName = Left(sString, InStr(1, sString, searchText) - 1)
printerPort = Right(sString, _
Len(sString) - Len(printerName) - Len(searchText))End Sub
Option ExplicitPrivate Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As LongPrivate Const DC_BINS = 6
Private Const DC_BINNAMES = 12Private Sub Command1_Click()
Dim prn As Printer
Dim dwbins As Long
Dim ct As Long
Dim nameslist As String
Dim nextString As String
Dim numBin() As Integer Text1.Font.Name = "Courier New"
Text1.Font.Size = 12
Text1.Text = ""
For Each prn In Printers
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINS, ByVal vbNullString, 0)
ReDim numBin(1 To dwbins)
nameslist = String(24 * dwbins, 0)
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINS, numBin(1), 0)
dwbins = DeviceCapabilities(prn.DeviceName, prn.Port, _
DC_BINNAMES, ByVal nameslist, 0)
If Text1.Text <> "" Then
Text1.Text = Text1.Text & vbCrLf & vbCrLf
End If
Text1.Text = Text1.Text & prn.DeviceName
For ct = 1 To dwbins
nextString = Mid(nameslist, 24 * (ct - 1) + 1, 24)
nextString = Left(nextString, InStr(1, nextString, _
Chr(0)) - 1)
nextString = String(6 - Len(CStr(numBin(ct))), " ") & _
numBin(ct) & " " & nextString
Text1.Text = Text1.Text & vbCrLf & nextString
Next ct
Next prn
End SubPrivate Sub Form_Load()
' Size and position the Form and controls
Me.Height = 7000
Me.Width = 7000
Text1.Top = 100
Text1.Left = 100
Text1.Height = 6450
Text1.Width = 5000
Text1.Text = "" ' Clear the TextBox
Command1.Left = 5300
Command1.Top = 1000
Command1.Width = 1500
Command1.Caption = "List Bins"
End Sub
****************************************************************
Welcome to www.easthot.net (Programer's web)
****************************************************************
VB中如何侦测LTP1端口的状态