Not a Member Yet,
Click here to Register
How do you like the new design?






ID: 171
Viewed: 2514
Added: Apr 29, 2002
Version:
Snippet uploaded by: snippet
Written By: unknown
Demo: Sorry, no demo



User Rated at: 4 Stars4 Stars4 Stars4 Stars
Rate This:

Thank you for your vote. Please wait...

It appears you already voted for this snippet

It appears your vote value was empty

none

Highlight all by clicking in box
<!---Declaration--->
'constant to set printer_info_5 attributes member
Public Const PRINTER_ATTRIBUTE_QUEUED = &H1 '1
Public Const PRINTER_ATTRIBUTE_DIRECT = &H2 '2
Public Const PRINTER_ATTRIBUTE_DEFAULT = &H4 '4
'Public Const PRINTER_ATTRIBUTE_DO_COMPLETE_FIRST = ?
Public Const PRINTER_ATTRIBUTE_SHARED = &H8 '8
Public Const PRINTER_ATTRIBUTE_NETWORK = &H10 '16
Public Const PRINTER_ATTRIBUTE_HIDDEN = &H20 '32
Public Const PRINTER_ATTRIBUTE_LOCAL = &H40 '64
Public Const PRINTER_ATTRIBUTE_WORK_OFFLINE = &H400 '1024
Public Const PRINTER_ATTRIBUTE_ENABLE_BIDI = &H800 '2048

Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type

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

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

Declare Function lstrcpy Lib "Kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, ByVal lpString2 As Any) As Long

'***************************************************************************

' NAME: PrinterSetDefault
' NOTES: Make printer the default
' : Taken from Microsoft Knowledge Base article Q167735
' PARAM: hPrinter : handle of printer to set as default
' : bShowError : display an error message if printer is not
available?
' DATE: 9/29/97
'***************************************************************************

Public Function PrinterSetDefault(hPrinter As Long, bShowError As Boolean)

Dim i As Long
Dim BufferSize As Long
Dim Temp() As Long
Dim pInfo5 As PRINTER_INFO_5 'your PRINTER_INFO structure

'make an initial call to GetPrinter, requesting Level 5
'(PRINTER_INFO_5) information, to determine how many bytes needed
i = GetPrinter(hPrinter, 5, ByVal 0&, 0, BufferSize)
'don't want to check GetLastError here - it's supposed to fail
'with a 122 - ERROR_INSUFFICIENT_BUFFER
'redim t as large as you need

ReDim Temp((BufferSize 4)) As Long

'and call GetPrinter for keepers this time
i = GetPrinter(hPrinter, 5, Temp(0), BufferSize, BufferSize)
'failed the GetPrinter
If i = False Then
If bShowError Then MsgBox ("Failed to GetPrinter")
Exit Function
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 Temp() array into a VB string.
'The other three elements are just dWords (long integers) and
'don't require any conversion
pInfo5.pPrinterName = PtrCtoVbString(Temp(0))
pInfo5.pPortName = PtrCtoVbString(Temp(1))
pInfo5.Attributes = Temp(2)
pInfo5.DeviceNotSelectedTimeout = Temp(3)
pInfo5.TransmissionRetryTimeout = Temp(4)

'this is the critical flag that makes it the default printer
pInfo5.Attributes = PRINTER_ATTRIBUTE_DEFAULT '4
' pInfo5.Attributes = PRINTER_ATTRIBUTE_QUEUED '1
' pInfo5.Attributes = PRINTER_ATTRIBUTE_DIRECT '2
' pInfo5.Attributes = PRINTER_ATTRIBUTE_SHARED '8
' pInfo5.Attributes = PRINTER_ATTRIBUTE_NETWORK '10
' pInfo5.Attributes = PRINTER_ATTRIBUTE_HIDDEN '20
' pInfo5.Attributes = PRINTER_ATTRIBUTE_LOCAL '40
' pInfo5.Attributes = PRINTER_ATTRIBUTE_WORK_OFFLINE '400
' pInfo5.Attributes = PRINTER_ATTRIBUTE_ENABLE_BIDI '800

'call SetPrinter to set it
i = SetPrinter(hPrinter, 5, pInfo5, 0)
'failed SetPrinter
If i = False Then
If bShowError Then MsgBox ("SetPrinter Failed. Error code: " &
GetLastError())
Exit Function
End If

PrinterSetDefault = True

End Function

'***************************************************************************

' NAME: PtrCtoVbString
' NOTES: Converts a pointer to a string to a VB string
' : Taken from Microsoft Knowledge Base article Q167735
' : (Be sure this is declared as follows:
' : Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
' : (ByVal lpString1 As String, ByVal lpString2 As Any) As Long
' PARAM: Add : pointer-to-string to convert
' DATE: 9/29/97
'***************************************************************************

Private Function PtrCtoVbString(Add As Long) As String

Dim sTemp As String * 512
Dim i As Long

i = 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

Highlight All
<!---Code--->
none;


No Comments to show

Please completely fill out the form below if you want to review this snippet. All reviews are subject to validation.


Replying to a Comment...


Adding your comment. Please wait...

Thanks for adding your comment!. After further review it will be added.

There was a problem adding your comment. Please try again.

Please complete all the fields in the form before sending.

© 2002 - 2017 snippetlibrary.com All Rights Reserved. Conditions