Modifier l'imprimante par défaut ! : RESOLU: voila le code !

Modifier l'imprimante par défaut ! : RESOLU: voila le code ! - VB/VBA/VBS - Programmation

Marsh Posté le 27-05-2003 à 16:21:30    

Bonjour !
 
Existe-t-il une methode pour modifier l'imprimante par defaut (sous VB6 et windows NT4) ?
 
J'ai donc 2 imprimante et je voudrais en forcer une ou l'autre comme imprimante par defaut pour windows ...
 
Merci d'avance
 
 
Voila le code:
 
Option Explicit
 
Private Const HWND_BROADCAST = &HFFFF
Private Const WM_WININICHANGE = &H1A
 
' constants for DEVMODE structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
 
' constants for DesiredAccess member of PRINTER_DEFAULTS
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
 
' constant that goes into PRINTER_INFO_5 Attributes member
' to set it as default
Private Const PRINTER_ATTRIBUTE_DEFAULT = 4
 
' Constant for OSVERSIONINFO.dwPlatformId
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
 
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 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
 
Private Type PRINTER_INFO_5
     pPrinterName As String
     pPortName As String
     Attributes As Long
     DeviceNotSelectedTimeout As Long
     TransmissionRetryTimeout As Long
End Type
 
Private Type PRINTER_DEFAULTS
     pDatatype As Long
     pDevMode As Long
     DesiredAccess As Long
End Type
 
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
 
Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long
 
Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lparam As String) As Long
 
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 Function PtrCtoVbString(Add As Long) As String
    Dim sTemp As String * 512, x As Long
 
    x = lstrcpy(sTemp, Add)
    If (InStr(1, sTemp, Chr(0)) = 0) Then
         PtrCtoVbString = ""
    Else
         PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
    End If
End Function
 
Public Sub setThisDefaultPrinter()
    setDefaultPrinter Printer.DeviceName, Printer.DeviceName, Printer.Port
End Sub
 
Private Sub setDefaultPrinter(ByVal PrinterName As String, _
    ByVal DriverName As String, ByVal PrinterPort As String)
    Dim DeviceLine As String
    Dim r As Long
    Dim l As Long
    DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
    ' Store the new printer information in the [WINDOWS] section of
    ' the WIN.INI file for the DEVICE= item
    r = WriteProfileString("windows", "Device", DeviceLine)
    ' Cause all applications to reload the INI file:
    l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows" )
End Sub
 
Private Sub Win95SetDefaultPrinter()
    Dim Handle As Long          'handle to printer
    Dim PrinterName As String
    Dim pd As PRINTER_DEFAULTS
    Dim x As Long
    Dim need As Long            ' bytes needed
    Dim pi5 As PRINTER_INFO_5   ' your PRINTER_INFO structure
    Dim LastError As Long
 
    ' determine which printer was selected
    PrinterName = List1.List(List1.ListIndex)
    ' none - exit
    If PrinterName = "" Then
        Exit Sub
    End If
 
    ' set the PRINTER_DEFAULTS members
    pd.pDatatype = 0&
    pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
 
    ' Get a handle to the printer
    x = OpenPrinter(PrinterName, Handle, pd)
    ' failed the open
    If x = False Then
        'error handler code goes here
        Exit Sub
    End If
 
    ' Make an initial call to GetPrinter, requesting Level 5
    ' (PRINTER_INFO_5) information, to determine how many bytes
    ' you need
    x = GetPrinter(Handle, 5, ByVal 0&, 0, need)
    ' don't want to check Err.LastDllError here - it's supposed
    ' to fail
    ' with a 122 - ERROR_INSUFFICIENT_BUFFER
    ' redim t as large as you need
    ReDim t((need \ 4)) As Long
 
    ' and call GetPrinter for keepers this time
    x = GetPrinter(Handle, 5, t(0), need, need)
    ' failed the GetPrinter
    If x = False Then
        'error handler code goes here
        Exit Sub
    End If
 
    ' set the members of the pi5 structure for use with SetPrinter.
    ' PtrCtoVbString copies the memory pointed at by the two string
    ' pointers contained in the t() array into a Visual Basic string.
    ' The other three elements are just DWORDS (long integers) and
    ' don't require any conversion
    pi5.pPrinterName = PtrCtoVbString(t(0))
    pi5.pPortName = PtrCtoVbString(t(1))
    pi5.Attributes = t(2)
    pi5.DeviceNotSelectedTimeout = t(3)
    pi5.TransmissionRetryTimeout = t(4)
 
    ' this is the critical flag that makes it the default printer
    pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
 
       ' call SetPrinter to set it
       x = SetPrinter(Handle, 5, pi5, 0)
 
       If x = False Then   ' SetPrinter failed
           MsgBox "SetPrinter Failed. Error code: " & Err.LastDllError
           Exit Sub
       Else
           If Printer.DeviceName <> List1.Text Then
           ' Make sure Printer object is set to the new printer
                SelectPrinter (List1.Text)
           End If
       End If
 
    ' and close the handle
    ClosePrinter (Handle)
End Sub
 
Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As _
    String, PrinterPort As String)
 
    Dim iDriver As Integer
    Dim iPort As Integer
    DriverName = ""
    PrinterPort = ""
 
    ' The driver name is first in the string terminated by a comma
    iDriver = InStr(Buffer, "," )
    If iDriver > 0 Then
 
         ' Strip out the driver name
        DriverName = Left(Buffer, iDriver - 1)
 
        ' The port name is the second entry after the driver name
        ' separated by commas.
        iPort = InStr(iDriver + 1, Buffer, "," )
 
        If iPort > 0 Then
            ' Strip out the port name
            PrinterPort = Mid(Buffer, iDriver + 1, _
            iPort - iDriver - 1)
        End If
    End If
End Sub
 
Private Sub ParseList(lstCtl As Control, ByVal Buffer As String)
    Dim i As Integer
    Dim s As String
 
    Do
        i = InStr(Buffer, Chr(0))
        If i > 0 Then
            s = Left(Buffer, i - 1)
            If Len(Trim(s)) Then lstCtl.AddItem s
            Buffer = Mid(Buffer, i + 1)
        Else
            If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer
            Buffer = ""
        End If
    Loop While i > 0
End Sub
 
Private Sub WinNTSetDefaultPrinter()
    Dim Buffer As String
    Dim DeviceName As String
    Dim DriverName As String
    Dim PrinterPort As String
    Dim PrinterName As String
    Dim r As Long
    If List1.ListIndex > -1 Then
        ' Get the printer information for the currently selected
        ' printer in the list. The information is taken from the
        ' WIN.INI file.
        Buffer = Space(1024)
        PrinterName = List1.Text
        r = GetProfileString("PrinterPorts", PrinterName, "", _
            Buffer, Len(Buffer))
 
        ' Parse the driver name and port name out of the buffer
        GetDriverAndPort Buffer, DriverName, PrinterPort
 
           If DriverName <> "" And PrinterPort <> "" Then
               setDefaultPrinter List1.Text, DriverName, PrinterPort
               If Printer.DeviceName <> List1.Text Then
               ' Make sure Printer object is set to the new printer
                  SelectPrinter (List1.Text)
               End If
           End If
End Sub
 
 
    Private Sub SelectPrinter(NewPrinter As String)
        Dim Prt As Printer
         
        For Each Prt In Printers
            If Prt.DeviceName = NewPrinter Then
                Set Printer = Prt
            Exit For
            End If
        Next
    End Sub
         
 
 
 


Message édité par mario51 le 28-05-2003 à 08:18:08

---------------
Il ne faut pas vendre la peau de l'ours.....NON, il ne faut pas!!!!
Reply

Marsh Posté le 27-05-2003 à 16:21:30   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed