::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2003-04-01 00:05:48, Hit : 4508, Vote : 1205
 http://www.howto.pe.kr
 Huffman 압축 알고리즘

// RLE(Run-Length Encoding) 알고리즘은 http://www.howto.pe.kr의
//   "Delphi"->"강좌/소스/문서" 에 예제와 함께 있습니다

unit HuffFuncs;

interface

uses classes,sysutils,windows;

type
Phuffinfo=^Thuffinfo;
THuffInfo=record
  left:phuffinfo;
  right:phuffinfo;
  code: array[0..255] of byte;
  codecount:integer;
  huff,char:byte;
  freq:integer;
  ticked:boolean;
end;
THuffcode=record
  char:byte;
  used:boolean;
  code:array[0..255] of byte;
  codelength:integer;
end;
PhuffCode=^THuffCode;

type
EError=class(Exception);
procedure Initialize;
function SetInputfile(afilename:string):boolean;
function SetOutputfile(afilename:string):boolean;
procedure Compress(var usize,csize:integer);
procedure Decompress;
procedure Finalize;

var
huffcodes: array[0..255] of Thuffcode;
implementation

procedure GetDistribution;forward;
procedure InitList;forward;
procedure BuildTree;forward;
procedure GetCodes;forward;
procedure GetTable;forward;
function GetCompressedSize:integer;forward;
procedure RetrieveTable; forward;
procedure ReconstructTree;forward;
procedure WriteCompressedFile;forward;
procedure WriteUncompressedFile;forward;

var
Charlist:array[0..511] of THuffinfo;
ifile,ofile:Tfilestream;
infile,outfile:string;
InBuffer,OutBuffer:array[0..32767] of byte;
ufilesize,cfilesize:integer;
rootnode:Phuffinfo;
table: array[0..1495] of byte;
tabsize:integer;
endbits:byte;

procedure Initialize;
begin
zeromemory(@charlist,sizeof(charlist));
zeromemory(@table,sizeof(table));
zeromemory(@huffcodes,sizeof(huffcodes));
infile:='';
outfile:='';
endbits:=0;
ufilesize:=0;
cfilesize:=0;
rootnode:=nil;
end;
procedure Finalize;
begin
freeandnil(ifile);
freeandnil(ofile);
end;

function SetInputfile(afilename:string):boolean;
begin
result:=fileexists(afilename);
if result=true then
  begin
   ifile:=Tfilestream.create(afilename,fmOpenRead or fmShareDenyNone);
   infile:=afilename;
   ufilesize:=GetFileSize(ifile.Handle,nil);
  end
else
  raise EError.Create('Invalid Filename');

end;

procedure InitList;
var
i:integer;
begin
zeromemory(@charlist,sizeof(charlist));
zeromemory(@huffcodes,sizeof(huffcodes));
for i:=0 to 255 do
  begin
   charlist[i].code[charlist[i].codecount]:=i;
   inc(charlist[i].codecount);
  end;
end;

function SetOutputfile(afilename:string):boolean;
begin
ofile:=Tfilestream.create(afilename,fmCreate or fmShareDenyNone);
outfile:=afilename;
result:=true;
end;

procedure GetDistribution;
var
i:integer;
bufcount:integer;
begin
bufcount:=ifile.read(inbuffer,32768);
repeat
  for i:=0 to bufcount-1 do
   charlist[inbuffer[i]].freq:=charlist[inbuffer[i]].freq+1;
  bufcount:=ifile.read(inbuffer,32768);
until bufcount=0;
end;

procedure BuildTree;
var
i,cnt,tmp:integer;
pinfo1,pinfo2:Phuffinfo;
begin
pinfo1:=nil;
pinfo2:=nil;
cnt:=255;
while true do
  begin
   tmp:=maxint;
   for i:=0 to cnt do
    begin
     if (charlist[i].freq<tmp) and (charlist[i].freq > 0) and(charlist[i].ticked=false) then
      begin
       pinfo1:=@charlist[i];
       tmp:=pinfo1.freq;
      end;
    end;
   if pinfo1=nil then
    break;
   pinfo1.ticked:=true;
   tmp:=maxint;
   for i:=0 to cnt do
    begin
     if (charlist[i].freq<tmp) and (charlist[i].freq > 0) and (charlist[i].ticked=false) then
      begin
       pinfo2:=@charlist[i];
       tmp:=pinfo2.freq;
      end;
    end;
   if pinfo2=nil then
    break;
   pinfo2.ticked:=true;
   inc(cnt);
   charlist[cnt].freq:=pinfo1.freq+pinfo2.freq;
   strcat(@charlist[cnt].code,@pinfo1.code);
   strcat(@charlist[cnt].code,@pinfo2.code);
   charlist[cnt].codecount:=pinfo1.codecount+pinfo2.codecount;
   charlist[cnt].left:=pinfo1;
   charlist[cnt].right:=pinfo2;
   pinfo1:=nil;
   pinfo2:=nil;
  end;
rootnode:=@charlist[cnt];
end;

procedure GetCodes;
var
i,j:integer;
tmpnode:phuffinfo;
flag:integer;
begin
for i:=0 to 255 do
  begin
   flag:=-1;
   tmpnode:=rootnode;
   while tmpnode.left<>nil do
    begin
     for j:=0 to tmpnode.left.codecount-1 do
      if tmpnode.left.code[j]= i then
       begin
        flag:=0;
        tmpnode:=tmpnode.left;
        break;
       end;
      if flag=-1 then
       begin
        for j:=0 to tmpnode.right.codecount-1 do
         if tmpnode.right.code[j]= i then
          begin
           flag:=1;
           tmpnode:=tmpnode.right;
           break;
          end;
       end;
     if flag=-1 then
      break;
     huffcodes[i].used:=true;
     huffcodes[i].code[huffcodes[i].codelength]:=flag;
     huffcodes[i].codelength:=huffcodes[i].codelength+1;
     huffcodes[i].char:=i;
     flag:=-1;
    end;
  end;
end;

procedure WriteCompressedFile;
var
i,j,k:integer;
tmpcode:byte;
bit:integer;
bufcount:integer;
begin
k:=0;
tmpcode:=0;
bit:=0;
ofile.seek(1,sofrombeginning);
ofile.write(tabsize,sizeof(tabsize));
ofile.write(table,tabsize);
ifile.seek(0,soFromBeginning);
bufcount:=ifile.read(inbuffer,32768);
repeat
  for i:=0 to bufcount-1 do
   begin
    for j:=0 to huffcodes[inbuffer[i]].codelength-1 do
     begin
      tmpcode:=(tmpcode shl 1) or huffcodes[inbuffer[i]].code[j];
      inc(bit);
      if bit=8 then
       begin
        outbuffer[k]:=tmpcode;
        inc(k);
        bit:=0;
        tmpcode:=0;
       end;
      if k=32768 then
       begin
        ofile.write(outbuffer,32768);
        k:=0;
       end;
     end;
   end;
  bufcount:=ifile.read(inbuffer,32768);
until bufcount=0;
if bit>0 then
  begin
   tmpcode:=tmpcode shl (8-bit);
   outbuffer[k]:=tmpcode;
   k:=k+1;
  end;
if k>0 then
  ofile.write(outbuffer,k);
ofile.seek(0,sofrombeginning);
ofile.write(bit,1);
end;


procedure Compress(var usize,csize:integer);
begin
Initlist;
GetDistribution;
BuildTree;
GetCodes;
GetTable;
WriteCompressedFile;
usize:=ufilesize;
csize:=GetCompressedsize;
end;

function GetCompressedSize:integer;
var
i:integer;
begin
result:=0;
for i:=0 to 255 do
  begin
   if huffcodes[i].used then
    result:=result+huffcodes[i].codelength*charlist[i].freq;
  end;
cfilesize:=result div 8;
if result mod 8>0 then
  cfilesize:=cfilesize+1;
cfilesize:=cfilesize+tabsize+sizeof(tabsize)+1;
result:=cfilesize;
end;

procedure GetTable;
var
i,j,k:integer;
tmpcode:byte;
bit:integer;
begin
k:=0;
bit:=0;
tmpcode:=0;
for i:=0 to 255 do
  begin
   if huffcodes[i].used=false then
    continue;
   table[k]:=i;
   table[k+1]:=huffcodes[i].codelength;
   k:=k+2;
   for j:=0 to huffcodes[i].codelength-1 do
    begin
     tmpcode:=tmpcode shl 1 or huffcodes[i].code[j];
     bit:=bit+1;
     if bit=8 then
      begin
       table[k]:=tmpcode;
       k:=k+1;
       bit:=0;
       tmpcode:=0;
      end;
    end;
   if bit>0 then
    begin
     tmpcode:=tmpcode shl (8-bit);
     table[k]:=tmpcode;
     k:=k+1;
     bit:=0;
     tmpcode:=0;
    end;
  end;
tabsize:=k;
end;

procedure RetrieveTable;
var
j,k,l:integer;
index:integer;
length,cnt:integer;
tmpcode:byte;
begin
ifile.seek(0,soFromBeginning);
ifile.read(endbits,1);
if endbits=0 then
  endbits:=8;
ifile.Read(table,sizeof(table));
tabsize:=pinteger(@table[0])^;
k:=sizeof(tabsize);
while k<tabsize+sizeof(tabsize) do
  begin
   j:=0;
   index:=table[k];
   k:=k+1;
   length:=table[k];
   k:=k+1;
   huffcodes[index].used:=true;
   huffcodes[index].char:=index;
   huffcodes[index].codelength:=length;
   while j<=length-1 do
    begin
     tmpcode:=table[k];
     k:=k+1;
     if (length-j)>8 then
      cnt:=8
     else
      cnt:=length-j;
     for l:=1 to cnt do
      begin
       huffcodes[index].code[l+j-1]:=(tmpcode shr (8-l)) and 1;
      end;
     j:=j+cnt;
    end;
  end;
end;

procedure ReconstructTree;
var
rinfo:phuffinfo;
i,j,k:integer;
begin
k:=0;
zeromemory(@charlist,sizeof(charlist));
for i:=0 to 255 do
  begin
   rinfo:=@charlist[511];
   for j:=0 to huffcodes[i].codelength-1 do
    begin
     charlist[k].huff:=huffcodes[i].code[j];
     if huffcodes[i].code[j]= 0 then
      begin
       if rinfo.left=nil then
        begin
         rinfo.left:=@charlist[k];
         k:=k+1;
        end;
       rinfo:=rinfo.left;
      end
     else
      begin
       if rinfo.right=nil then
        begin
         rinfo.right:=@charlist[k];
         k:=k+1;
        end;
       rinfo:=rinfo.right;
      end;
     if j=huffcodes[i].codelength-1 then
      rinfo.char:=huffcodes[i].char;
    end;
  end;
end;

procedure WriteUncompressedFile;
var
bufcount,i,j,l:integer;
tmpbit,tmpbyte:byte;
tmpnode:phuffinfo;
begin
i:=0;j:=1;l:=0;
tmpnode:=@charlist[511];
ifile.seek(tabsize+sizeof(tabsize)+1,soFromBeginning);
ofile.seek(0,soFromBeginning);
bufcount:=ifile.read(inbuffer,32768);
tmpbyte:=inbuffer[0];
i:=i+1;
repeat
  while true do
   begin
    while (tmpnode.left<>nil) do
     begin
      if j>8 then
       begin
        tmpbyte:=inbuffer[i];
        i:=i+1;
        if i=bufcount then
         begin
          bufcount:=ifile.read(inbuffer,32768);
          i:=0;
         end;
        j:=1;
       end;
      tmpbit:=(tmpbyte shr (8-j)) and 1;
      if tmpnode.left.huff=tmpbit then
       begin
        tmpnode:=tmpnode.left;
        j:=j+1;
       end
      else
       begin
        tmpnode:=tmpnode.right;
        j:=j+1;
       end;
     end;
    OutBuffer[l]:=tmpnode.char;
    l:=l+1;
    tmpnode:=@charlist[511];
    if l=32768 then
     begin
      ofile.write(outbuffer,32768);
      l:=0;
     end;
    if (bufcount=0) and (i=0) and (j>endbits) then
     break;
   end;
until bufcount=0;
if l>0 then
  ofile.write(outbuffer,l);
end;

procedure Decompress;
begin
RetrieveTable;
ReConstructTree;
WriteUncompressedfile;
end;

end.





771   [일반/컴포넌트] thread-safe Queue를 이용한 TLogThread  김영대 2003/11/18 4572 1083
770   [알고리즘] 구분자(delimiter)를 사용한 문자열 파싱(parsing)  김영대 2003/11/13 4983 1091
769   [일반/컴포넌트] StrToFloatDef  김영대 2003/11/13 4768 1214
768   [알고리즘] 숫자를 KB, MB, GB 단위로 환산하기  김영대 2003/11/13 4851 1107
767   [일반/컴포넌트] thread-safe Queue 구현  김영대 2003/08/18 5557 1151
766   [COM/OLE] 기존 Excel 문서 불러와서 편집후 저장하기  김영대 2003/04/18 5148 1235
765   [일반/컴포넌트] C에서 한글자르기  공성환 2003/04/16 4603 906
764   [COM/OLE] 그리드 자료 엑셀로 좀더 빠르게 보내기  공성환 2003/04/16 5274 915
763   [윈도우즈 API] 폼이 Minimized 되었을때 깜박이게 하기 2  김영대 2003/04/14 5520 1256
762   [일반/컴포넌트] 키보드의 Shift+Tab 이 눌린것처럼 처리하기  김영대 2003/04/14 4561 1260
761   [윈도우즈 API] 콤포넌트의 Hint 에 그림(Bitmap) 넣기  김영대 2003/04/11 4975 1294
760   [윈도우즈 API] 콤포넌트에 풍선 도움말 달기  김영대 2003/04/11 5591 1309
759   [윈도우즈 API] TScrollBox 안에 Animation으로 Form 띄우기  김영대 2003/04/11 4464 1252
758   [일반/컴포넌트] 동적으로 프로젝트의 Main form 바꾸기  김영대 2003/04/11 4650 1141
757   [시스템] 파일 복사하면서 진행상태와 남은 시간 표시하기  김영대 2003/04/10 5855 1199
756   [시스템] 실행중인 모든 프로그램의 실행파일명 구하고 검색하기  김영대 2003/04/10 5499 1219
755   [시스템] 파일(들)을 클립보드로 복사하여 탐색기에서 붙여넣기 하기  김영대 2003/04/10 5265 1350
754   [일반/컴포넌트] GIF 이미지의 width/height 구하기  김영대 2003/04/10 4452 1194
753   [윈도우즈 API] 4가지 윈도우즈 관련 폴더의 path 구하기  김영대 2003/04/08 5627 1271
752   [일반/컴포넌트] Thread in a Timer  김영대 2003/04/07 6732 1066
751   [알고리즘] 주어진 구분자(들)로 분리된 토큰(token)문자열 구하기  김영대 2003/04/02 4494 1026
750   [일반/컴포넌트] Form의 Caption 에서의 Click 알아내기  김영대 2003/04/01 3995 997
749   [윈도우즈 API] 키보드 입력 로케일(Locale) 구하기  김영대 2003/04/01 4086 1007
748   [윈도우즈 API] "내 컴퓨터"에 있는 폴더들의 디렉토리 구하기  김영대 2003/04/01 5119 1466
747   [윈도우즈 API] 네트워크 환경의 "컴퓨터 찾아보기" 화면 띄우기  김영대 2003/04/01 4951 1144
  [알고리즘] Huffman 압축 알고리즘  김영대 2003/04/01 4508 1205
745   [일반/컴포넌트] Windows의 사용자이름, 작업그룹 구하기  김영대 2003/04/01 4726 1167
744   [일반/컴포넌트] ComboBox에 IE의 URL 입력창 같은 근접검색 두기  김영대 2003/03/31 4447 1107
743   [윈도우즈 API] RichEdit에서 URL을 HyperLink 로 표시하기  김영대 2003/03/31 5262 1238
742   [일반/컴포넌트] 이미지를 마우스로 drag시 테두리 효과를 주면서 이동 시키기  김영대 2003/03/31 5023 1149
741   [일반/컴포넌트] PageControl의 TabSheet 마다 PopupMenu 두기  김영대 2003/03/31 5013 1196
740   [일반/컴포넌트] Delphi의 Tokenizer TParser 사용 예제  김영대 2003/03/31 4610 1209
739   [일반/컴포넌트] 네트워크 컴퓨터의 레지스트리 접근하기  김영대 2003/03/31 4203 1059
738   [네트웍/인터넷] 윈도우즈 네트워크로 메시지 보내기  김영대 2003/03/30 5146 1150
737   [네트웍/인터넷] IP로 이름 구하기 또는 이름으로 IP 구하기  김영대 2003/03/30 4765 1235
736   [일반/컴포넌트] IE "시작 페이지" 읽어오고 바꾸기  김영대 2003/03/30 5644 1368
735   [일반/컴포넌트] URL encoding 하기  김영대 2003/03/30 4440 1142
734   [일반/컴포넌트] URL 을 각 part로 분리하기  김영대 2003/03/30 4771 1223
733   [일반/컴포넌트] 기본 SMTP 서버와 계정 알아내기  김영대 2003/03/30 4340 1084
732   [일반/컴포넌트] Microsoft Internet Explorer의 버전 번호  김영대 2003/03/30 4182 1079

[1][2][3][4][5] 6 [7][8][9][10]..[25] [다음 10개]
 

Copyright 1999-2019 Zeroboard / skin by zero