2. Определить код символа заданной кодировки.

3. Добавить (отнять) к коду разницу от кода такого же символа в кодировке 1251.

4. Определить символ по полученному новому коду.

5. Добавить полученный символ в новую строку.

Подпрограмма выбора варианта перекодировки (КОИ-8R, 1251, OEM, 866, MAC, Unicode):

Sub Decoder(Fmas() As String, IndxCP As Integer, r As Integer, Smas() As String)

Dim i As Integer

Dim n As Integer

Dim Stroka As String

Dim OutStr As String

Dim smb As String

Dim code As Byte

If IndxCP = 1 Then Exit Sub 'если кодировка cp1251, то выход из процедуры без перекодирования

If IndxCP = 6 Then

Call DecUnicodeTo1251(Fmas, Smas)

Exit Sub

End If

ReDim Smas(r - 1)

For i = 0 To r - 1

Stroka = Fmas(i)

OutStr = ""

For n = 1 To Len(Stroka)

smb = Mid(Stroka, n, 1)

code = Asc(smb)

Select Case IndxCP

Case 0

OutStr = OutStr & Chr(cpKoiTo1251(code))

Case 2

OutStr = OutStr & Chr(cpOEMTo1251(code))

Case 3

OutStr = OutStr & Chr(cp866To1251(code))

Case 4

OutStr = OutStr & Chr(cpMACTo1251(code))

Case 5

OutStr = OutStr & Chr(cpISOTo1251(code))

End Select

Next n

Smas(i) = OutStr

Next i

End Sub

С Unicode немного сложнее:

· В начало текста (Unicode) добавляется два символа «я» и «ю». Их нужно удалить.

· Перекодировать нужно только первый байт, во втором байте всегда 04.

· Символы такие как «точка», «запятая» и другие, кодируются в памяти двумя байтами, но второй байт будет пустой.

1. Выбрать из строки поочередно каждый символ и определить его код.

2. Выбрать следующий за ним символ и определить его код.

3. Если первый байт не равен 4, а второй байт равен 4, то первый байт Unicode перекодируется в cp1251.

4. Иначе если первый байт не равен 4 и второй байт не равен 4, то перекодировка не требуется.

5. Добавить полученный символ в новую строку.

Подпрограмма обработки текста кодированного в Unicode для перекодировки в cp1251:

Sub DecUnicodeTo1251(TextUnicode() As String, Text1251() As String)

Dim i As Integer

Dim n As Integer

Dim fstr As String

Dim smb1 As String * 1

Dim smb2 As String * 1

Dim code1 As Byte

Dim code2 As Byte

Dim OutStr As String

'В тексте кодированном в cpUnicode в начале добавляется два символа "ю" и "я"

'Поэтому их надо удалить

fstr = Right(TextUnicode(0), Len(TextUnicode(0)) - 2) 'удаление символов "ю" и "я"

TextUnicode(0) = fstr

For i = 0 To UBound(TextUnicode)

OutStr = ""

For n = 1 To Len(TextUnicode(i))

smb1 = Mid(TextUnicode(i), n, 1)

code1 = Asc(smb1)

smb2 = Mid(TextUnicode(i), n + 1, 1)

code2 = Asc(smb2)

'Проверка по двум байтам:

'Если второй байт равен 4, то первый байт Unicode перекодируется в cp1251

If (code1 <> 4 And code2 = 4) Then OutStr = OutStr & Chr(cpUnicodeTo1251(code1))

'Если первый байт не равен 4, то символ ASCII, и не требует перекодировки

If (code1 <> 4 And code2 <> 4) Then OutStr = OutStr & Chr(code1)

Next n

ReDim Preserve Text1251(i)

Text1251(i) = OutStr

Next i

End Sub

Функции перекодировки кода заданной кодировки в код ср1251:

'перекодирование кода символа из cpКОИ-8R в cp1251

Function cpKoiTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

End Select

cpKoiTo1251 = c

End Function

'перекодирование кода символа из cpOEM в cp1251

Function cpOEMTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

End Select

cpOEMTo1251 = c

End Function

'перекодирование кода символа из cp866 в cp1251

Function cp866To1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

Case 128 To 175

c = code + 64

Case 224 To 239

c = code + 16

Case 240

c = 168

Case 241

c = 184

End Select

cp866To1251 = c

End Function

'перекодирование кода символа из Unicode в cp1251

Function cpUnicodeTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

Case 16 To 79

c = code + 176

Case 1

c = 168

Case 81

c = 184

End Select

cpUnicodeTo1251 = c

End Function

'перекодирование кода символа из cpMAC в cp1251

Function cpMACTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

Case 128 To 159

c = code + 64

Case 224 To 254

c = code

Case 221

c = 168

Case 222

c = 184

Case 223

c = 255

End Select

cpMACTo1251 = c

End Function

'перекодирование кода символа из cpISO в cp1251

Function cpISOTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

Case 176 To 239

c = code + 16

Case 160

c = 168

Case 240

c = 184

End Select

cpISOTo1251 = c

End Function

4. Алгоритм сортировки записей исходного файла

Задача сортировки файла формулируется следующим образом. Имеется файл, состоящий из последовательности записей. Одно из полей в составе каждой записи является полем ключа. Файл целиком размещается во внутренней памяти. Требуется вывести файл на внешний носитель так, чтобы записи располагались в заданном порядке следования ключей.

Страницы: 1, 2, 3, 4