2005年08月04日

zlibを使用しデータを圧縮/解凍する方法

あなたはムーアの法則をご存知でしょうか?
「半導体の集積密度は18〜24ヶ月で2倍になる」
という法則ですが、
現在では「集積密度」を「性能向上」に
置き換え考えられることが多く、
今後の半導体などの
性能向上を予測する指標となっています。

ムーアの法則に従うがごとく
CPUやBUSの性能が向上する一方で、
我々が扱う情報のデータ量も飛躍的に増加しています。
大量のデータ転送はシステムの顕著なボトルネックとして、
しばしば我々が直面する問題となることでしょう。

今回は、データ転送などの制約やボトルネックの
問題を解決する方法としデータの圧縮を取上げます。
zlibはZip、gzip、画像フォーマットPNGで使われている
圧縮アルゴリズムをライブラリ化したものです。
DelphiではBorland社から
「zlib」ユニットとして提供されています。

サンプルプログラムは、
Delphi標準のzlibユニットを利用し、
入力されたファイルをzlib形式で圧縮する機能と、
zlib形式のファイルを解凍する機能を提供します。

サンプルプログラムをよく理解し、
あなたの問題を解決するために役立ててください。

zlib公式サイトは以下のURLを参照してください。

URL:http://www.zlib.net/


全ソースは【続きを読む】をクリック!

使用例
procedure TForm1.btnCompressClick(Sender: TObject);
var
 lSData,
 lDData: Pointer;
 lSSize,
 lDSize,
 lLevel: Integer;
begin
 lSData := Nil;
 lDData := Nil;
 try
  // ファイルのデータを読込みます
  _ReadFile(edtFileName.Text, lSData, lSSize);
  // ファイルのデータを圧縮します
  case rgCompressMode.ItemIndex of
  0:lLevel := Z_NO_COMPRESSION;
  1:lLevel := Z_BEST_SPEED;
  2:lLevel := Z_BEST_COMPRESSION;
  end;
  CompressBuf(lLevel, lSData, lSSize, lDData, lDSize);
  // 圧縮データをファイルへ書き込みます
  _WriteFile(Format('%s.cmp',
   [edtFileName.Text]), lDData, lDSize);
 finally
  if (lSData <> Nil) then FreeMem(lSData);
  if (lDData <> Nil) then FreeMem(lDData);
 end;
end;


【画面イメージ】

ZLIBTester.gif

関連書籍


Copyright guy@かしらもんじ でぇ〜

注意:
 下記ソースファイルは、本ページの管理者である「guy」が個人的に作成しました。
 このソースは作者に断り無く、個人がコピー、改造することは許可しますが、
 いかなる場合であっても、商用目的に使用することを固く禁じます。
 あと、ホームページでの公開の都合上、各ソースの先頭に全角スペースが入ってます。
 あなたがDelphiでコンパイルする前に、この全角スペースを半角スペースに変換してくださいね。

Delphi Project File: ZLIBTester.dpr
program ZLIBTester;

uses
 Forms,
 ZLIBTesterUnit in 'ZLIBTesterUnit.pas' {Form1};

{$R *.res}

begin
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.


Delphi Form File: ZLIBTesterUnit.dfm
object Form1: TForm1
 Left = 192
 Top = 114
 BorderIcons = [biSystemMenu, biMinimize]
 BorderStyle = bsSingle
 Caption = 'ZLIB Tester'
 ClientHeight = 108
 ClientWidth = 234
 Color = clBtnFace
 Font.Charset = SHIFTJIS_CHARSET
 Font.Color = clWindowText
 Font.Height = -12
 Font.Name = #65325#65331' '#65328#12468#12471#12483#12463
 Font.Style = []
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 12
 object sbFileDialog: TSpeedButton
  Left = 208
  Top = 4
  Width = 23
  Height = 20
  Caption = '...'
  OnClick = sbFileDialogClick
 end
 object edtFileName: TEdit
  Left = 4
  Top = 4
  Width = 200
  Height = 20
  TabOrder = 0
  Text = 'C:\Temp\ZLIB\TEST.dat'
 end
 object btnCompress: TButton
  Left = 136
  Top = 40
  Width = 75
  Height = 25
  Caption = #22311#32302
  TabOrder = 1
  OnClick = btnCompressClick
 end
 object btnDecompress: TButton
  Left = 136
  Top = 70
  Width = 75
  Height = 25
  Caption = #35299#20941
  TabOrder = 2
  OnClick = btnDecompressClick
 end
 object rgCompressMode: TRadioGroup
  Left = 4
  Top = 28
  Width = 99
  Height = 77
  Caption = #22311#32302#65427#65392#65412#65438
  ItemIndex = 1
  Items.Strings = (
   #22311#32302#12394#12375
   #36895#24230#20778#20808
   #22311#32302#20778#20808)
  TabOrder = 3
 end
 object odFileDialog: TOpenDialog
  Left = 106
  Top = 28
 end
end


Delphi Source File: ZLIBTesterUnit.pas
unit ZLIBTesterUnit;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Buttons, StdCtrls, ExtCtrls, zlib;

type
 //----------------------------------------------------------------------------
 TForm1 = class(TForm)
  edtFileName: TEdit;
  sbFileDialog: TSpeedButton;
  odFileDialog: TOpenDialog;
  btnCompress: TButton;
  btnDecompress: TButton;
  rgCompressMode: TRadioGroup;
  procedure sbFileDialogClick(Sender: TObject);
  procedure btnCompressClick(Sender: TObject);
  procedure btnDecompressClick(Sender: TObject);
 private
  { Private 宣言 }
 public
  { Public 宣言 }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------
// 必要であれば以下のZlib.pas内ローカル定数をグローバル定数にしてください
{
const
 Z_NO_COMPRESSION    =  0;
 Z_BEST_SPEED      =  1;
 Z_BEST_COMPRESSION   =  9;
 Z_DEFAULT_COMPRESSION = (-1);
}

//------------------------------------------------------------------------------
// 必要であれば以下の関数をZlib.pasの同関数と置換えて使用して下さい
{
procedure CompressBuf(
 pLevel: Integer; const InBuf: Pointer; InBytes: Integer;
  out OutBuf: Pointer; out OutBytes: Integer);
var
 strm: TZStreamRec;
 P: Pointer;
begin
 FillChar(strm, sizeof(strm), 0);
 strm.zalloc := zlibAllocMem;
 strm.zfree := zlibFreeMem;
 OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
 GetMem(OutBuf, OutBytes);
 try
  strm.next_in := InBuf;
  strm.avail_in := InBytes;
  strm.next_out := OutBuf;
  strm.avail_out := OutBytes;
  CCheck(deflateInit_(strm, pLevel, zlib_version, sizeof(strm)));
  try
   while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
   begin
    P := OutBuf;
    Inc(OutBytes, 256);
    ReallocMem(OutBuf, OutBytes);
    strm.next_out :=
     PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
    strm.avail_out := 256;
   end;
  finally
   CCheck(deflateEnd(strm));
  end;
  ReallocMem(OutBuf, strm.total_out);
  OutBytes := strm.total_out;
 except
  FreeMem(OutBuf);
  OutBuf := Nil;
  raise
 end;
end;
}

//------------------------------------------------------------------------------
// 必要であれば以下の関数をZlib.pasの同関数と置換えて使用して下さい
{
procedure DecompressBuf(
 const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
 strm: TZStreamRec;
 P: Pointer;
 BufInc: Integer;
begin
 FillChar(strm, sizeof(strm), 0);
 strm.zalloc := zlibAllocMem;
 strm.zfree := zlibFreeMem;
 BufInc := (InBytes + 255) and not 255;
 if OutEstimate = 0 then
  OutBytes := BufInc
 else
  OutBytes := OutEstimate;
 GetMem(OutBuf, OutBytes);
 try
  strm.next_in := InBuf;
  strm.avail_in := InBytes;
  strm.next_out := OutBuf;
  strm.avail_out := OutBytes;
  DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
  try
   while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
   begin
    P := OutBuf;
    Inc(OutBytes, BufInc);
    ReallocMem(OutBuf, OutBytes);
    strm.next_out :=
     PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
    strm.avail_out := BufInc;
   end;
  finally
   DCheck(inflateEnd(strm));
  end;
  ReallocMem(OutBuf, strm.total_out);
  OutBytes := strm.total_out;
 except
  FreeMem(OutBuf);
  OutBuf := Nil;
  raise
 end;
end;
}

//------------------------------------------------------------------------------
procedure _ReadFile(
 pFileName: String; out pData: Pointer; out pSize: Integer);
var
 lRet,
 lFile: Integer;
begin
 lFile := -1;
 try
  try
   lFile := FileOpen(pFileName, fmOpenRead);
   if (lFile < 0) then
    raise Exception.Create(
     Format('ファイルのオープンに失敗しました (%s)', [pFileName]));
   pSize := FileSeek(lFile, 0, 2);
   FileSeek(lFile, 0, 0);
   if (pSize < 0) then
    raise Exception.Create(
     Format('ファイルサイズの取得に失敗しました (%s)', [pFileName]));
   GetMem(pData, pSize);
   lRet := FileRead(lFile, pData^, pSize);
   if (lRet <> pSize) then
    raise Exception.Create(
     Format('ファイルサイズの読込みに失敗しました (%s)', [pFileName]));
  except
   on E: Exception do
   begin
    if (pData <> Nil) then
    begin
     FreeMem(pData);
     pData := Nil;
    end;
    pSize := 0;
    raise;
   end;
  end;
 finally
  if (lFile >= 0) then FileClose(lFile);
 end;
end;

//------------------------------------------------------------------------------
procedure _WriteFile(
 pFileName: String; pData: Pointer; pSize: Integer);
var
 lRet,
 lFile: Integer;
begin
 lFile := -1;
 try
  if (FileExists(pFileName)) then
   lFile := FileOpen(pFileName, fmOpenWrite)
  else
   lFile := FileCreate(pFileName);
  if (lFile < 0) then
   raise Exception.Create(
    Format('ファイルのオープンに失敗しました (%s)', [pFileName]));
  lRet := FileWrite(lFile, pData^, pSize);
  if (lRet <> pSize) then
   raise Exception.Create(
    Format('ファイルサイズの書込みに失敗しました (%s)', [pFileName]));
 finally
  if (lFile >= 0) then FileClose(lFile);
 end;
end;

//------------------------------------------------------------------------------
procedure TForm1.sbFileDialogClick(Sender: TObject);
begin
 if (odFileDialog.Execute) then
  edtFileName.Text := odFileDialog.Files.CommaText;
end;

//------------------------------------------------------------------------------
procedure TForm1.btnCompressClick(Sender: TObject);
var
 lSData,
 lDData: Pointer;
 lSSize,
 lDSize,
 lLevel: Integer;
begin
 lSData := Nil;
 lDData := Nil;
 try
  _ReadFile(edtFileName.Text, lSData, lSSize);
  case rgCompressMode.ItemIndex of
  0:lLevel := Z_NO_COMPRESSION;
  1:lLevel := Z_BEST_SPEED;
  2:lLevel := Z_BEST_COMPRESSION;
  end;
  CompressBuf(lLevel, lSData, lSSize, lDData, lDSize);
  _WriteFile(Format('%s.cmp', [edtFileName.Text]), lDData, lDSize);
 finally
  if (lSData <> Nil) then FreeMem(lSData);
  if (lDData <> Nil) then FreeMem(lDData);
 end;
end;

//------------------------------------------------------------------------------
procedure TForm1.btnDecompressClick(Sender: TObject);
var
 lSData,
 lDData: Pointer;
 lSSize,
 lDSize: Integer;
begin
 lSData := Nil;
 lDData := Nil;
 try
  _ReadFile(edtFileName.Text, lSData, lSSize);
  DeCompressBuf(lSData, lSSize, 0, lDData, lDSize);
  _WriteFile(Format('%s.dec', [edtFileName.Text]), lDData, lDSize);
 finally
  if (lSData <> Nil) then FreeMem(lSData);
  if (lDData <> Nil) then FreeMem(lDData);
 end;
end;

end.

posted by guy at 08:13 | データ圧縮編
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。