Установка принтера по умолчанию (API)

'--------------------------------------------------------------------

' Module : modSetUPDefPrinter

' Author : es

' Date : 25.11.2000 - L.E.16.11.2012

' Purpose : Модуль составления списка установленных принтеров и установки одного из них по умолчанию

'--------------------------------------------------------------------

Option Compare Database

Option Explicit

'--------------------------------------------------------------------

'Например:

'Cписок принтеров (через точку с запятой для использования в списке ComboBox):

' esPrintersList()

'Установить принтер по умолчанию:

' esSetPrinterAsDefault "Название Принтера"

'--------------------------------------------------------------------

Private Declare Function GetProfileString Lib "Kernel32" Alias "GetProfileStringA" ( _

ByVal lpAppName As String, _

ByVal lpKeyName As Any, _

ByVal lpDefault As String, _

ByVal lpReturnedString As String, _

ByVal nSize As Integer) As Integer

Private Declare Function WriteProfileString Lib "Kernel32" Alias "WriteProfileStringA" ( _

ByVal lpApplicationName As String, _

ByVal lpKeyName As Any, _

ByVal lpString As Any) As Integer

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" ( _

ByVal hWnd As Integer, ByVal wMsg As Integer, _

ByVal wParam As Integer, lParam As Any) As Long

Private Const WM_WININICHANGE = &H1A

Private Const HWND_BROADCAST = &HFFFF

Public Function esPrintersList() As String

' Строит список установленных принтеров (через точку с запятой)

' для использования в ComboBox-е

'--------------------------------------------------------------------

Dim i As Integer

Dim StrBuffer As String

'--------------------------------------------------------------------

On Error GoTo esPrintersList_Err

esPrintersList = ""

'Получение информации из WIN.INI

StrBuffer = Space(1024) 'или, если что, = Space(8192)

i = GetProfileString("PrinterPorts", 0&, "", StrBuffer, Len(StrBuffer))

Do

i = InStr(StrBuffer, Chr(0))

If i > 2 Then

If Len(esPrintersList) > 1 Then esPrintersList = esPrintersList & ";"

esPrintersList = esPrintersList & Left(StrBuffer, i - 1)

StrBuffer = Mid(StrBuffer, i + 1)

End If

Loop While i > 2

esPrintersList_Bye:

Exit Function

esPrintersList_Err:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"in procedure esPrintersList", vbCritical, "Error!"

Resume esPrintersList_Bye

End Function

Public Function esSetPrinterAsDefault(MyPrinterName As String)

Dim i As Integer 'переменные на запуск

Dim x As Long ' --//--

Dim StrBuffer As String 'Строка возвращаемая

Dim DeviceName As String 'Строка передаваемая (полная)

Dim DriverName As String

Dim PrinterPort As String

'Получение информации по указанному принтеру из WIN.INI

'--------------------------------------------------------------------

On Error GoTo esSetPrinterAsDefault_Err

StrBuffer = Space(1024)

i = GetProfileString("PrinterPorts", MyPrinterName, "", StrBuffer, Len(StrBuffer))

'Получаем имена драйвера и порта из переменной StrBuffer

GetDriverAndPort StrBuffer, DriverName, PrinterPort

If DriverName <> "" And PrinterPort <> "" Then

'Установка принтера по умолчанию

'формирование строки дя вставки в секцию

DeviceName = MyPrinterName & "," & DriverName & "," & PrinterPort

'Сохраняет информацию нового принтера в [WINDOWS] разделе

'файла WIN.INI по DEVICE= принтер

i = WriteProfileString("windows", "Device", DeviceName)

'Иницализация перезагрузки WIN.INI

x = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")

End If

esSetPrinterAsDefault_Bye:

Exit Function

esSetPrinterAsDefault_Err:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"in procedure esSetPrinterAsDefault", vbCritical, "Error!"

Resume esSetPrinterAsDefault_Bye

End Function

Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As String, PrinterPort As String)

'Вспомогательная

' Опеределние настроек драйвера и порта принтера из того же win.ini

' (откопано где то на просторах MSDN)

'--------------------------------------------------------------------

Dim R As Integer

Dim iDriver As Integer

Dim iPort As Integer

DriverName = ""

PrinterPort = ""

iDriver = InStr(Buffer, ",")

If iDriver > 0 Then

DriverName = Left(Buffer, iDriver - 1)

iPort = InStr(iDriver + 1, Buffer, ",")

If iPort > 0 Then

PrinterPort = Mid(Buffer, iDriver + 1, iPort - iDriver - 1)

End If

End If

End Sub