Листинг 2. Код утилиты RusCode2 для Совета 255 "Как определить кодировку текста: еще один вариант"

Public Sub Main()
       ' Стартовая процедура
       ' для утилиты RusCode2 -
       ' определение кодовой таблицы текста по ключевому параметру
       '==========================
       Const KeyCode$ = "!Codepage=" ' ключ поиска
       Const Password$ = "Кодовая таблица" ' идентификатор
   
       Dim SourceFile$, LenS&, NumByte&, Source$
   
       Dim TableName$(-1 To 5) ' названия таблиц
       TableName$(-1) = "Нет ключа-идентификатора"
       TableName$(0) = "Неопределена"
       TableName$(1) = "DOS (cp866)"
       TableName$(2) = "Windows (cp1251)"
       TableName$(3) = "UNIX (KOI-8)"
       TableName$(4) = "General(ISO 8859-5)"
       TableName$(5) = "Mac"
   
       SourceFile$ = App.Path + "\" + "TestWin.htm"
       ' чтение исходного текстового файла
       Open SourceFile$ For Binary As #1
           LenS = LOF(1)
           Source$ = Space$(LenS)
           Get #1, , Source$
       Close #1
       ' поиск ключа
       NumByte = NumberTableTestKey(Source$, KeyCode$, Password$)
   
       MsgBox "Кодовая таблица файла " & vbCrLf    & _
           SourceFile$ & vbCrLf &    _
           "= " & TableName$(NumByte)
   End Sub
   
   Public Function NumberTableTestKey%(Source$, KeyCode$, Password$)
       ' Проверка кодовой таблицы по ключевым параметрам
       'ВХОД: Source$ - содержимое исходного файла
       ' KeyCode$ - ключ для поиска
       ' Password$ - идентификатор
       'ВЫХОД: значение функции (см. содержимое TableName())
       '
       Dim NumByte&, StrWord$, i%
   
       NumByte = InStr(Source$, KeyCode$)
       If NumByte <= 0 Then ' нет записи с ключом
           NumberTableTestKey = -1
           Exit Function
       End If
   
       'выделяем идентификатор
       StrWord$ = Mid$(Source$, NumByte + Len(KeyCode$),     Len(Password$))
   
       If StrWord$ = Password$ Then 'Windows, cp1251
       NumberTableTestKey = 2: Exit Function
       End If
       NumByte = 0
       For i = 1 To 5 ' сравнение перебором
           If i <> 2 Then '
               If StrWord$    = RusDosOther$(Password$, 2, i) Then
                   NumByte    = i: Exit For
               End    If
           End If
       Next
       NumberTableTestKey = NumByte
   End Function