Куда-то русские буквы в примере потерялись. Дублирую:

Option Explicit

Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long
Private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
  
Private Sub Command1_Click()
   DisplayPrinterComments Printer.DeviceName
End Sub

Private Sub DisplayPrinterComments(ByVal psPrinterName As String)
'
'  Возвращает информацию об указанном принтере в структуре PRINTER_INFO_2
'
   Dim aLBuffer()     As Long  'Буфер для получения информации
   Dim lPrinterHandle As Long  'Манипулятор принтера
   Dim lResult        As Long  'Возврат из API-функции
   Dim lSizeNeeded    As Long  'Нужный размер буфера
   Dim lUBound        As Long  'Верхняя граница массива

   'Получим манипулятор принтера
   lResult = OpenPrinter(psPrinterName, lPrinterHandle, 0)

   'Узнаем нужный размер для буфера (в байтах)
   lResult = GetPrinter(lPrinterHandle, 2, 0, 0, lSizeNeeded)
  
   'Переопределим размер буфера (размер Long равен 4 байтам)
   lUBound = (lSizeNeeded / 4) + 3
   ReDim aLBuffer(0 To lUBound) As Long
  
   'Получим в aLBuffer информацию о принтере в структуре PRINTER_INFO_2
   lResult = GetPrinter(lPrinterHandle, 2, aLBuffer(0), lUBound * 4, lSizeNeeded)

   'Закроем открытый объект принтера
   ClosePrinter lPrinterHandle
  
   Label1.Caption = StringFromPointer(aLBuffer(5), 255)
  
End Sub

Private Function StringFromPointer(ByRef plStringPointer As Long, _
                                  ByRef plMaxLen As Long) _
                 As String
'
'  Возвращает строку по ее указателю
'
   Dim sString As String 'Возвращаемая строка
  
   If plStringPointer <> 0 Then
      If Not IsBadStringPtrByLong(plStringPointer, plMaxLen) Then
     
         sString = Space$(plMaxLen)
         CopyMemory ByVal sString, ByVal plStringPointer, ByVal Len(sString)
        
         If Err.LastDllError = 0 Then
             If InStr(sString, Chr$(0)) > 0 Then
                 sString = Left$(sString, InStr(sString, Chr$(0)) - 1)
             End If
         End If
      End If
   End If
  
   StringFromPointer = sString
  
End Function

Ответить

Стоило написать  форум, как я это победила. Вот - вдруг кому интересно:

Private Const SORT_DEFAULT = &H0       'Сортировка по умолчанию
Private Const LANG_RUSSIAN = &H19      'Russian language
Private Const SUBLANG_ENGLISH_US = &H1 'English (USA) Sublanguage

Private Declare Function SetThreadLocale Lib "kernel32" (ByVal Locale As Long) As Long

Private Sub Command1_Click()
   Dim lLastError As Long 'N последней ошибки
   Dim lLocale    As Long 'Locale id для процесса
   Dim lSuccess   As Long 'Возвращаемое из API-функции значение
  
   lLocale = MakeLcid(MakeLangId(LANG_RUSSIAN, SUBLANG_ENGLISH_US), SORT_DEFAULT)
   lSuccess = SetThreadLocale(lLocale)
  
   DisplayPrinterComments Printer.DeviceName
  
End Sub

Public Function MakeLangId(ByVal plPrimaryLanguage As Long, _
                           ByVal plSubLanguage As Long) _
                As Long
'
'  VB-версия C++ макроса MAKELANGID.
'  Создает language id из primary language id и sublanguage id.
'
   MakeLangId = (LLeftShift(plSubLanguage, 10) Or plPrimaryLanguage)
  
End Function

Public Function MakeLcid(ByVal piLanguageID As Integer, _
                         ByVal piSortID As Integer) _
                As Long
'
'  VB-версия C++ макроса MAKELCID.
'  Создает locale id из language id и sort id.
'
   MakeLcid = (LLeftShift(piSortID, 16) Or piLanguageID)
  
End Function

Public Function LLeftShift(ByVal plNum As Long, _
                           ByVal plShift As Long) _
                As Long
'
'  Вместо left shift.
'
   LLeftShift = plNum * (2 ^ plShift)
   
End Function

Ответить