'ShowProperties : Gonderilen Printer'in ozellikler ekranini acar
' (vPrinterName As String, vHwnd As Long)

'SelectPrinter : W95 sistemleri icin varsayilan printer seciminin yapilmasi
' (NewPrinter As String)

'SetDefaultPrinter : Windows sistem dahilinde gonderilen printer'in default printer olarak
' atanmasi
' (vPrinterName As String) As Boolean
'GetPrinterNames : Windows sistem printer isimlerinin okunmasi
' (Optional vDelimeter As String) As String
'GetPrinterDesc : Gonderilen Printer'in Description ozelliginin okunmasi
' (vPrinterName As String) As String
'GetPrinterComments : Gonderilen Printer'in Comments ozelliginin okunmasi
' (vPrinterName As String) As String

Private Const PRINTER_ENUM_LOCAL = &H2
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_1
flags As Long
pDescription As String
pName As String
pComment As String
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

Private 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 ClosePrinter Lib "winspool.drv" (ByVal hPrinter 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 lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long
Private Declare Function PrinterProperties Lib "winspool.drv" _
(ByVal Hwnd As Long, ByVal hPrinter As Long) As Long

Private Sub AssignDefaultPrinter(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 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 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
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
Function SetDefaultPrinter(vPrinterName As String) As Boolean

 Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
'Win9x atama islemi icin gerekli degiskenler
Dim Handle As Long 'handle to printer
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
'WinNT atama islemi icin gerekli degiskenler
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim r As Long

On Error GoTo handler
'fonksiyon degeri ataniyor
SetDefaultPrinter = False
'eger printer ismi atanmamissa fn terkediliyor
If Trim(vPrinterName) = "" Then Exit Function
'W.x versiyonu aliniyor
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
'sistemin versiyonuna gore printer atama islemi yapiliyor
If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
'Windows9x icin varsayilan printer ataniyor -
' set the PRINTER_DEFAULTS members
pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
' Get a handle to the printer
x = OpenPrinter(vPrinterName, Handle, pd)
' failed the open
If x = False Then Exit Function
' 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 Exit Function
' 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
Exit Function
Else
If Printer.DeviceName <> vPrinterName Then SelectPrinter (vPrinterName)
End If
' and close the handle
ClosePrinter (Handle)
'Windows9x icin varsayilan printer ataniyor +
Else
'WindowsNT ve turevleri icin varsayilan printer ataniyor -
' Get the printer information for the currently selected
' printer in the list. The information is taken from the
' WIN.INI file.
Buffer = Space(1024)
r = GetProfileString("PrinterPorts", vPrinterName, "", Buffer, Len(Buffer))
' Parse the driver name and port name out of the buffer
GetDriverAndPort Buffer, DriverName, PrinterPort
If DriverName <> "" And PrinterPort <> "" Then
AssignDefaultPrinter vPrinterName, DriverName, PrinterPort
If Printer.DeviceName <> vPrinterName Then
' Make sure Printer object is set to the new printer
SelectPrinter (vPrinterName)
End If
End If
'WindowsNT ve turevleri icin varsayilan printer ataniyor +
End If
'fonksiyon degeri ataniyor
SetDefaultPrinter = True
Exit Function
handler:
'fonksiyon degeri ataniyor
SetDefaultPrinter = False
End Function
Function GetPrinterNames(Optional vDelimeter As String) As String

 Dim priPrinterInfo() As PRINTER_INFO_1
Dim lngBuffer() As Long
Dim lngNumBytes As Long
Dim lngNumNeeded As Long
Dim lngNumPrinters As Long
Dim lngC As Integer
Dim retval As Long

 If vDelimeter = "" Then vDelimeter = "#"
lngNumBytes = 3076
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
lngNumBytes = lngNumNeeded
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
'Debug.Print "Could not successfully enumerate the printer."
End
End If
End If
If lngNumPrinters <> 0 Then ReDim priPrinterInfo(0 To lngNumPrinters - 1) As PRINTER_INFO_1
For lngC = 0 To lngNumPrinters - 1
priPrinterInfo(lngC).flags = lngBuffer(4 * lngC)
priPrinterInfo(lngC).pDescription = Space(lstrlen(lngBuffer(4 * lngC + 1)))
retval = lstrcpy(priPrinterInfo(lngC).pDescription, lngBuffer(4 * lngC + 1))
priPrinterInfo(lngC).pName = Space(lstrlen(lngBuffer(4 * lngC + 2)))
retval = lstrcpy(priPrinterInfo(lngC).pName, lngBuffer(4 * lngC + 2))
priPrinterInfo(lngC).pComment = Space(lstrlen(lngBuffer(4 * lngC + 3)))
retval = lstrcpy(priPrinterInfo(lngC).pComment, lngBuffer(4 * lngC + 3))
Next lngC
GetPrinterNames = ""
For lngC = 0 To lngNumPrinters - 1
GetPrinterNames = GetPrinterNames & priPrinterInfo(lngC).pName & vDelimeter
Next
If Trim(GetPrinterNames) <> "" Then GetPrinterNames = Left(GetPrinterNames, Len(GetPrinterNames) - Len(vDelimeter))
End Function
Function GetPrinterDesc(vPrinterName As String) As String

 Dim priPrinterInfo() As PRINTER_INFO_1
Dim lngBuffer() As Long
Dim lngNumBytes As Long
Dim lngNumNeeded As Long
Dim lngNumPrinters As Long
Dim lngC As Integer
Dim retval As Long

 lngNumBytes = 3076
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
lngNumBytes = lngNumNeeded
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
'Debug.Print "Could not successfully enumerate the printer."
End
End If
End If
If lngNumPrinters <> 0 Then ReDim priPrinterInfo(0 To lngNumPrinters - 1) As PRINTER_INFO_1
For lngC = 0 To lngNumPrinters - 1
priPrinterInfo(lngC).flags = lngBuffer(4 * lngC)
priPrinterInfo(lngC).pDescription = Space(lstrlen(lngBuffer(4 * lngC + 1)))
retval = lstrcpy(priPrinterInfo(lngC).pDescription, lngBuffer(4 * lngC + 1))
priPrinterInfo(lngC).pName = Space(lstrlen(lngBuffer(4 * lngC + 2)))
retval = lstrcpy(priPrinterInfo(lngC).pName, lngBuffer(4 * lngC + 2))
priPrinterInfo(lngC).pComment = Space(lstrlen(lngBuffer(4 * lngC + 3)))
retval = lstrcpy(priPrinterInfo(lngC).pComment, lngBuffer(4 * lngC + 3))
Next lngC
GetPrinterDesc = ""
For lngC = 0 To lngNumPrinters - 1
If vPrinterName = priPrinterInfo(lngC).pName Then GetPrinterDesc = priPrinterInfo(lngC).pDescription
Next
End Function
Function GetPrinterComments(vPrinterName As String) As String

 Dim priPrinterInfo() As PRINTER_INFO_1
Dim lngBuffer() As Long
Dim lngNumBytes As Long
Dim lngNumNeeded As Long
Dim lngNumPrinters As Long
Dim lngC As Integer
Dim retval As Long

 lngNumBytes = 3076
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
lngNumBytes = lngNumNeeded
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
'Debug.Print "Could not successfully enumerate the printer."
End
End If
End If
If lngNumPrinters <> 0 Then ReDim priPrinterInfo(0 To lngNumPrinters - 1) As PRINTER_INFO_1
For lngC = 0 To lngNumPrinters - 1
priPrinterInfo(lngC).flags = lngBuffer(4 * lngC)
priPrinterInfo(lngC).pDescription = Space(lstrlen(lngBuffer(4 * lngC + 1)))
retval = lstrcpy(priPrinterInfo(lngC).pDescription, lngBuffer(4 * lngC + 1))
priPrinterInfo(lngC).pName = Space(lstrlen(lngBuffer(4 * lngC + 2)))
retval = lstrcpy(priPrinterInfo(lngC).pName, lngBuffer(4 * lngC + 2))
priPrinterInfo(lngC).pComment = Space(lstrlen(lngBuffer(4 * lngC + 3)))
retval = lstrcpy(priPrinterInfo(lngC).pComment, lngBuffer(4 * lngC + 3))
Next lngC
GetPrinterComments = ""
For lngC = 0 To lngNumPrinters - 1
If vPrinterName = priPrinterInfo(lngC).pName Then GetPrinterComments = priPrinterInfo(lngC).pComment
Next
End Function
Sub ShowProperties(vPrinterName As String, vHwnd As Long)

 Dim priPrinterInfo() As PRINTER_INFO_1
Dim lngBuffer() As Long
Dim lngNumBytes As Long
Dim lngNumNeeded As Long
Dim lngNumPrinters As Long
Dim lngC As Integer
Dim retval As Long

Dim hPrinter As Long
Dim hPDefaults As PRINTER_DEFAULTS

On Error Resume Next
lngNumBytes = 3076
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
lngNumBytes = lngNumNeeded
ReDim lngBuffer(0 To lngNumBytes / 4) As Long
retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, lngBuffer(0), lngNumBytes, lngNumNeeded, lngNumPrinters)
If retval = 0 Then
'Debug.Print "Could not successfully enumerate the printer."
End
End If
End If
If lngNumPrinters <> 0 Then ReDim priPrinterInfo(0 To lngNumPrinters - 1) As PRINTER_INFO_1
For lngC = 0 To lngNumPrinters - 1
priPrinterInfo(lngC).flags = lngBuffer(4 * lngC)
priPrinterInfo(lngC).pDescription = Space(lstrlen(lngBuffer(4 * lngC + 1)))
retval = lstrcpy(priPrinterInfo(lngC).pDescription, lngBuffer(4 * lngC + 1))
priPrinterInfo(lngC).pName = Space(lstrlen(lngBuffer(4 * lngC + 2)))
retval = lstrcpy(priPrinterInfo(lngC).pName, lngBuffer(4 * lngC + 2))
priPrinterInfo(lngC).pComment = Space(lstrlen(lngBuffer(4 * lngC + 3)))
retval = lstrcpy(priPrinterInfo(lngC).pComment, lngBuffer(4 * lngC + 3))
Next lngC
For lngC = 0 To lngNumPrinters - 1
If vPrinterName = priPrinterInfo(lngC).pName Then
OpenPrinter priPrinterInfo(lngC).pName, hPrinter, hPDefaults
PrinterProperties vHwnd, hPrinter
ClosePrinter hPrinter
Exit For
End If
Next
End Sub