VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPrinters"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Const HWND_BROADCAST = &HFFFF
Const WM_WININICHANGE = &H1A

'For DEVMODE structure.
Const CCHDEVICENAME = 32
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
     dmLogPixels As Integer
     dmBitsPerPel As Long
     dmPelsWidth As Long
     dmPelsHeight As Long
     dmDisplayFlags As Long
     dmDisplayFrequency As Long
     dmICMMethod As Long        ' // Windows 95 only
     dmICMIntent As Long        ' // Windows 95 only
     dmMediaType As Long        ' // Windows 95 only
     dmDitherType As Long       ' // Windows 95 only
     dmReserved1 As Long        ' // Windows 95 only
     dmReserved2 As Long        ' // Windows 95 only
End Type

'For printer info.
Const PRINTER_ATTRIBUTE_DEFAULT = 4
Private Type PRINTER_INFO_5
     pPrinterName As String
     pPortName As String
     Attributes As Long
     DeviceNotSelectedTimeout As Long
     TransmissionRetryTimeout As Long
End Type
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const PRINTER_ACCESS_ADMINISTER = &H4
Const PRINTER_ACCESS_USE = &H8
Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                            PRINTER_ACCESS_ADMINISTER Or _
                            PRINTER_ACCESS_USE)
Private Type PRINTER_DEFAULTS
     pDatatype As Long
     pDevMode As Long
     DesiredAccess As Long
End Type

'For os version.
Private Const VER_PLATFORM_WIN32_WINDOWS = 1 'For dwPlatformID
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

'Private property variables.
Private mvarDefaultPrinter As String 'local copy

'API declares.
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As String) As Long
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
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 SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Public Property Let DefaultPrinter(ByVal vData As String)

    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer

    osinfo.dwOSVersionInfoSize = 148
    osinfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(osinfo)

    'Set default printer depending on operating system.
    'Assumes future versions of Windows use the NT method.
    If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
        If Win95SetDefaultPrinter(vData) Then
            mvarDefaultPrinter = vData
        End If
    Else
        If WinNTSetDefaultPrinter(vData) Then
            mvarDefaultPrinter = vData
        End If
    End If

End Property

Public Property Get DefaultPrinter() As String
    
    Dim lResult As Long
    Dim sBuffer As String
    
    ' Get list of printers from Win.ini or registry.
    sBuffer = Space$(8192)
    lResult = GetProfileString("windows", "Device", "", _
                               sBuffer, Len(sBuffer))

    'Trim extra spaces.
    sBuffer = Left$(sBuffer, lResult)
    
    'Get printer name from string.
    mvarDefaultPrinter = Left$(sBuffer, InStr(1, sBuffer & ",", ",") - 1)
    
    DefaultPrinter = mvarDefaultPrinter

End Property

Private Function PtrToString(Address As Long) As String

    Dim sTemp   As String * 512
    Dim lResult As Long

    lResult = lstrcpy(sTemp, Address)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrToString = ""
    Else
         PtrToString = Left$(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
    
End Function

Private Function Win95SetDefaultPrinter(PrinterName As String) As Boolean

    Dim lPrtHandle  As Long
    Dim pd          As PRINTER_DEFAULTS
    Dim lResult     As Long
    Dim lNeedBytes  As Long
    Dim pi5         As PRINTER_INFO_5
    Dim LastError   As Long
    Dim t()         As Long
    
    Win95SetDefaultPrinter = False
    
    'Make sure printer name is supplied
    If PrinterName = "" Then
        Exit Function
    End If
    
    'Set the PRINTER_DEFAULTS members.
    pd.pDatatype = 0&
    pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
    
    'Get a handle to the printer.
    lResult = OpenPrinter(PrinterName, lPrtHandle, pd)
    If lResult = False Then
        Exit Function
    End If
    
    'Call GetPrinter, requesting Level 5 (PRINTER_INFO_5)
    'info to determine how many bytes we Need.
    lResult = GetPrinter(lPrtHandle, 5, ByVal 0&, 0, lNeedBytes)
    ReDim t((lNeedBytes \ 4)) As Long
    
    'Call GetPrinter for real this time.
    lResult = GetPrinter(lPrtHandle, 5, t(0), lNeedBytes, lNeedBytes)
    If lResult = False Then
        Exit Function
    End If
    
    'Set items in the pi5 structure for use with SetPrinter.
    'Note: PtrCtoVbString converts memory areas pointed to
    'by the t() array into Visual Basic strings.
    pi5.pPrinterName = PtrToString(t(0))
    pi5.pPortName = PtrToString(t(1))
    pi5.Attributes = t(2)
    pi5.DeviceNotSelectedTimeout = t(3)
    pi5.TransmissionRetryTimeout = t(4)
    pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT 'Set as default.
    
    'Set the printer info.
    lResult = SetPrinter(lPrtHandle, 5, pi5, 0)
    If lResult = False Then
        Exit Function
    End If
    
    'Close printer handle.
    ClosePrinter (lPrtHandle)
    
    Win95SetDefaultPrinter = True

End Function

Private Function WinNTSetDefaultPrinter(PrinterName As String) As Boolean

    Dim sBuffer      As String
    Dim sPrinter    As String
    Dim lResult     As Long
    Dim PrinterInfo As Variant
    
    WinNTSetDefaultPrinter = False
    
    If PrinterName > "" Then
        
        'Get info for printer.
        sBuffer = Space(1024)
        lResult = GetProfileString("PrinterPorts", PrinterName, "", _
                                   sBuffer, Len(sBuffer))
        
        'Parse the driver name and port name out of the buffer
        PrinterInfo = Split(sBuffer & ",,", ",")
        
        'Set default printer.
        If PrinterInfo(0) <> "" And PrinterInfo(1) <> "" Then
            sPrinter = PrinterName & "," _
                     & PrinterInfo(0) & "," _
                     & PrinterInfo(1)
            lResult = WriteProfileString("windows", "Device", sPrinter)
            
            'Force all applications to reread the info.
            lResult = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
            
            WinNTSetDefaultPrinter = True
        End If 'Valid printer info.
    End If 'Valid printer name.

End Function
