GFSetOSDefaultPrinter/GFSetOSDefaultPrinter.frm

VERSION 5.00
Begin VB.Form GFSetOSDefaultPrinterfrm
   BorderStyle     =   0 'Kein
   Caption         =   "Form1"
   ClientHeight    =   90
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   90
   Enabled         =   0 'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   90
   ScaleWidth      =   90
   ShowInTaskbar   =   0 'False
   StartUpPosition =   3 'Windows‑Standard
   Visible         =   0 'False
End
Attribute VB_Name = "GFSetOSDefaultPrinterfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis.
'
'NOTE: this code is from Microsoft (it's not my fault if it does not work).
'It fixes the one‑cannot‑set‑default‑printer error of VB 5.0
'(Set Printer = Printers(x) does not work).
'Look at http://support.microsoft.com/support/kb/articles/Q167/7/35.asp
'for original, unchanged code (03‑17‑2001).
'
'THIS FORM IS PLUG‑IN CODE, DO NOT CHANGE!
'
'GFSetOSDefaultPrinter_SetOSDefaultPrinter
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
'SetDefaultPrinter_Win95
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 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 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
'SetDefaultPrinter_WinNT
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 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
'SetDefaultPrinter_WinINI
Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
'GetStringFromStringAddress
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
'GFSetOSDefaultPrinter_SetOSDefaultPrinter
Const HWND_BROADCAST = &HFFFF
Const VER_PLATFORM_WIN32_WINDOWS = 1
'SetDefaultPrinter_Win95
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)
Const PRINTER_ATTRIBUTE_DEFAULT = 4
'SetDefaultPrinter_WinINI
Const WM_WININICHANGE = &H1A
'GFSetOSDefaultPrinter_SetOSDefaultPrinter
Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
'SetDefaultPrinter_Win95
Private Type PRINTER_DEFAULTS
    pDatatype As Long
    pDevMode As Long
    DesiredAccess As Long
End Type
'SetDefaultPrinter_Win95
Private Type PRINTER_INFO_5
    pPrinterName As String
    pPortName As String
    Attributes As Long
    DeviceNotSelectedTimeout As Long
    TransmissionRetryTimeout As Long
End Type

'************************************INTERFACE SUBS*************************************

Public Function GFSetOSDefaultPrinter_SetOSDefaultPrinter(ByVal PrinterName As String) As Boolean
    'on error resume next
    Dim OSVERSIONINFOVar As OSVERSIONINFO
    'preset
    OSVERSIONINFOVar.dwOSVersionInfoSize = Len(OSVERSIONINFOVar)
    Call GetVersionExA(OSVERSIONINFOVar)
    'begin
    If OSVERSIONINFOVar.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
        GFSetOSDefaultPrinter_SetOSDefaultPrinter = SetDefaultPrinter_Win95(PrinterName)
    Else
        '
        'NOTE: this (whatever ‑ ask Microsoft) assumes that future versions
        'of Windows will use the WinNT method (say what).
        '
        GFSetOSDefaultPrinter_SetOSDefaultPrinter = SetDefaultPrinter_WinNT(PrinterName)
    End If
End Function

'*********************************END OF INTERFACE SUBS*********************************
'*********************************WIN95 PRINTER CHANGE**********************************

Private Function SetDefaultPrinter_Win95(ByVal PrinterName As String) As Boolean
    'on error resume next 'function returns true if passed printer has been set to default, False if not
    Dim PrinterHandle As Long
    Dim PrinterBufferBytesCount As Long 'bytes needed for something (???)
    Dim PrinterBuffer() As Long 'any buffer (???)
    Dim PRINTER_INFO_5Var As PRINTER_INFO_5
    Dim PRINTER_DEFAULTSVar As PRINTER_DEFAULTS
    Dim Temp As Long
    'preset
    PRINTER_DEFAULTSVar.pDatatype = 0&
    PRINTER_DEFAULTSVar.DesiredAccess = PRINTER_ALL_ACCESS Or PRINTER_DEFAULTSVar.DesiredAccess
    'begin
    If Not (PrinterName = "") Then 'verify
        '
        Temp = OpenPrinter(PrinterName, PrinterHandle, PRINTER_DEFAULTSVar)
        If Temp = 0 Then GoTo Error: 'verify
        Temp = GetPrinter(PrinterHandle, 5, ByVal 0&, 0, PrinterBufferBytesCount) 'request level 5 information and number of bytes (???)
        'If Temp = 0 Then GoTo Error: 'verify
        '
        ReDim PrinterBuffer((PrinterBufferBytesCount \ 4)) As Long
        Temp = GetPrinter(PrinterHandle, 5, PrinterBuffer(0), PrinterBufferBytesCount, PrinterBufferBytesCount)
        If Temp = 0 Then GoTo Error: 'verify
        '
        'BLABLA (annotation was removed).
        '
        PRINTER_INFO_5Var.pPrinterName = GetStringFromStringAddress(PrinterBuffer(0))
        PRINTER_INFO_5Var.pPortName = GetStringFromStringAddress(PrinterBuffer(1))
        PRINTER_INFO_5Var.Attributes = PrinterBuffer(2)
        PRINTER_INFO_5Var.DeviceNotSelectedTimeout = PrinterBuffer(3)
        PRINTER_INFO_5Var.TransmissionRetryTimeout = PrinterBuffer(4)
        PRINTER_INFO_5Var.Attributes = PRINTER_ATTRIBUTE_DEFAULT
        '
        Temp = SetPrinter(PrinterHandle, 5, PRINTER_INFO_5Var, 0)
        If Temp = 0 Then GoTo Error:
        '
        Call ClosePrinter(PrinterHandle)
    Else
        GoTo Error:
    End If
    SetDefaultPrinter_Win95 = True 'ok
    Exit Function
Error:
    SetDefaultPrinter_Win95 = False 'error
    Exit Function
End Function

'******************************END OF WIN95 PRINTER CHANGE******************************
'*********************************WINNT PRINTER CHANGE**********************************

Private Function SetDefaultPrinter_WinNT(ByVal PrinterName As String) As Boolean
    'on error resume next 'function returns True if passed printer has been set to default, False if not
    Dim PrinterBufferString As String
    Dim PrinterPort As String
    Dim PrinterDeviceName As String
    Dim PrinterDriverName As String
    'begin
    If Not (PrinterName = "") Then 'verify
        PrinterBufferString = String$(1024, Chr$(0)) 'initialize buffer
        Call GetProfileString("PrinterPorts", PrinterName, "", PrinterBufferString, Len(PrinterBufferString)) 'read from win.ini
        Call GetPrinterDriverAndPortFromPrinterBufferString(PrinterBufferString, PrinterDriverName, PrinterPort)
        If Not ((PrinterDriverName = "") Or (PrinterPort = "")) Then 'verify
            Call SetDefaultPrinter_WinINI(PrinterName, PrinterDriverName, PrinterPort)
        Else
            GoTo Error:
        End If
    Else
        GoTo Error:
    End If
    SetDefaultPrinter_WinNT = True 'ok
    Exit Function
Error:
    SetDefaultPrinter_WinNT = False 'error
    Exit Function
End Function

Private Sub SetDefaultPrinter_WinINI(ByVal PrinterName As String, ByVal PrinterDriverName As String, ByVal PrinterPort As String)
    'on error resume next 'sets default printer in win.ini
    Dim PrinterDeviceLine As String
    'begin
    PrinterDeviceLine = PrinterName + "," + PrinterDriverName + "," + PrinterPort
    '
    'NOTE: the new printer information is saved in the
    '[WINDOWS] section of the win.ini file for the DEVICE=item.
    '
    Call WriteProfileString("windows", "Device", PrinterDeviceLine)
    Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows") 'react to changes
End Sub

Private Sub GetPrinterDriverAndPortFromPrinterBufferString(ByVal PrinterBufferString As String, ByRef PrinterDriverName As String, ByRef PrinterPortString As String)
    'on error resume next
    Dim PrinterDriverNameStartPos As Long
    Dim PrinterPortStringStartPos As Long
    '
    'NOTE: the PrinterBufferString has the format:
    '[printer driver name],[printer port], [...].
    '
    'preset
    PrinterDriverName = "" 'default (error)
    PrinterPortString = "" 'default (error)
    'begin
    PrinterDriverNameStartPos = InStr(1, PrinterBufferString, ",", vbBinaryCompare)
    If Not (PrinterDriverNameStartPos = 0) Then 'verify
        PrinterDriverName = Left(PrinterBufferString, PrinterDriverNameStartPos ‑ 1)
        PrinterPortStringStartPos = InStr(PrinterDriverNameStartPos + 1, PrinterBufferString, ",", vbBinaryCompare)
        If Not (PrinterPortStringStartPos = 0) Then 'verify
            PrinterPortString = Mid(PrinterBufferString, PrinterDriverNameStartPos + 1, PrinterPortStringStartPos ‑ PrinterDriverNameStartPos ‑ 1)
        End If
    End If
End Sub

'******************************END OF WINNT PRINTER CHANGE******************************
'*****************************************OTHER*****************************************

Private Function GetStringFromStringAddress(ByVal StringAddress As Long) As String
    'on error resume next
    Dim Temp As Long
    Dim TempStr As String * 512
    'begin
    Temp = lstrcpy(TempStr, StringAddress)
    If (InStr(1, TempStr, Chr(0)) = 0) Then
         GetStringFromStringAddress = "" 'error
    Else
         GetStringFromStringAddress = Left(TempStr, InStr(1, TempStr, Chr(0)) ‑ 1) 'ok
    End If
End Function


[END OF FILE]