Функция EnumSystemCodePages

Declare Function EnumSystemCodePages Lib "kernel32" _
    Alias "EnumSystemCodePagesA" (ByVal _
    lpCodePageEnumProc As Long, ByVal dwFlags As Long) _
    As Long

EnumSystemCodePages перечисляет кодовые страницы, установленные или поддерживаемые операционной системой.

Возвращаемое значение

В случае ошибки функция возвращает 0 (используйте GetLastError для получения кода ошибки). В успешном случае возвращается ненулевое значение.

Параметры

lpLocaleEnumProc

Указатель на функцию обратного вызова EnumCodePagesProc

dwFlags

Флаг, определяющий кодовые страницы для перечисления. Можно принимать одно из следующих значений

Const CP_INSTALLED = &H1	Перечисляет только установленные кодовые страницы
Const CP_SUPPORTED = &H2	Перечисляет все поддерживаемые кодовые страницы

Пример

' Получим информацию об установленных кодовых страницах
' Код для модуля
Private Declare Function EnumSystemCodePages Lib "kernel32" _
        Alias "EnumSystemCodePagesA" (ByVal _
        lpCodePageEnumProc As Long, ByVal dwFlags 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 GetCPInfo Lib "kernel32" (ByVal _
        CodePage As Long, lpCPInfo As CPINFO) As Long

Const CP_INSTALLED = &H1
Const CP_SUPPORTED = &H2

Const MAX_DEFAULTCHAR = 2
Const MAX_LEADBYTES = 12

Type CPINFO
  MaxCharSize As Long
  DefaultChar(MAX_DEFAULTCHAR) As Byte
  LeadByte(MAX_LEADBYTES) As Byte
End Type

Dim CP() As Long

Public Sub EnumCodePage(LB As ListBox)
  Dim x%, cpinfo$, Result&, CPInf As CPINFO
  
      ReDim CP(0 To 0)
      LB.Clear
      Call EnumSystemCodePages(AddressOf EnumCodePagesProc, CP_INSTALLED)
      For x = 0 To UBound(CP) - 1
        Result = GetCPInfo(CP(x), CPInf)
        CPINFO = CP(x) & " " & " " _
             & GetCodePageString(CP(x))

        LB.AddItem CPINFO
      Next x
End Sub

Private Function EnumCodePagesProc(CP_Pointer&) As Long
  Dim Buffer$
  
    Buffer = Space$(255)
    Call CopyMemory(ByVal Buffer, CP_Pointer, Len(Buffer))
    Buffer = Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
    CP(UBound(CP)) = CLng(Buffer)
    ReDim Preserve CP(0 To UBound(CP) + 1)
    EnumCodePagesProc = 1&
End Function

Private Function GetCodePageString(CP&) As String
  Dim cpinfo$
    
    Select Case CP

      Case 437:   CPINFO = "MS-DOS United States"
      Case 855:   CPINFO = "IBM Cyrillic (primarily Russian)"
      Case 866:   CPINFO = "MS-DOS Russian"
      Case 1251:  CPINFO = "Windows Cyrillic"
      Case 1252:  CPINFO = "Windows US (ANSI)"
      Case Else: CPINFO = "Смотри в документации"
    End Select
    
    GetCodePageString = CPINFO
End Function

' Добавьте на форму ListBox
Private Sub Form_Load()
  Call EnumCodePage(List1)
End Sub

Реклама

Категория

Поддержка национальных языков