Установка принтера по умолчанию (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