API 读取打印机端口

cangou

我电脑有两个打印机，想要根据不同的内容自动更换打印机打印，其中有的打印机是在网络中，
使用 wshShell.RegRead 也是可以读取的，但是网络共享的打印机会出错网络打印机一般是：\\计算机名\打印机名，反正试了几次不行，改用API试试，
我使用API获取注册表中打印机的名称和端口，现在打印机的名称都是没问题了，端口如何取得呢？

cangou

没人的话，还是先顶一下吧

cangou

貌似没人呢，唉

邛海

同问，因为办公室各电脑经常增减打印机，同一打印机在不同电脑上的端口号变来变去，每次都要重新调整，很麻烦。
能不能用VBA自动测试出打印机端口号？
或者能不能选择打印机时不加端口号，避免因端口号变化而出错？

zhengrui-csb

好像这个谁较过我，忘了~
有一个什么方法不用选择就可以直接打印，我还经常要换内外网呢……

19811123lxys

我也非常想知道啊

小fisher

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Const PRINTER_ENUM_LOCAL = &H2
Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
Type PRINTER_INFO_5
        pPrinterName As Long
        pPortName As Long
        Attributes As Long
        DeviceNotSelectedTimeout As Long
        TransmissionRetryTimeout As Long
End Type

Sub ListPrinters()
    Dim PI(1 To 100) As PRINTER_INFO_5
    Dim n As Long
    Dim m As Long
    Dim i As Long
    Dim sPrinterName As String
    Dim sPortName As String
    If EnumPrinters(PRINTER_ENUM_LOCAL, "", 5, ByVal VarPtr(PI(1)), Len(PI(0)) * 100, n, m) <> 0 Then
        For i = 1 To m
            sPrinterName = Space(lstrlen(PI(i).pPrinterName))
            lstrcpy sPrinterName, PI(i).pPrinterName
            sPortName = Space(lstrlen(PI(i).pPortName))
            lstrcpy sPortName, PI(i).pPortName
            Debug.Print i, sPrinterName, sPortName
        Next
    End If
End Sub

zhengrui-csb

楼主，7楼高手的代码好用吗？

小fisher

这样应该行了：

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
          Alias "RegOpenKeyExA" _
          (ByVal hKey As Long, _
          ByVal lpSubKey As String, _
          ByVal ulOptions As Long, _
          ByVal samDesired As Long, phkResult As Long) As Long

      Private Declare Function RegEnumValue Lib "advapi32.dll" _
          Alias "RegEnumValueA" _
          (ByVal hKey As Long, _
          ByVal dwIndex As Long, _
          ByVal lpValueName As String, _
          lpcbValueName As Long, _
          ByVal lpReserved As Long, _
          lpType As Long, _
          lpData As Long, _
          lpcbData As Long) As Long

      Private Declare Function RegCloseKey Lib "advapi32.dll" _
          (ByVal hKey As Long) As Long

      Const HKEY_CLASSES_ROOT = &H80000000
      Const HKEY_CURRENT_USER = &H80000001
      Const HKEY_LOCAL_MACHINE = &H80000002
      Const HKEY_USERS = &H80000003

      Const ERROR_SUCCESS = 0&

      Const SYNCHRONIZE = &H100000
      Const STANDARD_RIGHTS_READ = &H20000
      Const STANDARD_RIGHTS_WRITE = &H20000
      Const STANDARD_RIGHTS_EXECUTE = &H20000
      Const STANDARD_RIGHTS_REQUIRED = &HF0000
      Const STANDARD_RIGHTS_ALL = &H1F0000
      Const KEY_QUERY_VALUE = &H1
      Const KEY_SET_VALUE = &H2
      Const KEY_CREATE_SUB_KEY = &H4
      Const KEY_ENUMERATE_SUB_KEYS = &H8
      Const KEY_NOTIFY = &H10
      Const KEY_CREATE_LINK = &H20
      Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                        KEY_QUERY_VALUE Or _
                        KEY_ENUMERATE_SUB_KEYS Or _
                        KEY_NOTIFY) And _
                        (Not SYNCHRONIZE))

      Const REG_DWORD = 4
      Const REG_BINARY = 3
      Const REG_SZ = 1




      Private Sub Command1_Click()
         Dim lngKeyHandle As Long
         Dim lngResult As Long
         Dim lngCurIdx As Long
         Dim strValue As String
         Dim bytData(1 To 200) As Byte
         Dim lngValueLen As Long
         Dim lngData As Long
         Dim lngDataLen As Long
         Dim strResult As String
         Dim strData As String
         
         lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, _
                 "Software\Microsoft\Windows NT\CurrentVersion\Devices\", _
                  0&, _
                  KEY_READ, _
                  lngKeyHandle)

         If lngResult <> ERROR_SUCCESS Then
             MsgBox "Cannot open key"
             Exit Sub
         End If

         lngCurIdx = 0
         Do
            lngValueLen = 2000
            strValue = String(lngValueLen, 0)
            lngDataLen = 200
            strData = Space(200)
            lngResult = RegEnumValue(lngKeyHandle, _
                                     lngCurIdx, _
                                     ByVal strValue, _
                                     lngValueLen, _
                                     0&, _
                                     REG_DWORD, _
                                     ByVal StrPtr(strData), _
                                     lngDataLen)

            lngCurIdx = lngCurIdx + 1

         If lngResult = ERROR_SUCCESS Then
            strResult = Replace(strValue, Chr(0), "")
            strData = Left(StrConv(strData, vbUnicode), lngDataLen - 1)
            strData = Mid(strData, InStr(strData, ",") + 1)
            MsgBox strResult & " 在 " & strData
         End If

         Loop While lngResult = ERROR_SUCCESS
         Call RegCloseKey(lngKeyHandle)
      End Sub

goldowl2011

Thanks  a lot.Good codes.