Declare Function EnumSystemCodePages Lib "kernel32" _ Alias "EnumSystemCodePagesA" (ByVal _ lpCodePageEnumProc As Long, ByVal dwFlags As Long) _ As Long
EnumSystemCodePages перечисляет кодовые страницы, установленные или поддерживаемые операционной системой.
В случае ошибки функция возвращает 0 (используйте GetLastError для получения кода ошибки). В успешном случае возвращается ненулевое значение.
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