' Объявление API-функции

Declare Function GetProfileStringA Lib «kernel32» _

(ByVal lpAppName As String, ByVal lpKeyName As String, _

ByVal lpDefault As String, ByVal lpReturnedString As _

String, ByVal nSize As Long) As Long

Sub Принтер()

Dim strFullInfo As String * 255 ' Буфер для API-функции

Dim strInfo As String ' Строка с полной информацией

Dim strPrinter As String ' Название принтера

Dim strDriver As String ' Драйвер принтера

Dim strPort As String ' Порт принтера

Dim strMessage As String

Dim intPrinterEndPos As Integer

Dim intDriverEndPos As Integer

' Заполнение буфера пробелами

strFullInfo = Space(255)

' Получение полной информации о принтере

Call GetProfileStringA(«Windows», «Device», "", strFullInfo,

254)

' Удаление лишних символов из конца возвращенной строки

' Строка strInfo имеет формат <имя_принтера>,<драйвер>,<-

порт>:

strInfo = Trim(strFullInfo)

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

intPrinterEndPos = Application.Find(",", strInfo, 1)

intDriverEndPos = Application.Find(",", strInfo,

intPrinterEndPos + 1)

' Определение названия принтера

strPrinter = Left(strInfo, intPrinterEndPos – 1)

' Определение драйвера

strDriver = Mid(strInfo, intPrinterEndPos + 1,

intDriverEndPos _

– intPrinterEndPos – 1)

' Определение порта (его название заканчивается символом ":")

strPort = Mid(strInfo, intDriverEndPos + 1, InStr(1, strInfo,

":") _

– intDriverEndPos – 1)

' Формирование информационного сообщения

strMessage = «Принтер:» & Chr(9) & strPrinter & Chr(13)

strMessage = strMessage & «Драйвер:» & strDriver & Chr(13)

strMessage = strMessage & «strPort:» & Chr(9) & strPort

' Вывод информационного сообщения

MsgBox strMessage, vbInformation, «Сведения о принтере по умолчанию»

End Sub