Перекодировка текстовых файлов (стр. 2 из 3)

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

Case 225 To 226c = code - 33Case 228 To 229c = code - 32Case 233 To 240c = code - 33Case 242 To 245c = code - 34Case 193 To 194c = code + 31Case 196 To 197c = code + 32Case 201 To 208c = code + 31Case 210 To 213c = code + 30Case 221c = 249Case 223c = 250Case 217c = 251Case 216c = 252Case 220c = 253Case 192c = 254

Case 247c = 194Case 231c = 195Case 179c = 168Case 246c = 198Case 250c = 199Case 230c = 212Case 232c = 213Case 227c = 214Case 254c = 215Case 251c = 216 Case 163c = 184Case 214c = 230Case 218c = 231Case 198c = 244

Case 253c = 217Case 255c = 218Case 249c = 219Case 248c = 220Case 252c = 221Case 224c = 222Case 242c = 223Case 215c = 226Case 199c = 227Case 195c = 246Case 222c = 247Case 219c = 248 Case 200c = 245Case 209c = 255

End Select

cpKoiTo1251 = c

End Function

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

Function cpOEMTo1251(code As Byte) As Byte

Dim c As Byte

c = code

Select Case code

Case 161c = 192Case 163c = 193Case 236c = 194Case 173c = 195Case 167c = 196Case 169c = 197Case 133c = 168Case 234c = 198Case 244c = 199Case 184c = 200Case 190c = 201Case 199c = 202Case 209c = 203Case 211c = 204Case 213c = 205Case 215c = 206Case 221c = 207Case 226c = 208Case 228c = 209Case 181c = 245Case 164c = 246Case 251c = 247

Case 230c = 210Case 232c = 211Case 171c = 212Case 182c = 213Case 165c = 214Case 152c = 215Case 246c = 216Case 250c = 217Case 238c = 218Case 242c = 219Case 159c = 220Case 248c = 221Case 170c = 244Case 249c = 249Case 237c = 250Case 241c = 251Case 158c = 252Case 247c = 253Case 150c = 254Case 222c = 255Case 231c = 243Case 245c = 248

Case 157c = 222Case 224c = 223Case 160c = 224Case 162c = 225Case 235c = 226Case 172c = 227Case 166c = 228Case 168c = 229Case 132c = 184Case 233c = 230Case 243c = 231Case 183c = 232Case 189c = 233Case 198c = 234Case 208c = 235Case 210c = 236Case 212c = 237Case 214c = 238Case 216c = 239Case 225c = 240Case 227c = 241Case 229c = 242

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

EndType

Например:

ЗАПИСЬ:	Par.prop	Par.vol(0)	Par.vol(1)	Par.vol(2)	Par.vol(3)
Строка:	Аммиак NH3	15,0	28,0	15	79

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

Например:

Аммиак NH3HT15,0HT28,0HT15HT79

Подпрограмма разделения строк исходного файла на поля:

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

Nexti

EndSub

Подпрограмма второго этапа сортировки - вывод результата в рабочий лист 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

SubCore()

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:&bsol;ВоспламеняемостьГазов.txt"

name2 = "d:&bsol;vba&bsol;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)

EndSub

Модуль 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

Проверка принадлежности текста к одной из шести кодовых таблиц