Binaryworld - How to change printer port using API ? ... [ VB -> Printing ]

Option Explicit

Private Type PRINTER_DEFAULTS
  pDatatype As String
  pDevMode As Long  'DEVMODE
  DesiredAccess As Long
End Type

Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Long, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Long, ByVal Command As Long) As Long
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 ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrcpy1 Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

Function GetPort(strPrinter As String) As String
  Dim hPrinter As Long
  Dim bBuffer() As Long
  Dim lngNeeded As Long
  Dim pdDefaults As PRINTER_DEFAULTS

  ReDim bBuffer(1)

  pdDefaults.DesiredAccess = PRINTER_ACCESS_USE
  pdDefaults.pDatatype = "RAW"
  pdDefaults.pDevMode = 0

  If OpenPrinter(strPrinter, hPrinter, pdDefaults) = 0 Then
    GetPort = ""
    Exit Function
  End If

  GetPrinter hPrinter, 2, bBuffer(0), 0, lngNeeded
  If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
    GetPort = ""
    ClosePrinter hPrinter
    Exit Function
  End If

  ReDim bBuffer((lngNeeded \ 4) + 1)
  If GetPrinter(hPrinter, 2, bBuffer(0), lngNeeded, lngNeeded) = 0 Then
    GetPort = ""
    ClosePrinter hPrinter
    Exit Function
  End If

  GetPort = PointerToString(bBuffer(3))
  ClosePrinter hPrinter
  Exit Function
End Function

Function ChangePort(strPrinter As String, strPort As String) As Boolean
  Dim hPrinter As Long
  Dim bBuffer() As Long  'This is a PRINTER_INFO_2 + the string area
  Dim lngNeeded As Long
  Dim pdDefaults As PRINTER_DEFAULTS

  ReDim bBuffer(1)

  pdDefaults.DesiredAccess = PRINTER_ALL_ACCESS
  pdDefaults.pDatatype = "RAW"
  pdDefaults.pDevMode = 0

  If OpenPrinter(strPrinter, hPrinter, pdDefaults) = 0 Then
    ChangePort = False
    Exit Function
  End If

  GetPrinter hPrinter, 2, bBuffer(0), 0, lngNeeded
  If Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER Then
    ChangePort = False
    ClosePrinter hPrinter
    Exit Function
  End If

  ReDim bBuffer((lngNeeded \ 4) + (Len(strPort) \ 2) + 2)
  If GetPrinter(hPrinter, 2, bBuffer(0), lngNeeded, lngNeeded) = 0 Then
    ChangePort = False
    ClosePrinter hPrinter
    Exit Function
  End If

  lstrcpy1 VarPtr(bBuffer((lngNeeded \ 4) + 1)), strPort
  bBuffer(3) = VarPtr(bBuffer((lngNeeded \ 4) + 1))

  If SetPrinter(hPrinter, 2, bBuffer(0), 0) = 0 Then
    ChangePort = False
    ClosePrinter hPrinter
    Exit Function
  End If

  ClosePrinter hPrinter
  ChangePort = True
  Exit Function
End Function

Function PointerToString(pString As Long) As String
  Dim sTemp As String * 512

  lstrcpy sTemp, pString
  If (InStr(1, sTemp, Chr(0)) = 0) Then
    PointerToString = ""
  Else
    PointerToString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
  End If
  Exit Function
End Function