Printer Select Dialog Form -- Part 2B

'----------------------------------------------------------------------------------------
' Procedure : SetPrinterProperty
' Date      : 18 May 2003
' Author    : Cassandra Roads, P. Eng.
' Copyright (c) 2003[b]Continued from Part 2 -- mdlPrinterAccess.bas[/b]
[code]
'----------------------------------------------------------------------------------------
' Procedure : SetPrinterProperty
' Date      : 18 May 2003
' Author    : Cassandra Roads, P. Eng.
' Copyright (c) 2003 Professional Logics Corporation
'----------------------------------------------------------------------------------------
'
Public Function SetPrinterProperty(ByVal strPrinterName As String, _
        ByVal intPropertyType As Integer, ByVal intPropertyValue As Integer) As Boolean
    '
    '   Code adapted from Microsoft KnowledgeBase article Q230743.
    '
    '   Obtain a handle to the selected printer.
    '   If we did not get the handle, then baile out, doing nothing.
    '   Get the size of the DEVMODE structure to be loaded.
    '   Redimension the byte array to receive DEVMODE structure.  Add some
    '               leeway space, in case the printer driver lied about the DEVMODE size.
    '   Load the byte array from the printer driver.
    '   Copy the byte array into a structure so it can be manipulated.
    '   Set the indicated property to the desired value.
    '   Store the structure back into the byte array.
    '   Tell the printer about the updated property.
    '*******
    '*  Handler for some Postscript printers, which do not respond properly to
    '*      the above code.
    '*  Set the byte array large enough for PRINTER_INFO_2 structure.
    '*  Load the PRINTER_INFO_2 structure into a byte array.
    '*  Copy the byte array into the structured type.
    '*  Load the DEVMODE structure with the byte array containing the new property value.
    '*  Set the security descriptor to NULL.
    '*  Copy the PRINTER_INFO_2 structure back into the byte array.
    '*  Send the new details to the printer.
    '*******
    '   Indicate whether it all worked or not.
    '   Release the printer handle.
    '   Flush the system's message queue.
    '   Exit.
    '------------------------------------------------------------------------------------
    '
    Dim I As Integer
    Dim lngDummy As Long
    Dim blnBailOut As Boolean
    Dim hPrinter As Long
    Dim udtPD As PRINTER_DEFAULTS
    Dim udtPrinterInfo As PRINTER_INFO_2
    Dim udtDM As DEVMODE
    Dim lngBytesNeeded As Long
    Dim lngRet As Long
    
    '   Byte array to hold contents of DEVMODE structure.
    Dim bytDevModeData() As Byte
    '   Byte array to hold contents of PRINTER_INFO_2 structure
    Dim bytPrinterInfoMemory() As Byte
    
    On Error GoTo SetPrinterProperty_Error
    '
    '   Obtain a handle to the selected printer.
    '
    udtPD.DesiredAccess = PRINTER_NORMAL_ACCESS
    lngRet = OpenPrinter(strPrinterName, hPrinter, udtPD)
    '
    '   Can't access current printer. Bail out doing nothing
    '
    SetPrinterProperty = False
    If (lngRet = 0) Or (hPrinter = 0) Then Exit Function
    '
    '   Get the size of the DEVMODE structure to be loaded.
    '
    blnBailOut = False
    lngRet = DocumentProperties(0, hPrinter, strPrinterName, 0, 0, 0)
    If (lngRet < 0) Then
        blnBailOut = True
    Else
        '
        '   Redimension the byte array to receive DEVMODE structure.  Add some
        '   leeway space, in case the printer driver lied about the DEVMODE size.
        '
        ReDim bytDevModeData(0 To lngRet + 128) As Byte
        '
        '   Load the byte array from the printer driver.
        '
        lngRet = DocumentProperties(0, hPrinter, strPrinterName, _
                    VarPtr(bytDevModeData(0)), 0, DM_OUT_BUFFER)
        If (lngRet >= 0) Then
            '
            '   Copy the byte array into a structure so it can be manipulated.
            '
            Call CopyMemory(udtDM, bytDevModeData(0), Len(udtDM))
        
            If (udtDM.dmFields And intPropertyType) <> 0 Then
                '
                '   Set the indicated property to the desired value.
                '
                Select Case intPropertyType
                    Case DM_ORIENTATION
                        udtDM.dmOrientation = intPropertyValue
                    Case DM_PAPERSIZE
                        udtDM.dmPaperSize = intPropertyValue
                    Case DM_PAPERLENGTH
                        udtDM.dmPaperLength = intPropertyValue
                    Case DM_PAPERWIDTH
                        udtDM.dmPaperWidth = intPropertyValue
                    Case DM_DEFAULTSOURCE
                        udtDM.dmDefaultSource = intPropertyValue
                    Case DM_PRINTQUALITY
                        udtDM.dmPrintQuality = intPropertyValue
                    Case DM_COLOR
                        udtDM.dmColor = intPropertyValue
                End Select
                '
                '   Store the structure back into the byte array.
                '
                Call CopyMemory(bytDevModeData(0), udtDM, Len(udtDM))
            End If
        End If
    End If
    '
    If Not blnBailOut Then
        '
        '   Tell the printer about the updated property.
        '
        lngRet = DocumentProperties(0, hPrinter, strPrinterName, _
                VarPtr(bytDevModeData(0)), VarPtr(bytDevModeData(0)), _
                DM_IN_BUFFER Or DM_OUT_BUFFER)
        If (lngRet >= 0) Then
            '*
            '*  Handler for some Postscript printers, which do not respond properly to
            '*      the above code.
            '*
            Call GetPrinter(hPrinter, 2, 0, 0, lngBytesNeeded)
            If (lngBytesNeeded <> 0) Then
                '*
                '*  Set the byte array large enough for PRINTER_INFO_2 structure.
                '*
                ReDim bytPrinterInfoMemory(0 To lngBytesNeeded + 128)
                '*
                '*  Load the PRINTER_INFO_2 structure into a byte array.
                '*
                lngRet = GetPrinter(hPrinter, 2, bytPrinterInfoMemory(0), _
                        lngBytesNeeded, lngDummy)
                If (lngRet <> 0) Then
                    '*
                    '*  Copy the byte array into the structured type.
                    '*
                    Call CopyMemory(udtPrinterInfo, bytPrinterInfoMemory(0), _
                            Len(udtPrinterInfo))
                    '*
                    '*  Load the DEVMODE structure with the byte array containing
                    '*  the new property value.
                    '*
                    udtPrinterInfo.pDevMode = VarPtr(bytDevModeData(0))
                    '*
                    '*  Set the security descriptor to NULL.
                    '*
                    udtPrinterInfo.pSecurityDescriptor = 0
                    '*
                    '*  Copy the PRINTER_INFO_2 structure back into the byte array.
                    '*
                    Call CopyMemory(bytPrinterInfoMemory(0), udtPrinterInfo, _
                            Len(udtPrinterInfo))
                    '*
                    '*  Send the new details to the printer.
                    '*
                    lngRet = SetPrinter(hPrinter, 2, bytPrinterInfoMemory(0), 0)
                    '
                    '   Indicate whether it all worked or not.
                    '
                    SetPrinterProperty = Not CBool(lngRet)
                End If
            End If
        End If
    End If
    On Error GoTo 0
    '
    '   Release the printer handle.
    '
    If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)
    '
    '   Flush the system's message queue.
    '
    For I = 1 To 20
        DoEvents
    Next I
    Exit Function

SetPrinterProperty_Error:
    Debug.Print "mdlPrinterAccess : SetPrinterProperty :: " & Err.Number & " : " & _
            Err.Description
    Err.Clear
    On Error GoTo 0
    If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)
    For I = 1 To 20
        DoEvents
    Next I
    SetPrinterProperty = True
End Function
'
'----------------------------------------------------------------------------------------
'

'----------------------------------------------------------------------------------------
' Procedure : GetPrinterStati
' Date      : 18 May 2003
' Author    : Cassandra Roads, P. Eng.
' Copyright (c) 2003 Professional Logics Corporation
'----------------------------------------------------------------------------------------
'
Public Function GetPrinterStati(ByVal strPrinterName As String, _
        ByRef strPrinterType As String, ByRef strPrinterStatus As String, _
        ByRef strPortName As String, ByRef strComment As String) As Boolean
    '
    '   Set up the error handler.
    '   Preset the return values.
    '   Obtain a handle to the selected printer.
    '   If we could not access the selected printer. Bail out, doing nothing.
    '   Determine the number of bytes needed in our PrinterInfo2 structure.
    '   If we need any bytes (structure exists), then
    '       Resize the byte array to recieve the PrinterInfo2 structure.
    '       Obtain the PrinterInfo2 structure from the printer driver.
    '       Copy the PrinterInfo2 structure into the PrinterInfo variable.
    '       Extract the stati from the PrinterInfo variable and pass them back to
    '               the caller.
    '   Indicate that the requested stati were retrieved.
    '   Exit.
    '------------------------------------------------------------------------------------
    '
        Dim hPrinter As Long, lngBytesNeeded As Long, bytPrinterInfoMemory() As Byte
        Dim lngRet As Long, lngDummy As Long, udtPrinterInfo As PRINTER_INFO_2
        Dim udtPrinterDefaults As PRINTER_DEFAULTS
        
        GetPrinterStati = False
        On Error GoTo GetPrinterStati_Error
        strPrinterStatus = ""
        strPortName = ""
        strComment = ""
        '
        '   Obtain a handle to the selected printer.
        '
        udtPrinterDefaults.DesiredAccess = PRINTER_NORMAL_ACCESS
        lngRet = OpenPrinter(strPrinterName, hPrinter, udtPrinterDefaults)
        '
        '   If we could not access the selected printer. Bail out, doing nothing.
        '
        If (lngRet = 0) Or (hPrinter = 0) Then Exit Function
        '
        '   Determine the number of bytes needed in our PrinterInfo2 structure.
        '
        Call GetPrinter(hPrinter, 2, 0, 0, lngBytesNeeded)
        If lngBytesNeeded <> 0 Then
            '
            '   Resize the byte array to recieve the PrinterInfo2 structure.
            '
            ReDim bytPrinterInfoMemory(0 To lngBytesNeeded + 128)
            '
            '   Obtain the PrinterInfo2 structure from the printer driver.
            '
            lngRet = GetPrinter(hPrinter, 2, bytPrinterInfoMemory(0), lngBytesNeeded, _
                    lngDummy)
            If lngRet <> 0 Then
                '
                '   Copy the PrinterInfo2 structure into the PrinterInfo variable.
                '
                Call CopyMemory(udtPrinterInfo, bytPrinterInfoMemory(0), _
                        Len(udtPrinterInfo))
                '
                '   Extract the stati from the PrinterInfo variable and pass them
                '   back to the caller.
                '
                strPortName = DerefStringPointer(udtPrinterInfo.pPortName, 128)
                strComment = DerefStringPointer(udtPrinterInfo.pComment, 128)
                strPrinterType = DerefStringPointer(udtPrinterInfo.pPrinterName, 128)
'Catch22
'   To retrieve the status from the printer, the printer needs to be printing.
                Call ParsePrinterStatus(strPrinterStatus, udtPrinterInfo.Status)
            End If
        End If
        '
        '   Indicate that the requested stati were retrieved.
        '
        GetPrinterStati = True
        On Error GoTo 0
        Exit Function
        
GetPrinterStati_Error:
        Debug.Print "mdlPrinterAccess : GetPrinterStati :: " & Err.Number & " : " & _
                Err.Description
        Err.Clear
        On Error GoTo 0
        GetPrinterStati = False
End Function
'
'----------------------------------------------------------------------------------------
'