![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() |
BooM |
![]()
Сообщение
#1
|
Группа: Пользователи Сообщений: 3 Пол: Мужской Репутация: ![]() ![]() ![]() |
Можите мне подсказать что я делаю не так???
Пишу на TP. Помогите пожалуйста ![]() ![]() ![]() Код PROGRAM Arhivator; Uses Crt; TYPE Tree=^PTree; PTree=Record Symbol:Byte; {Кодируемый символ} Leng:Byte; {Длина кодовой последовательности} Bit:Byte; {Бит, соответствующий направл. ветви} Counter:Longint; {Счётчик частоты вхождений} Code:Word; {Кодовая последовательность} Next,Prev:Tree; {Указетели на элементы списка} Right,Left:Tree; {Указатели на правую и левую ветвь дерева} End; ArrayTree=array[0..255] Of Tree; VAR Root,pBegin,pNext,pEnd,Current,P:Tree; b:ArrayTree; HelpCode:Word; i,j,n,m,q,Buf:Byte; CountCode:Integer; s:Longint; f:File; r:Text; ch:Char; st:String; Procedure Compression; Begin {Инициализация массива узлов} For i:=0 To 255 Do begin New(b[i]); With b[i]^ Do begin Counter:=0; Symbol:=i; Bit:=0; Leng:=0; Code:=0; Right:=Nil; Left:=Nil; end; end; {Организация связи массива узлов} For i:=0 To 255 Do begin If i>0 Then b[i-1]^.Next:=b[i]; If i<255 Then b[i+1]^.Prev:=b[i]; end; b[0]^.Prev:=Nil; b[255]^.Next:=Nil; {Подсчёт частот вхождений байтов} While not(eof(f)) Do begin BlockRead(f,Buf,1); Inc(b[Buf]^.Counter); end; {Сотировка массива узлов} pBegin:=b[0]; While pBegin<>Nil Do begin pNext:=pBegin; While pNext<>Nil Do begin If pBegin^.Counter>pNext^.Counter Then begin s:=pBegin^.Counter; n:=pBegin^.Symbol; m:=pBegin^.Bit; q:=pBegin^.Leng; HelpCode:=pBegin^.Code; pBegin^.Counter:=pNext^.Counter; pBegin^.Symbol:=pNext^.Symbol; pBegin^.Bit:=pNext^.Bit; pBegin^.Leng:=pNext^.Leng; pBegin^.Code:=pNext^.Code; pNext^.Counter:=s; pNext^.Symbol:=n; pNext^.Bit:=m; pNext^.Leng:=q; pNext^.Code:=HelpCode; end; pNext:=pNext^.Next; end; pBegin:=pBegin^.Next; end; {Нахождение ненулевых значений счётчика в массиве} pBegin:=b[0]; While pBegin<>Nil Do If pBegin^.Counter=0 Then begin pBegin:=pBegin^.Next; pNext:=pBegin; end Else begin pNext:=pBegin; Break; end; {Создание кодового дерева} pEnd:=b[255]; While (pNext<>Nil) and (pNext^.Next<>Nil) Do begin New(Root); With Root^ Do begin Right:=pNext^.Next; Left:=pNext; Counter:=pNext^.Counter+pNext^.Next^.Counter; Symbol:=0; Bit:=0; Leng:=0; Code:=0; end; Root^.Right^.Bit:=1; Root^.Left^.Bit:=0; Current:=pNext; While (Current^.Counter<Root^.Counter) and (Current<>Nil) Do Current:=Current^.Next; If Current=Nil Then begin Root^.Prev:=pEnd; pEnd^.Next:=Root; Root^.Next:=Nil; pEnd:=Root; end Else begin Root^.Prev:=Current^.Prev; Current^.Prev:=Root; Root^.Next:=Current; If Root^.Prev<>Nil Then Root^.Prev^.Next:=Root; end; pNext:=pNext^.Next^.Next; end; End; BEGIN ClrScr; Writeln('Для архивации файла нажмите ''a''.'); Writeln('Для распаковки файла нажмите ''r''.'); Writeln('Для отмены нажмите любую клавишу.'); ch:=Readkey; Case ch Of #97:Begin Writeln('Введите полный путь и имя файла:'); Readln(st); Assign(f,st); Reset(f,1); If FileSize(f)=0 Then Writeln('Файл пуст!!!') Else Begin Assign(r,'D:\Kopiya.TXT'); Rewrite(r); Writeln(r,st); Compression; Close(r); End; Close(f); End; Else Halt; End; Readln; END. |
![]() ![]() |
![]() |
Текстовая версия | 20.07.2025 0:25 |