| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Сжатие данных [D7, WinXP]
Logun © (2004-11-07 01:02:00)Доброй ночи!
Есть задачка написать архиватор на основе полуадаптивной схемы и алгоритма Хаффмана.
Подскажите пожалуйста ссылочкии по теме, может исходники где есть. Буду очень признателен
Defunct (2004-11-07 05:18:00) [1]Более того, судя по асм коду, это было для процессора 8088.
Defunct (2004-11-07 05:15:00) [2]PS: то что я привел [1,2], разумеется для TP7.
Defunct (2004-11-07 05:12:00) [3]Распаковщик:
Program BitMapAnaliz;
Var B,B1:Array[0..32000] Of Byte;
I,N,W:Word;
E:Array[0..3] Of Word;
BitMap:Array[0..3] Of Byte;
F:File;
PakByte:Byte;
Procedure InitArray;
Begin
Assign(F,ParamStr(1));
Reset(F,1);
BlockRead(F,B,32000,N);
Dec(N);
Close(F);
End;
Procedure CreateBitMap;
Begin
PakByte:=B[0];
Asm
Push Ds
Pop Es
Mov Cx,4
Mov Di,OffSet BitMap
Mov AL,PakByte
@@LL1:
Mov AH,0
Shl Ax,1
Shl Ax,1
Xchg Ah,Al
Stosb
Xchg AH,AL
Loop @@LL1
End
End;
Procedure UnPakStream;
Var NumberOfMap:Byte;
CodeInDL:Byte;
TekCL,NextBit:Byte;
Begin
NumberOfMap:=3; W:=0;
CodeInDL:=0; TekCL:=0;
For I:=1 To N Do
Begin
Asm
Push Ds
Pop Es
Mov DL,CodeInDL
Mov NextBit,8
Mov Si,I
Add Si,OffSet B
LodsB { В AL закодированный символ}
@@L0: Xor Cx,Cx
Mov CodeInDL,DL { сохраним текущий DL }
Mov CL,TekCL
@@L1:
Mov TekCL,CL
Dec NextBit
Js @@Exit
Shl AL,1
Jnc @@CreateSumbol
Inc Cx
Cmp CL,3
Jnz @@L1
@@CreateSumbol: { на этой метке CL содержит номер из BitMap }
Mov Si,Cx
Add Si,OffSet BitMap
Push Ax
LodsB { читаем в AL сивол из BitMap }
Mov TekCL,0
Shl DL,1
Shl DL,1
Add DL,AL
Pop Ax
Dec NumberOfMap { уменьшим позицию в байте }
Jns @@L0 { если позиция не была равна 0, то повторим}
Mov NumberOfMap,3 { иначе загрузим верхнее значение }
Push Ax
Mov AL,DL { подготовим выходной байт }
Mov Di,W
Add Di,OffSet B1
StosB { запишем в выходной поток }
Pop Ax
Inc W { увеличим позицию байта в потоке }
Mov DL,0 { обнулим текущий байт }
Jmp @@L0
@@Exit:
End;
End;
End;
Begin
InitArray;
CreateBitMap;
UnPakStream;
WriteLn('BitMap is => ');
WriteLn(BitMap[0]);
WriteLn(BitMap[1]);
WriteLn(BitMap[2]);
WriteLn(BitMap[3]);
WriteLn;
WriteLn('Длинна входного потока => ',N);
WriteLn('Длинна распакованного потока => ',W+1);
WriteLn('поток записан в файл UnPak.MDP');
Assign(F,'UnPak.MDP');
ReWrite(F,1);
BlockWrite(F,B1,W+1);
Close(F);
End.
Здесь строго соблюден алгоритм Хаффмана ни более ни менее.
Defunct (2004-11-07 05:10:00) [4]Алгоритм Хаффмана основанный на битовом дереве?
есть что-то подобное, но очень-очень старое, так что за код не ручаюсь.
Упаковщик:
{$D+}
Program BitMapAnaliz;
Const Code : Array[0..3] of Word = ($0703, $0603, $0202, $0001);
Var B,B1:Array[0..32000] Of Byte;
I,N,W:Word;
E:Array[0..3] Of Word;
Ves:Array[0..3] Of Byte;
F:File;
PakByte:Byte;
Procedure InitArray;
Begin
Assign(F,ParamStr(1));
Reset(F,1);
BlockRead(F,B,32000,N);
Dec(N);
Close(F);
End;
Procedure InitStrukture;
Begin
For I:=0 To 3 Do
Begin
E[i]:=0;
Ves[i]:=0;
End;
End;
Procedure ByteAnaliz(B:Byte);Assembler;
Asm
Xor Ax,Ax
Mov AL,B
Mov Cx,4
@@Start:
Shl Ax,1
Shl Ax,1
Or Ah,Ah
Jnz @@L1
Inc Word Ptr [E]
Jmp @@Exit
@@L1:
Shr AH,1
JC @@L2
Inc Word Ptr [E+4]
Jmp @@Exit
@@L2:
Shr AH,1
JC @@L3
Inc Word Ptr [E+2]
Jmp @@Exit
@@L3:
Inc Word Ptr [E+6]
@@Exit:
Loop @@Start
End;
Procedure GeneratePakByte;
Var B1,B2,BF:Byte;
Begin
PakByte:=0;
For I:=0 To 3 Do
For W:=0 To 3 Do
If E[i]>E[w] Then Inc(Ves[i]);
For I:=0 To 3 Do
Begin
B1:=Ves[i];
Asm
Mov Ax,I
Mov CL,B1
Shl Cl,1
Shl AL,CL
Mov B2,AL
End;
PakByte:=PakByte Or B2;
End;
End;
Procedure PakStream;
Var LenthOfDx:Byte;
CodeInDx:Word;
Begin
W:=0;LenthOfDx:=0;
CodeInDx:=0;
For I:=0 To N Do
Begin
Asm
Push Ds
Pop Es
Mov Dx,CodeInDx
Mov BL,LenthOfDx
Mov Cx,4
Mov Si,I
Add Si,OffSet B
LodsB
@@StartPByte:
Mov AH,0
SHL Ax,1
SHL Ax,1
Push Cx
Mov CL,AH
Mov DI,Cx
Mov CL,Byte Ptr DS:[Ves+Di]
Shl CL,1
Mov Di,Cx
Mov Cx,Word Ptr DS:[Code+Di] { в CL - длинна кода (бит) }
Push Cx
CMP BL,8
Jna @@NotProblem
{ Сдесь формирование выходного байта }
Mov Di,W
Add Di,OffSet B1
Mov CL,16
Sub CL,BL
Push Cx
SHL Dx,Cl
Push Ax
Mov AL,DH
StosB
Pop Ax
Pop Cx
Sub BL,8
Shr Dx,Cl
Inc W
@@NotProblem:
Pop Cx
Add BL,CL
SHL Dx,CL { сдвинем Dx на длиину поступившего}
Add DL,CH { кода, и поместим его в DL}
Pop Cx
Loop @@StartPByte
Mov CodeInDx,Dx
Mov LenthOfDx,BL
End;
End;
Asm
Mov Di,W
Add Di,OffSet B1
Mov CL,16
Sub CL,LenthOfDx
Push Cx
SHL Dx,Cl
Push Ax
Mov AL,DH
StosB
Pop Ax
Pop Cx
Sub LenthOfDx,8
Shr Dx,Cl
Inc W
End;
End;
Begin
InitArray;
InitStrukture;
For I:=0 To N Do
ByteAnaliz(B[i]);
GeneratePakByte;
{ ByteAnaliz($01);
ByteAnaliz($FF);}
WriteLn('00 -> ',E[0]);
WriteLn('01 -> ',E[1]);
WriteLn('10 -> ',E[2]);
WriteLn('11 -> ',E[3]);
WriteLn;
WriteLn('00 -> ',Ves[0]);
WriteLn('01 -> ',Ves[1]);
WriteLn('10 -> ',Ves[2]);
WriteLn('11 -> ',Ves[3]);
WriteLn;
WriteLn('PakByte is => ',PakByte);
PakStream;
WriteLn('Длинна входного потока => ',N+1);
WriteLn('Длинна выходного потока => ',W+1);
WriteLn('Выходной поток сохранён в файл Out.mdp');
Assign(F,'Out.Mdp');
ReWrite(F,1);
BlockWrite(F,PakByte,1);
BlockWrite(F,B1,W+1);
Close(F);
End.
| |
