декодирование не работает в чем проблема ? не понятно

 
0
 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,StdCtrls, Buttons, Grids, ComCtrls, ValEdit;

type
  TEl = Record
    Count  : DWord;
    E      : DWord;//Переменная под частоту
    Length : Integer; //Переменная под длину
    Link   : Integer;
    Code   : Word;//Переменная под код
  end;

  TForm1 = class(TForm)
    OD: TOpenDialog; //Диалог открытия файла
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn; //Кнопка под открытие файла
    Button1: TButton; //Кнопка под кодирование
    SD: TSaveDialog; //Диалог сохранения
    Button2: TButton; //Кнопка декодирования
    ProgressBar1: TProgressBar; //Полоса прогресса
    StatusBar1: TStatusBar;
    RichEdit1: TRichEdit;//Окно для тескста

    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
   private
  El :array[0..255] of TEl;//Динамический массив
  procedure ClearTree;//Очистка дерева

  function BitsToStr(b: Word;Length: byte):string;//Биты в байты
  function BitToByte(var Code:string):Byte;//Байты в биты
  function ByteToStr(c:byte):string;
  procedure CreateTree(FS:DWord);//Процедура построения древа
  function Check(str1,str2:string):boolean;
    { Private declarations }
  public
    { Public declarations }
  end;//Закончили начальные описания

var //Описание переменных
  Form1: TForm1;//Форма
  const BufSize=2048;//Размер буфера


implementation

{$R *.dfm}

function TForm1.BitToByte(var Code:string):Byte;
var
j:integer;
begin
if length(code)<8 then
  code:=concat('00000000',code);
result:=0;
for j:=0 to 7 do
  begin
  result:=result+(StrToInt(code[Length(code)])mod 2);
  if j<7 then result:=result shl 1;
  delete(code,Length(code),1);
  end;
end;

function TForm1.Check(str1,str2:string):boolean;
begin
if str1=copy(str2,Length(str2)-Length(str1)+1,Length(str1)) then result:=true
else result:=false;
end;

function TForm1.ByteToStr(c:byte):string;
var
i:integer;
tmp:string;
begin
result:='';
for i:=0 to 7 do
  begin
  tmp:=tmp+inttostr(c mod 2);
  c:=c shr 1;
  end;
for i:=0 to 7 do
  result:=concat(result,tmp[Length(tmp)-i]);
end;

function TForm1.BitsToStr(b: Word;Length: byte):string;
var
  i:byte;
begin
  result:='';
  i:=0;
  while i<Length do
    begin
    result:=concat(result,IntToStr(b mod 2));
    b:=b shr 1;
    inc(i);//Наращиваем счётчик
    end;
end;
procedure TForm1.ClearTree;//Процедура очистки древа
var//Переменные
  i:byte;//Счётчик
begin
  for i:=0 to 255 do
    begin
      El[i].Count:=0;//Обнуляем кол.-во
      El[i].Length:=0;//Обнляем длины
      El[i].Link:=-1;
      El[i].E:=0;//Обнуляем частоты
      El[i].Code:=0;//Обнуляем код
    end;//Закончили обнуление
end;//Закончили очистку
//Нам нужен список либо бинарное дерево в общем какая нибудь структура
//Мы строим бинарное дерево
procedure TForm1.CreateTree(FS:DWord); //Процедура построения древа
var
  n:DWord;
  m1, m2: Byte;
  n1:Cardinal;
  i:Integer;//Счётчик
begin
  n:=0;
  while n<FS do
    begin
      m1:=48;
      n1:=high(Cardinal);
      for i:=0 to 255 do
        if (El[i].Count<>0) and (El[i].Count < n1) then
           begin
             n1 := El[i].Count;
             m1:=i;
           end;
      n1:=high(Cardinal);
      m2:=m1;
      for i:=0 to 256 do
        begin
        if (m2=m1)and(i=256) then
          begin
          if m1>0 then
            m2:=m1-1
          else
            m2:=m1+1;
          break;
          end;
        if (i<256)and(El[i].Count <> 0) and (El[i].Count <= n1) and (i<>m1) then
          begin
            n1 := El[i].Count;
            m2:=i;
          end;
        end;
      El[m1].Count:=El[m1].Count + El[m2].Count;
      n:=El[m1].Count;
      El[m1].Code:=El[m1].Code shl 1;
      El[m2].Count:=0;
      El[m1].Length:=El[m1].Length+1;
      while El[m1].Link>=0 do
        begin
        El[El[m1].Link].Length:=El[El[m1].Link].Length+1;
        El[El[m1].Link].Code:=El[El[m1].Link].Code shl 1;
        m1:=El[m1].Link;
        end;
      El[m1].Link:=m2;
      El[m2].Code:=(El[m2].Code shl 1)+1;
      while El[m1].Link>=0 do
        begin
        El[El[m1].Link].Length:=El[El[m1].Link].Length+1;
        m1:=El[m1].Link;
        El[El[m1].Link].Code:=(El[El[m1].Link].Code shl 1)+1;
        end;
    end;
end;//Закончили создание древа


procedure TForm1.BitBtn1Click(Sender: TObject);
var//Описание пременных
  i, k, FS : DWord;//Различные счётчики
  FInput: file;//Переменная для файла
  Buf: array[0..BufSize-1] of AnsiChar;//Буферный массив
  NumRead:Integer;
begin
OD.Filter:='';//фильтр открытия файла
if not OD.Execute then exit;
  StatusBar1.Panels[0].Text:=OD.FileName;//Выводим директорию файла в панель снизу
  for i:=0 to StringGrid1.ColCount-1 do //Обработка таблицы
  StringGrid1.Cells[i,1]:='';//Очищаем таблицу
  StringGrid1.RowCount:=2;//Возвращаем две строки
  AssignFile(FInput,OD.FileName);//Связываем дескриптор файла с текстовым файлом
  Reset(FInput,1); //Открываем текстовый файл для чтения
  if FileSize(FInput)=0 then //Проверяем размер открытого файла
    begin
    ShowMessage('Файл пуст...'); //Если он равен 0 то выдаём сообщение
    exit; //Выходим   из процедуры
    end;//Конец процедуры
  ProgressBar1.Position:=0;//Ставим полосу в начальн положение
  ProgressBar1.Max:=(FileSize(FInput) div BufSize);
  ProgressBar1.Visible:=true;//Показываем полосу прогресса
  ClearTree; //Очищаем древо
  repeat//Цикл на считвывание символов
  BlockRead(FInput,Buf,SizeOf(Buf),NumRead);//Считываем символы
  RichEdit1.Text:=buf;//Выводим текст
  Application.ProcessMessages;//Команда для выполнения текущих задач
  if NumRead>0 then
    for i:=0 to NumRead-1 do
      begin
      inc(El[ord(Buf[i])].Count);//Увелииваем количество
      inc(El[ord(Buf[i])].E);//Увеличиваем частоту
      end;
  ProgressBar1.Position:=ProgressBar1.Position+1;//Наращиваем полосу прогресса
  until (NumRead<SizeOf(Buf));//Повторяем до тех пор пока буфер не наполнился
  FS:=FileSize(FInput);//Считываем размер файла
  CreateTree(FS);//Строим древо
  k:=0;//Обнуляем счётчик
  for i:=0 to 255 do //Выводим все данные по тексту
    if El[i].Length<>0 then
      begin
      StringGrid1.RowCount:=StringGrid1.RowCount+1;// Наращиваем число строк
      StringGrid1.Cells[0,i+1-k]:=IntToStr(i); // Код символа в ASCII
      StringGrid1.Cells[1,i+1-k]:=Chr(i);//Сам символ
      StringGrid1.Cells[2,i+1-k]:=IntToStr(El[i].E);// Частота
      StringGrid1.Cells[3,i+1-k]:=IntToStr(El[i].Length);//Длина
      StringGrid1.Cells[4,i+1-k]:=BitsToStr(El[i].Code,El[i].Length); //Код Хаффмана
    end
    else k:=k+1;
  StringGrid1.RowCount:=StringGrid1.RowCount-1;
  CloseFile(FInput);//Закрываем входной файл
  ProgressBar1.Visible:=false;//Скрываем полосу загрузки

end;//Закончили открытие файла


procedure TForm1.Button1Click(Sender: TObject);
var
  Code,tmp:String;
  FInput, FOutput: file;
  Ost: Word;
  Buf: array[0..BufSize-1] of AnsiChar;
  NumRead:Integer;
  i,j,k:integer;
  FS:DWord;
begin
  AssignFile(FInput,OD.FileName);//Входной файл
  AssignFile(FOutput,OD.FileName+'.asd');//Выходной файл
  Rewrite(FOutput,1);//Открываем файл для записи
  Reset(FInput,1); //Открываем текстовый файл для чтения
  Seek(FInput,0);  //Перемещаем указатель в  файле в новую позицию
  repeat
  BlockRead(FInput,Buf,BufSize,Numread);//Считываем символы в буфер
  if NumRead>0 then
    for i:=0 to Numread-1 do
    begin
    tmp:='';
    Ost:=El[ord(Buf[i])].Code;
    for j:=0 to El[ord(Buf[i])].Length-1 do
      begin
      Code:=Concat(Code,IntToStr(Ost mod 2));
      Ost:=Ost shr 1;
      end;
    end;
  until (NumRead<SizeOf(Buf));
  j:=0;
  for i:=0 to 255 do
    if El[i].E>0 then
      inc(j);
  if j=256 then j:=0;
  Buf[0]:=Ansichar(chr(j));
  k:=1;
  for i:=0 to 255 do
    if El[i].E>0 then
      begin
      Buf[k]:=Ansichar(chr(i));
      inc(k);
      FS:=El[i].E;
      for j:=1 downto 0 do
        begin
        Buf[k+j]:=Ansichar(chr(FS mod 256));
        FS:=FS shr 8;
        end;
      inc(k,2);
      end;
  BlockWrite(FOutput,Buf,k);
  tmp:=code;
  code:='';
  for i:=0 to length(tmp)-1 do
    begin
    code:=concat(code,tmp[Length(tmp)]);
    delete(tmp,Length(tmp),1);
    end;
  if Length(Code)mod 8>0 then
    j:=Length(Code)div 8 +1
  else j:=Length(Code)div 8;
  i:=0;
  while i<j do
    begin
    while (i<SizeOf(Buf))and(i<j) do
      begin
      buf[i]:=Ansichar(Chr(BitToByte(Code)));
      inc(i);
      end;

    BlockWrite(FOutput,Buf,i);
    if i<j then
      begin
      dec(j,i);
      i:=0;
      end;
    end;

  ProgressBar1.Visible:=false;//Скрыли ролосу загрузки
  CloseFile(FOutput);//Закрыли выходной файл
  CloseFile(FInput);//Закрыли входной файл
  ShowMessage('Файл закодирован.'); //Сообщение о завершении кодирования
end;

procedure TForm1.Button2Click(Sender: TObject);
type//Описание типа вручную
  TE=record //Тип типа запись
    Code:string;//Пременная под код
    byte:byte;//Под байты
  end; //Закончили описание
var //Описываем переменные
archiv,normal:File;//Переменные под файлы
FS:DWord;
Buf: array[0..BufSize-1] of AnsiChar;//Буферный массив
i,j:integer;//Разные счётчики
NumRead:integer;
Code:string;//Переменная под код
E:array of TE;
tmp:string;
T:Word;
k:integer; //Счётчик
CountBits:DWord;
begin
OD.Filter:='Archive file|*.asd'; //Фильтр открытия файла
if not OD.Execute then exit;//Если нет файла выходим
if not SD.Execute then exit; //Если нет файла выходим
ClearTree;//Очищаем дерево
AssignFile(archiv,OD.FileName); //Откываем для чтения файл из Open Dialog
AssignFile(normal,SD.FileName); //Открываем для чтения файл из Save Dialog
Reset(archiv,1);//Считываем кодированный файл
ReWrite(normal,1);//Отрываем файл для записи
FS:=filesize(archiv);//Размер закодированного файла
if FS>SizeOf(Buf) then
  FS:=SizeOf(Buf);
BlockRead(archiv,buf,FS);//Считываем символы в буфер
j:=1;
FS:=0;
k:=ord(Buf[0]);
if k=0 then k:=256;
SetLength(E,k);
for i:=0 to k-1 do
  begin
  E[i].byte:=ord(Buf[j]);
  El[ord(Buf[j])].Count:=ord(buf[j+1])*256 + ord(buf[j+2]);
  El[ord(Buf[j])].E:=El[ord(Buf[j])].Count;
  inc(FS,El[ord(Buf[j])].Count);
  inc(j,3);
  end;
CreateTree(FS);//Строим дерево

for i:=0 to Length(E)-1 do
  begin
  T:=El[E[i].byte].Code;
  tmp:='';
  for j:=0 to El[E[i].byte].Length-1 do
    begin
    tmp:=tmp+IntToStr(T mod 2);
    T:=T shr 1;
    end;

    begin
    E[i].Code:=tmp;
    end;
  end;
Seek(archiv,k*3+1);
repeat
BlockRead(archiv,Buf,SizeOf(Buf),NumRead);
if NumRead>0 then
  begin
  i:=0;
  while i<NumRead do
    begin
    Code:=concat(Code,ByteToStr(ord(Buf[i])));
    inc(i);
    end;
  end;
until NumRead<SizeOf(Buf);
CloseFile(archiv);
tmp:=code;
code:='';
for i:=1 to Length(tmp) do
  Code:=concat(code,tmp[Length(tmp)-i+1]);
for j:=0 to Length(E)-1 do
  begin
  tmp:=E[j].Code;
  E[j].Code:='';
  for i:=1 to length(tmp) do
    E[j].Code:=E[j].Code+tmp[Length(tmp)-i+1];
  end;

i:=0;//Обнуление счётчика
k:=0;//Обнуление счётчика
while i<FS do
  begin
  for j:=0 to Length(E)-1 do
    if Check(E[j].Code,Code) then
      begin
      buf[k]:=Ansichar(chr(E[j].byte));
      Delete(Code,Length(Code)-Length(E[j].Code)+1,Length(E[j].Code));
      if j mod 100 =0 then
        begin
        Application.ProcessMessages;//Выполняем задачи на данный момент
        end;
      inc(k);//Наращиваем k
      break;
      end;
  if k=SizeOf(Buf) then
    begin
    BlockWrite(normal,buf,sizeof(buf));//Открываем файл для внесения раскодированного текста
    k:=0;//Обнуляем счётчик
    end;
  inc(i);//Наращиваем счётчик
  end;
BlockWrite(normal,buf,k);//Записываем раскодированные символы в файл
CloseFile(Normal);//Закрыли файл
ShowMessage('Файл создан...');//Сообщение о созданном файле
end;


procedure TForm1.FormCreate(Sender: TObject);
begin //Задаём
StringGrid1.Cells[0,0]:='Код'; //Код в ASCII
StringGrid1.Cells[1,0]:='Символ';//Символ
StringGrid1.Cells[2,0]:='Частота'; //Частота встречаемости
StringGrid1.Cells[3,0]:='Длина'; //Длина кода
StringGrid1.Cells[4,0]:='Код Хаффмана'; //Код Хафффмана
end;

end.

задан 21:58, 19.04.2017
ava 

Ответы (1)

при нажатие на кнопку декодировать прога зависает 

отвечен 22:07, 19.04.2017
ava 


Зарегистрируйтесь или войдите, чтобы написать.
Фирма дня
Вы также можете добавить свою фирму в каталог IT-фирм, и публиковать статьи, новости, вакансии и другую информацию от имени фирмы.
Подробнее
Участники
advanced
Отправить