Option Explicit On
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
Public Class FrmChgPrnt
Private Structure PRINTER_INFO_4
Dim pPrinterName As Long
Dim pServerName As Long
Dim Attributes As Long
End Structure
'This is non-windows constant
'defined for this method
Private Const SIZEOFPRINTER_INFO_4 = 12
Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
Private Const PRINTER_LEVEL4 = &H4
Private Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" _
(ByVal Flags As Long, _
ByVal Name As String, _
ByVal Level As Long, _
pPrinterEnum As String, _
ByVal cbBuffer As Long, _
pcbNeeded As Long, _
pcReturned As Long) As Long
Private Declare Function EnumPrintersNull Lib "winspool.drv" _
Alias "EnumPrintersA" _
(ByVal pPrinterEnum As Long)
Private Declare Function SendNotifyMessage Lib "user32" _
Alias "SendNotifyMessageA" _
(ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
lParam As String) As Long
Private Declare Function SendNotifyMessageNull Lib "user32" _
Alias "SendNotifyMessageA" _
(ByVal lParam As Long)
Private Declare Function SetDefaultPrinter Lib "winspool.drv" _
Alias "SetDefaultPrinterA" _
(ByVal pszPrinter As String) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, ByVal ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(ByVal ptr As String) As Long
Private Declare Function lstrlenANull Lib "kernel32" _
(ByVal ptr As Long) As Long
Private Sub Form_Load()
With Command1
.Text = "Set Default Printer"
End With
Call EnumPrintersWinNTPlus()
End Sub
Private Sub Command1_Click()
'set the default printer to the
'selected item
SetDefaultPrinter(List1.SelectedItem)
'broadcast the change
''BREAKPOINT = Expression expected.
Call SendNotifyMessage(HWND_BROADCAST, _
WM_WININICHANGE, _
0, ByVal "windows")
''BREAKPOINT
End Sub
Private Function EnumPrintersWinNTPlus() As Long
Dim cbRequired As Long
Dim cbBuffer As Long
Dim ptr() As PRINTER_INFO_4
Dim nEntries As Long
Dim cnt As Long
List1.Items.Clear()
'To determine the required buffer size,
'call EnumPrinters with cbBuffer set to zero.
'EnumPrinters fails, and Err.LastDLLError
'returns ERROR_INSUFFICIENT_BUFFER, filling
'in the cbRequired parameter with the size,
'in bytes, of the buffer required to hold
'the array of structures and their data.
Call EnumPrinters(PRINTER_ENUM_LOCAL, _
vbNullString, _
PRINTER_LEVEL4, _
0, 0, _
cbRequired, _
nEntries)
'The strings pointed to by each PRINTER_INFO_4
'struct's members reside in memory after the end
'of the array of structs. So we're not only
'allocating memory for the structs themselves,
'but all the strings pointed to by each struct's
'member as well.
ReDim ptr((cbRequired \ SIZEOFPRINTER_INFO_4))
'Set cbBuffer equal to the size of the buffer
cbBuffer = cbRequired
'Enumerate the printers. If the function succeeds,
'the return value is nonzero. If the function fails,
'the return value is zero.
''BREAKPOINT = Value of type 'WindowsApplication1.FrmChgPrnt.PRINTER_INFO_4' cannot be converted to 'String'.
If EnumPrinters(PRINTER_ENUM_LOCAL, _
vbNullString, _
PRINTER_LEVEL4, _
ptr(0), cbBuffer, _
cbRequired, nEntries) Then
''BREAKPOINT
For cnt = 0 To nEntries - 1
With ptr(cnt)
List1.Items.Add(GetStrFromPtrA(.pPrinterName))
End With
Next cnt
Else
List1.Items.Add("Error enumerating printers.")
End If 'EnumPrinters
EnumPrintersWinNTPlus = nEntries
End Function
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
''BREAKPOINT = Error 3 'String' is a type and cannot be used as an expression, expression expected, expression expected,
''expression expected
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
''BREAKPOINT
End Function
Private Sub FrmChgPrnt_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub List1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles List1.SelectedIndexChanged
If List1.SelectedIndex > -1 Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If
End Sub
Private Sub Command1_Click(sender As Object, e As EventArgs) Handles Command1.Click
End Sub
End Class