' 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!!!!
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!!!!