Перекодування текстових файлів

1. Структура заданого вихідного файлу і структури даних, відповідні даними файлу

Файл - це послідовність байтів, що зберігається в пам'яті.

Текстовий файл - це так само послідовність байтів, але кожен байт текстового файлу можна уявити кодом символу.

Поставлене вихідний файл - текстовий, тому що в кожному байті зберігається код символу.

У файлі зберігається текст:

Межі займистості деяких газів і пари в повітрі і в кисні,% (обсяги). Тиск 1 бар, температура 20 ° С.

Речовина Нижня межа в повітрі Верхня межа в повітрі Нижня межа в кисні Верхня межа в кисні

Аміак NH3 15,0 28,0 15 79

Окис вуглецю СО 12,5 74 15,5 94

Водень Н2 4,0 75,6 4,0 94

Метан СН4 5,0 15,0 травня 1961

Метилхлорид СН3С1 7,1 18,5 8,0 66

Етан С2Н6 3,0 12,5 3,0 66

Діметілефір С2Н6О 2,0 27,0 3,9 61

Етилен С2Н4 2,7 28,5 2,9 80

Окис етилену С2Н4О 2,6 100 - -

Ацетальдегід С2Н4О 4,0 57,0 4,0 93

Вінілхлорид С2Н3С1 3,8 29,3 4,0 70

Ацетилен С2Н2 1,5 82,0 2,8 93

Трихлоретилен С2НС13 7,9 - 10,0 65

Пропан СзН8 2,1 9,5 2,3 55

Пропиляний С3Н6 2,0 11,7 2,1 53

н-Бутан C4H10 1,5 8,5 1,8 49

Діетиловий ефір С4Н10О 1,7 36 2,0 82

1-бутилен С4Н8 1,6 10 1,8 58

2-бутилен С4Н8 1,7 9,7 1,7 55

Текст розбитий на рядки нецензурними (керуючими) символами CR / LF.

Перший рядок ніяк не розділена і в програмі буде представлена ​​типом String.

Другий рядок розбита на елементи недрукованим (керуючим) символом горизонтальної табуляції (НТ). Для представлення другого рядка в програмі буде використовуватися рядковий масив типу String.

Третя і наступні рядки, так само як і друга, розбиті на елементи символом горизонтальної табуляції (НТ), але елементи мають різні типи (рядкові та числові), тому буде використовуватися ЗАПИС користувацького типу "param", що складається з однієї змінної типу String і масиву типу Single - для одного рядка

Type param

prop As String

vol (7) As Single

End Type

і масив ЗАПИСІВ - для кількох рядків.

Dim mas () As param

У тексті також замість чисел зустрічається символ «дефіс» («-»), що ускладнює сортування рядків, тому даний символ програма буде заміняти на число нуль.

If smb = "-" Then

par. vol (q) = 0

Для послідовного читання рядків з файлу буде використаний цикл DO UNTIL, умовою виходу з циклу буде стан EOF (EndOfFile-кінець файлу). Кінець файлу визначається розміром файлу. Підпрограма знаходиться в окремому модулі і викликається головною програмою.

Sub InputData (name As String, nf1 As Integer, st () As String, sk () As String, k As Integer)

k = 0

Open name For Input As nf1

Do Until EOF (nf1)

ReDim Preserve st (k)

Line Input # nf1, st (k)

ReDim Preserve sk (k)

sk (k) = st (k)

k = k + 1

Loop

Close # nf1

End Sub

2. Визначення кодування файлу

Кодування являє собою таблицю символів, де кожній букві алфавіту (а також цифрам і спеціальним знакам) привласнений свій унікальний номер - код символу.

Стандартизована тільки половина таблиці, т.зв. ASCII-код - перші 128 символів, які містять у собі букви латинського алфавіту. І з ними ніколи не буває проблем. Друга ж половина таблиці (а всього в ній 256 символів - по кількості станів, який може прийняти один байт) віддана під національні символи, і в кожній країні ця частина різна. Але тільки в Росії було придумано цілих 5 різних кодувань. Термін "різні" позначає те, що одному і тому самому символу відповідає різний цифровий код. Тобто якщо неправильно визначити кодування тексту, то користувачеві постане абсолютно нечитаний текст.

Використання безлічі кодувань в сучасному ПО створює багато незручностей не тільки програмістам, але й користувачам. Згідно раціональної точки зору, впоратися з незрозумілими символами можна, якщо програми будуть автоматично розпізнавати кодування вхідного тексту.

Для однобайтовим кодувань можна враховувати той факт, що частота використання різних букв сильно розрізняється (наприклад, у російській часто використовується «о», але рідко «'»). Тому, знаючи мову тексту, можна легко вибрати кодування, в якому частота байтів краще відповідає частоті літер цієї мови.

Для визначення кодування текстового файлу потрібно виконати наступний план дій:

1. По черзі перебираючи символи з тексту, визначати код символу і перевіряти приналежність його до кожної кодової таблиці.

2. Збільшувати на 1 лічильники тих кодових таблиць, яким не суперечить код символу.

3. Знайти максимальне значення серед лічильників - воно вкаже на найбільш ймовірну кодування.

Текст, кодований в Unicode, виглядає інакше. Кожен символ в Unicode кодується двома байтами, в першому байті пам'яті зберігається код символу Unicode, а в другому завжди 04. Тому, щоб визначити чи має текст кодування Unicode, достатньо перевірити другий байт пам'яті, він повинен зберігати код 04.

Підпрограма перевірки приналежності тексту до однієї з шести кодових таблиць:

Sub FindCP (stroky () As String, msg1 As String, msg2 As String, index As Integer)

Dim s As Integer, z As Integer

Dim symb As String * 1

Dim kod As Byte

Dim scp (7) As codepage

Dim ks As String, ks1 As String

Dim ks2 As String, ne As String

ks = "Ваш текст імовірно має кодування"

ne = "не"

ks1 = "Потрібна"

ks2 = "Перекодування"

For s = 0 To UBound (stroky)

For z = 1 To Len (stroky (s))

symb = Mid (stroky (s), z, 1)

kod = Asc (symb)

If cp1 (kod) Then scp (0). Vol = scp (0). Vol + 1: scp (0). Name = "КОІ-8R"

If cp2 (kod) Then scp (1). Vol = scp (1). Vol + 1: scp (1). Name = "Cp1251"

If cp3 (kod) Then scp (2). Vol = scp (2). Vol + 1: scp (2). Name = "OEM"

If cp4 (kod) Then scp (3). Vol = scp (3). Vol + 1: scp (3). Name = "Cp866"

If cp5 (kod) Then scp (4). Vol = scp (4). Vol + 1: scp (4). Name = "Mac"

If cp6 (kod) Then scp (5). Vol = scp (5). Vol + 1: scp (5). Name = "ISO"

If cp71 (symb) Then scp (6). Vol = scp (6). Vol + 1: scp (6). Name = "Unicode"

Next z

Next s

z = 0

For s = 0 To 6

If scp (s). Vol> = z Then

z = scp (s). vol: index = s

End If

Next s

'При збігу лічильників "КОІ-8R" і "cp1251" кодування тексту визначається як "cp1251"

If ((scp (0). Vol = scp (1). Vol) And index <= 1) Then index = 1

If index = 1 Then

msg1 = ks & scp (index). name

msg2 = ks2 & ne & LCase (ks1)

Else:

msg1 = ks & scp (index). name

msg2 = ks1 & LCase (ks2)

End If

End Sub

Ця підпрограма використовує функції перевірки приналежності коду до заданого діапазону. Функції знаходяться в окремому модулі.

Функції перевірки приналежності коду до заданого діапазону:

'Кодова таблиця КОІ-8R

Function cp1 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim e As Boolean, d As Boolean

Const x1 = 163, X2 = 179

Const x4 = 195, X5 = 255

a = x1 = kod: b = X2 = kod

d = x4 <= kod: e = kod <= X5

cp1 = (a) Or (b) Or (d And e)

End Function

'Кодова таблиця Cp1251

Function cp2 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 168, X2 = 184

Const x3 = 195, x4 = 255

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp2 = (a) Or (b) Or (c And d)

End Function

'Кодова таблиця OEM

Function cp3 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Dim a1 As Boolean, b1 As Boolean

Dim c1 As Boolean, d1 As Boolean

Dim a2 As Boolean, b2 As Boolean

Dim c2 As Boolean, d2 As Boolean

Dim a3 As Boolean, b3 As Boolean

Dim c3 As Boolean, d3 As Boolean

Dim a4 As Boolean, b4 ​​As Boolean

Dim c4 As Boolean, d4 As Boolean

Const x1 = 132, X2 = 133

Const x3 = 156, x4 = 159

Const X5 = 160, X6 = 173

Const X7 = 181, X8 = 184

Const X9 = 189, X10 = 190

Const X11 = 198, X12 = 199

Const X13 = 208, X14 = 216

Const X15 = 221, X16 = 222

Const X17 = 224, X18 = 238

Const X19 = 225, X20 = 252

a = x1 <= kod: b = kod <= X2: c = x3 <= kod: d = kod <= x4

a1 = X5 <= kod: b1 = kod <= X6: c1 = X7 <= kod: d1 = kod <= X8

a2 = X9 <= kod: b2 = kod <= X10: c2 = X11 <= kod: d2 = kod <= X12

a3 = X13 <= kod: b3 = kod <= X14: c3 = X15 <= kod: d3 = kod <= X16

a4 = X17 <= kod: b4 = kod <= X18: c4 = X19 <= kod: d4 = kod <= X20

cp3 = (a And b) Or (c And d) Or (a1 And b1) Or (c1 And d1) Or (a2 And b2) Or (c2 And d2) Or (a3 And b3) Or (c3 And d3) Or (a4 And b4) Or (c4 And d4)

End Function

'Кодова таблиця Cp866

Function cp4 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 128, X2 = 175

Const x3 = 224, x4 = 241

a = x1 <= kod: b = kod <= X2

c = x3 <= kod: d = kod <= x4

cp4 = (a And b) Or (c And d)

End Function

'Кодова таблиця Mac

Function cp5 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 128, X2 = 159

Const x3 = 221, x4 = 254

a = x1 <= kod: b = kod <= X2

c = x3 <= kod: d = kod <= x4

cp5 = (a And b) Or (c And d)

End Function

'Кодова таблиця ISO

Function cp6 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 160, X2 = 240

Const x3 = 176, x4 = 238

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp6 = (a And b) Or (c And d)

End Function

'Кодова таблиця Unicode (молодші розряди)

Function cp7 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 1, X2 = 81

Const x3 = 16, x4 = 79

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp7 = a Or b Or (c And d)

End Function

'Продовження Unicode (старші розряди (04))

Function cp71 (symb As String) As Boolean

Dim k As Byte

Dim a As Boolean

Const x1 = 4

k = AscB (symb)

a = x1 = k

cp71 = a

End Function

3. Алгоритми перекодування файлу у cp 1251

Знаючи кодування (п.2) можна скласти алгоритм перекодування тексту вихідної кодування в задану-СР1251. Мною були обрані шість кодових таблиць: КОІ-8 R, OEM, cp 866, ISO, MAC і Unicode.

З першими п'ятьма кодуваннями все просто:

1. Вибрати з рядка по черзі кожен символ.

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 'якщо кодування cp 1251, то вихід з процедури без перекодування

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 в cp 1251

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. Третя і наступні рядки перетворюються на ЗАПИСИ типу param:

Type param

prop As String

vol (7) As Single

End Type

Наприклад:

Роздільником при перетворенні в ЗАПИС є знак горизонтальної табуляції (HT)

Наприклад:

Аміак NH3 HT 15,0 HT 28,0 HT 15 HT 79

Підпрограма розділення рядків вихідного файлу на поля:

Sub seps (str As String, par As param, howpar As Integer)

Dim p As Integer, q As Integer, r As Integer

Dim dlina As Integer

Dim sp As String, smb As String

Dim HT As String * 1

HT = Chr (9)

dlina = Len (str)

If dlina = 0 Then

Exit Sub

End If

r = InStr (str, HT)

par.prop = Left (str, r - 1)

sp = Right (str, dlina - r) & HT

dlina = dlina - r + 1

p = 1: q = 0

Do While p <dlina

r = InStr (p, sp, HT)

smb = Mid (sp, p, r - p)

If smb = "-" Then

par.vol (q) = 0

Else:

par.vol (q) = CSng (smb)

End If

q = q + 1

p = r + 1

Loop

howpar = q

End Sub

Алгоритм сортування

Рішення задачі сортування файлу розбивається на два етапи.

На першому етапі створюється допоміжний вектор. На другому етапі формується вихідний файл: першою виводиться запис, номер якій 0 потім виводиться запис, номер якої 1 і т. д.

Перший етап. Опис алгоритму формування допоміжного вектора.

Вихідні дані: volVector - масив записів, у складі кожного запису є поле ключа Vol (1). У масиві volVector міститься N елементів. доступ до ключа j-го елемента позначається так: volVector (j). Vol (1). Тип даного Vol (1) допускає порівняння на дорівнює, більше і менше. В результаті виконання алгоритму, визначаються значення елементів допоміжного вектора intMesto. В алгоритмі використовується допоміжний логічний вектор розміром N. Flag (j) = True означає, що елемент volVector (j) доступний для перегляду, але, якщо flag (j) = False, то елемент volVector (j) виключається з перегляду. У вихідному стані всі елементи вектора flag встановлюються в значення True. Допоміжна змінна voltemp зберігає поточне мінімальне значення Vol (1). Константа voltemp має той же тип, що і ключ Vol (1), значення voltemp свідомо більше будь-якого ключа Vol (1).

1. Для кожного i від 0 до N виконувати кроки 1 .... 5. (Індекс i визначає місце запису у вихідному файлі.)

2. Встановити voltemp рівним 99999 і перейти до кроку 3.

3. Для кожного j від 0 до N виконувати крок 4. (У цьому циклі відшукується претендент на місце i.)

4. Якщо flag (j) = True і volVector (j). Vol (1) <= voltemp, виконати voltemp ← volVector (j). Vol (1); kl ← j. (Якщо елемент volVector (j) доступний і його ключ volVector (j). Vol (1) менше, ніж поточний мінімум voltemp, то замінити значення поточного мінімуму і запам'ятати його місце. Доступність елемента volVector (j) визначається значенням True елемента flag (j ).

5. Виконати intMesto (i) ← kl; flag (kl) ← False. (Мінімальне значення з безлічі доступних ключів знайдено в записі з індексом kl. Значення kl записується в intMesto (i), kl-ий елемент вектора volVector позначається як недоступний, виключається з подальших дій.)

Другий етап сортування файлу - висновок в робочий лист Excel і запис у файл на диску.

(Mas-масив вихідних записів, mm-допоміжний масив, sk-масив вихідних рядків)

For q = 0 To h

Cells (q + 3, 1) = mas (mm (q)). Prop

For i = 0 To hp - 1

Cells (q + 3, i + 2) = mas (mm (q)). Vol (i)

Next i

Print # nf2, sk (mm (q) + 2)

Next q

Підпрограма першого етапу сортування (створення допоміжного масиву intMesto):

Sub sort (volVector () As param, intMesto () As Integer, h As Integer)

Dim i As Integer, j As Integer, kl As Integer

Dim highIndex As Integer, lj As Integer

Dim voltemp As Single

Dim flag () As Boolean

h = UBound (volVector)

ReDim intMesto (h)

highIndex = UBound (volVector)

ReDim flag (highIndex)

For i = 0 To highIndex

flag (i) = True

Next i

For i = 0 To highIndex

voltemp = 99999

For j = 0 To highIndex

If flag (j) Then

If volVector (j). Vol (1) <= voltemp Then

'Якщо volvector (j) буде менше або дорівнює voltemp

'Те значення поточного мінімуму voltemp, буде

'Замінено на елемент volvector (j)

voltemp = volVector (j). vol (1)

kl = j

End If

End If

Next j

intMesto (i) = kl

flag (kl) = False

Next i

End Sub

Підпрограма другого етапу сортування - висновок результату в робочий лист Excel і запис у файл на диску:

Sub OutputData (name As String, sk () As String, mm () As Integer, h As Integer, hp As Integer, nf2 As Integer, str As String, mas () As param)

Dim i As Integer, q As Integer

Open name For Output As nf2

Print # nf2, sk (0)

Print # nf2, sk (1)

Cells (1, 1) = sk (0)

For i = 0 To hp

Cells (2, i + 1) = str (i)

Next i

For q = 0 To h

Cells (q + 3, 1) = mas (mm (q)). Prop

For i = 0 To hp - 1

Cells (q + 3, i + 2) = mas (mm (q)). Vol (i)

Next i

Print # nf2, sk (mm (q) + 2)

Next q

Close # nf2

End Sub

5. Структурна ієрархічна схема програми

6. Лістинг програми

Модуль 1

Головна програма

'Головна програма

'Чалк С.А. 10.06.2010

Sub Core ()

Dim st () As String, sk () As String

Dim mm () As Integer, mas () As param

Dim h As Integer, кодування As String

Dim msg As String

Dim q As Integer, hp As Integer

Dim nf1 As Integer, nf2 As Integer

Dim k As Integer, i As Integer

Dim str As String, indx As Integer

Dim name1 As String, name2 As String

name1 = "d: \ ​​ВоспламеняемостьГазов. txt"

name2 = "d: \ ​​vba \ Save.txt"

nf1 = FreeFile (): nf2 = FreeFile ()

Worksheets (1). Select

Call InputData (name1, nf1, st, sk, k)

Call FindCP (st, кодування, msg, indx): MsgBox кодування: MsgBox msg

Call Decoder (st, indx, k, sk)

Call ConvertToRecord (sk, k, str, mas, hp)

Call sort (mas, mm, h)

Call OutputData (name2, sk, mm, h, hp, nf2, str, mas)

End Sub

Модуль 2

Введення даних з файлу в пам'ять

Sub InputData (name As String, nf1 As Integer, st () As String, sk () As String, k As Integer)

k = 0

Open name For Input As nf1

Do Until EOF (nf1)

ReDim Preserve st (k)

Line Input # nf1, st (k)

ReDim Preserve sk (k)

sk (k) = st (k)

k = k + 1

Loop

Close # nf1

End Sub

Модуль 3

Перевірка приналежності тексту до однієї з шести кодових таблиць

Sub FindCP (stroky () As String, msg1 As String, msg2 As String, index As Integer)

Dim s As Integer, z As Integer

Dim symb As String * 1

Dim kod As Byte

Dim scp (7) As codepage

Dim ks As String, ks1 As String

Dim ks2 As String, ne As String

ks = "Ваш текст імовірно має кодування"

ne = "не"

ks 1 = "Потрібна"

ks 2 = "Перекодування"

For s = 0 To UBound (stroky)

For z = 1 To Len (stroky (s))

symb = Mid (stroky (s), z, 1)

kod = Asc (symb)

If cp1 (kod) Then scp (0). Vol = scp (0). Vol + 1: scp (0). Name = "КОІ-8R"

If cp2 (kod) Then scp (1). Vol = scp (1). Vol + 1: scp (1). Name = "Cp1251"

If cp3 (kod) Then scp (2). Vol = scp (2). Vol + 1: scp (2). Name = "OEM"

If cp4 (kod) Then scp (3). Vol = scp (3). Vol + 1: scp (3). Name = "Cp866"

If cp5 (kod) Then scp (4). Vol = scp (4). Vol + 1: scp (4). Name = "Mac"

If cp6 (kod) Then scp (5). Vol = scp (5). Vol + 1: scp (5). Name = "ISO"

If cp71 (symb) Then scp (6). Vol = scp (6). Vol + 1: scp (6). Name = "Unicode"

Next z

Next s

z = 0

For s = 0 To 6

If scp (s). Vol> = z Then

z = scp (s). vol: index = s

End If

Next s

'При збігу лічильників "КОІ-8 R" і "cp 1251" кодування тексту визначається як "cp 1251"

If ((scp (0). Vol = scp (1). Vol) And index <= 1) Then index = 1

If index = 1 Then

msg1 = ks & scp (index). name

msg2 = ks2 & ne & LCase (ks1)

Else:

msg1 = ks & scp (index). name

msg2 = ks1 & LCase (ks2)

End If

End Sub

Модуль 4

Процедура вибору варіанта перекодування (КОІ-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

Модуль 5

Перевірка необхідності перетворення рядків у записі користувача типу

Sub ConvertToRecord (sk () As String, k As Integer, str As shapka, mas () As param, hp As Integer)

Dim i As Integer

Dim str1 As String

Dim str2 As param

For i = 1 To k - 1

str1 = sk (i)

If i = 1 Then

Call sep (str1, str, hp)

Else:

If k> 1 Then

Call seps (str1, str2, hp)

ReDim Preserve mas (i - 2)

mas (i - 2) = str2

End If

End If

Next i

End Sub

Модуль 6

Перший етап сортування рядків (створення допоміжного масиву)

Sub sort (volVector () As param, intMesto () As Integer, h As Integer)

Dim i As Integer, j As Integer, kl As Integer

Dim highIndex As Integer, lj As Integer

Dim voltemp As Single

Dim flag () As Boolean

h = UBound (volVector)

ReDim intMesto (h)

highIndex = UBound (volVector)

ReDim flag (highIndex)

For i = 0 To highIndex

flag (i) = True

Next i

For i = 0 To highIndex

voltemp = 99999

For j = 0 To highIndex

If flag (j) Then

If volVector (j). Vol (1) <= voltemp Then 'якщо volvector (j) буде менше або дорівнює voltemp,

'Те значення поточного мінімуму voltemp, буде

'Замінено на елемент volvector (j)

voltemp = volVector (j). vol (1)

kl = j

End If

End If

Next j

intMesto (i) = kl

flag (kl) = False

Next i

End Sub

Модуль 7

Висновок результату на робочий лист Excel і збереження у файл

Sub OutputData (name As String, sk () As String, mm () As Integer, h As Integer, hp As Integer, nf2 As Integer, str As String, mas () As param)

Dim i As Integer, q As Integer

Open name For Output As nf2

Print # nf2, sk (0)

Print # nf2, sk (1)

Cells (1, 1) = sk (0)

For i = 0 To hp

Cells (2, i + 1) = str (i)

Next i

For q = 0 To h

Cells (q + 3, 1) = mas (mm (q)). Prop

For i = 0 To hp - 1

Cells (q + 3, i + 2) = mas (mm (q)). Vol (i)

Next i

Print # nf2, sk (mm (q) + 2)

Next q

Close # nf2

End Sub

Модуль 8

Процедура обробки тексту кодованого в cpUnicode для перекодування в 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

Модуль 9

Діапазони кодів кодувань (КОІ-8R, 1251, OEM, 866, MAC, Unicode)

'Кодова таблиця КОІ-8R

Function cp1 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim e As Boolean, d As Boolean

Const x1 = 163, X2 = 179

Const x4 = 195, X5 = 255

a = x1 = kod: b = X2 = kod

d = x4 <= kod: e = kod <= X5

cp1 = (a) Or (b) Or (d And e)

End Function

'Кодова таблиця Cp1251

Function cp2 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 168, X2 = 184

Const x3 = 195, x4 = 255

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp2 = (a) Or (b) Or (c And d)

End Function

'Кодова таблиця OEM

Function cp3 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Dim a1 As Boolean, b1 As Boolean

Dim c1 As Boolean, d1 As Boolean

Dim a2 As Boolean, b2 As Boolean

Dim c2 As Boolean, d2 As Boolean

Dim a3 As Boolean, b3 As Boolean

Dim c3 As Boolean, d3 As Boolean

Dim a4 As Boolean, b4 ​​As Boolean

Dim c4 As Boolean, d4 As Boolean

Const x1 = 132, X2 = 133

Const x3 = 156, x4 = 159

Const X5 = 160, X6 = 173

Const X7 = 181, X8 = 184

Const X9 = 189, X10 = 190

Const X11 = 198, X12 = 199

Const X13 = 208, X14 = 216

Const X15 = 221, X16 = 222

Const X17 = 224, X18 = 238

Const X19 = 225, X20 = 252

a = x1 <= kod: b = kod <= X2: c = x3 <= kod: d = kod <= x4

a1 = X5 <= kod: b1 = kod <= X6: c1 = X7 <= kod: d1 = kod <= X8

a2 = X9 <= kod: b2 = kod <= X10: c2 = X11 <= kod: d2 = kod <= X12

a3 = X13 <= kod: b3 = kod <= X14: c3 = X15 <= kod: d3 = kod <= X16

a4 = X17 <= kod: b4 = kod <= X18: c4 = X19 <= kod: d4 = kod <= X20

cp3 = (a And b) Or (c And d) Or (a1 And b1) Or (c1 And d1) Or (a2 And b2) Or (c2 And d2) Or (a3 And b3) Or (c3 And d3) Or (a4 And b4) Or (c4 And d4)

End Function

'Кодова таблиця Cp866

Function cp4 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 128, X2 = 175

Const x3 = 224, x4 = 241

a = x1 <= kod: b = kod <= X2

c = x3 <= kod: d = kod <= x4

cp4 = (a And b) Or (c And d)

End Function

'Кодова таблиця Mac

Function cp5 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 128, X2 = 159

Const x3 = 221, x4 = 254

a = x1 <= kod: b = kod <= X2

c = x3 <= kod: d = kod <= x4

cp5 = (a And b) Or (c And d)

End Function

'Кодова таблиця ISO

Function cp6 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 160, X2 = 240

Const x3 = 176, x4 = 238

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp6 = (a And b) Or (c And d)

End Function

'Кодова таблиця Unicode (молодші розряди)

Function cp7 (kod As Byte) As Boolean

Dim a As Boolean, b As Boolean

Dim c As Boolean, d As Boolean

Const x1 = 1, X2 = 81

Const x3 = 16, x4 = 79

a = x1 = kod: b = kod = X2

c = x3 <= kod: d = kod <= x4

cp7 = a Or b Or (c And d)

End Function

'Продовження Unicode (старші розряди (04))

Function cp71 (symb As String) As Boolean

Dim k As Byte

Dim a As Boolean

Const x1 = 4

k = AscB (symb)

a = x1 = k

cp71 = a

End Function

Модуль 10

Опис для користувача типів даних

Type param

prop As String

vol (7) As Single

End Type

Type codepage

name As String

vol As Integer

End Type

Модуль 11

Процедура розбивки рядка на слова з наступним записом в масив

Sub sep (str As String, par () As String, howpar As Integer)

Dim p As Integer, q As Integer, r As Integer

Dim dlina As Integer

Dim sp As String

Dim slovo As String

Dim HT As String * 1

HT = Chr (9) '09-код символу "горизонтальна табуляція"

str = str & HT

dlina = Len (str)

p = 1: q = 0

Do While p <dlina

r = InStr (p, str, HT)

slovo = Mid (str, p, r - p)

ReDim Preserve par (q)

par (q) = slovo

q = q + 1

p = r + 1

Loop

howpar = q

End Sub

Модуль 12

Процедура перетворення рядка до запису (елементи записи можуть бути типу String і Single)

Sub seps (str As String, par As param, howpar As Integer)

Dim p As Integer, q As Integer, r As Integer

Dim dlina As Integer

Dim sp As String, smb As String

Dim HT As String * 1

HT = Chr (9)

dlina = Len (str)

If dlina = 0 Then

Exit Sub

End If

r = InStr (str, HT)

par.prop = Left (str, r - 1)

sp = Right (str, dlina - r) & HT

dlina = dlina - r + 1

p = 1: q = 0

Do While p <dlina

r = InStr (p, sp, HT)

smb = Mid (sp, p, r - p)

If smb = "-" Then

par.vol (q) = 0

Else:

par.vol (q) = CSng (smb)

End If

q = q + 1

p = r + 1

Loop

howpar = q

End Sub

Модуль 13

Перекодування кодів символів з ​​вихідної кодування в задану 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

Література

• Стеценко О.О. Структури та алгоритми обробки даних - Методичні вказівки до практичних та лабораторних занять.: Чебоксари 2009.

• Стеценко О.О. Структури і типи даних - навчальний посібник.: Чебоксари 2009.

• Електронний підручник з VBA. Режим доступу: http://www.mini-soft.ru/soft/vba