shikaku anime トップページへ shikaku animeお気楽プログラム shikaku anime超ローテクDelphi講座 shikaku anime超低空飛行DelphiTip shikaku anime世界のVCL
shikaku anime復活畳の部屋 shikaku animeぶつぶつの部屋 shikaku animeおすすめLINK shikaku anime自己紹介 shikaku animeたたみやさんの伝言板
 

圧縮解凍プログラムを作る

 

ここでは「アッシュ君」でも利用させてもらっている、
米田昌司さん作「統合アーカイバコンポーネント」を使ってサンプルを書いていきます。

まずは各自DelphianWorldなどから統合アーカイバコンポーネントをダウンロードして
説明書通りDelphiへインストールしてください。その後「新規作成」で新しいフォームを作って
コンポをフォームへ張り付けてください。その他アーカイブ用DLLもインストールしておいてください。

 

1.圧縮ファイルを作る

フォーム上にボタンを1つ、オープンダイアログコンポを置きます。
ボタンをダブルクリックし、そのイベントハンドラの中に以下の太字部分を記述します。

 

procedure TForm1.Button1Click(Sender: TObject);
 var arc:TArchiveFile;
   filelist:tstringlist;
   BaseDir:string;
begin
 if form1.OpenDialog1.Execute then    //opendialogでokが押されたら以下を実行する
  begin
   BaseDir := ExtractfilePath(form1.OpenDialog1.FileName);
//基準ディレクトリー
   filelist:=tstringlist.Create;     
        //DLLへ渡すためのファイルの名前リストを作る
   filelist.AddStrings(form1.OpenDialog1.Files); 
//opendialogで得たfile名を名前リストに追加
   arc:= tArchiveFile.Create(self);
    //統合アーカイバコンポの実体を作成
   arc.FileName:='c:\test.lzh';
       //作りたいファイル名をPath付きで指定
   arc.Options.x := 1;
             // ディレクトリ情報を記録 LHA の -x1 オプションに相当。
   arc.Options.a := 1;             // 隠し属性やsytemファイルも取り込む
   arc.Options.n := 1;            // 経過表示のダイアログを出しません。
   arc.OutputSize := 8192;          // 出力バッファサイズを指定
   arc.Options.jso := 0;            //Umlha32command.txtを参照(^^;;)
   arc.PackFiles(form1.handle,nil,BaseDir,[filelist]);  //圧縮実行
   arc.Free;
                    //統合アーカイバコンポの実体を消去
   filelist.Free;
                  //名前リストを消去
  end;
end;
 

赤字のところは
たったこれだけのコードで圧縮ファイルが作れます。
すっごいですね。
実際unlha32.dllだけをwinapiを使ってやろうとすると、
まだまだ凄まじいコードを書かなければなりません。
以下要点だけを拾って説明いたします。

 

オプションスイッチ
オプションスイッチはunlha32.dllのものが踏襲されています。

arc.Options.x := 1; // ディレクトリ情報(Path情報)を記録。LHA の -x1 オプションに相当。
arc.Options.a := 1;// 隠し属性やsytemファイルも取り込む
arc.Options.n := 1;// 経過表示のダイアログを出しません。
arc.Options.r := 1;// 圧縮したいファイル名にc:\windows\*.*などと指定すると
              そのフォルダ以下にある全てのファイル(サブフォルダも含む)を
              DLL側で探して圧縮してくれます。

まだまだありますが、詳しくはunlha32.dll付属の説明などを読んでみてください。
しかし全てのオプションスイッチが各DLL全てには当てはまりません。
統合アーカイバのページに詳しく説明がありますので参照してください。

圧縮タイプ指定
arc.ArchiverType:= atLha;
// こうするとLZH形式で圧縮されます。
arc.ArchiverType:= atcab; // cabinet形式です
でも上記の例文ように、ファイル名の拡張子で指定した場合はいりません。

 

基準ディレクトリ
例えば次のようなファイルがあるとします。

c:¥test¥me¥my¥test.txt

圧縮するときの基準ディレクトリをc:¥test¥とします。
圧縮したいファイル名リストにはme¥my¥test.txtを入れます。そして
arc.PackTo(form1.handle,'c:¥test¥',filelist);

とすると、me¥my¥というPath情報を持ったtest.txtが圧縮ファイル内に保存されます。

 

DLLから返ってくるメッセージ
圧縮や解凍を実行すると、DLL側からメッセージが帰ってきます。
これを取得するには以下の文を書いておきます。
またフォームにmemoコンポーネントを張り付けておいてください。

ArchiveFile.OutputSize := 8192; // 出力バッファサイズを指定。8kbyte
Form1.Memo1.Lines.SetText( PChar( arc.Output ));//ポインタ渡しで文字列を
                                    メモコンポーネントに書き込みます。

以上をarc.freeの前に追加してください。

 

 

2.圧縮ファイルを解凍する

フォーム上にボタンをもう1つ置きます。
ボタンをダブルクリックし、そのイベントハンドラの中に以下の太字部分を記述します。
テスト解凍用に"c:\temp"フォルダを作ってください。

procedure TForm1.Button2Click(Sender: TObject);
 var arc:TArchiveFile;
begin
 if form1.OpenDialog1.Execute then    //opendialogでokが押されたら以下を実行する
  begin
   arc:= tArchiveFile.Create(form1);
  //統合アーカイバコンポの実体を作成
   arc.FileName:=form1.OpenDialog1.filename;
   //opendlgで得た圧縮ファイルを指定
   arc.Options.x := 1;
// ディレクトリ情報を再現して解凍
   arc.Options.n := 1;// 経過表示のダイアログを出しません。
   arc.OutputSize := 8192; // 出力バッファサイズを指定
   arc.unPackTo(form1.handle,'c:\temp',nil);  //解凍実行
   arc.Free;
                   //統合アーカイバコンポの実体を消去
  end;
end;

以上を実行すると、'c:\temp'へ解凍されます。またpath情報があれば
その情報に従って再現(フォルダが作られる)されます。 

 

 

3.圧縮ファイルの内容を取得する(1)

 

フォーム上にボタンとメモコンポをもう1つ置きます。

procedure TForm1.Button3Click( Sender:TObject );
var
 Arc: TArchiveFile; // 書庫ファイル
 IndivisualInfo:TIndivisualInfo; // 書庫内項目情報
 i: integer;
begin
 Arc := TArchiveFile.Create( form1);
 Arc.FileName := form1.OpenDialog1.filename;
//opendlgで得た圧縮ファイルを指定
 memo1.lines.clear;                   //memoコンポの内容をクリア。
 Arc.FindOpen( form1.Handle,0 );         //書庫をオープン
 i := Arc.FindFirst( '*.*',IndivisualInfo );
    //書庫の中の最初のファイル情報を取得

  while i = 0 do  // iが0(true)なら、取得成功なので以下を実行
   begin
    memo1.lines.add( IndivisualInfo.szFileName );
//
    i := Arc.FindNext( IndivisualInfo );
   end;
  Arc.FindClose;

 Arc.Free;
end;

統合アーカイバコンポのTIndivisualInfo構造体
統合アーカイバコンポの FindFirst/FindNext 関数で使用される構造体です。
以下はARCHIVES.PASからの抜粋です。

TIndivisualInfo = packed record
 dwOriginalSize: DWORD;
 dwCompressedSize: DWORD;
 dwCRC: DWORD;
 uFlag: UINT;
 uOSType: UINT;
 wRatio: WORD;
 wDate: WORD;
 wTime: WORD;
 szFileName: array[0..FNAME32_MAX] of char;
 dummy1: array[0..2] of char;
 szAttribute: array[0..7] of char;
 szMode: array[0..7] of char;
end;

以上の項目があります。
上の例ではファイル名しかmemoコンポに入れてませんが、
これらも全て表示させることが出来ます。
しかしcab形式では、圧縮率などは取得できません。

 

4.圧縮ファイルの内容を取得する(2)

3.の取得方法をふまえて、リストビューに内容を一覧表示します。
拙作アッシュくん等で使っている方法です。
リストビューとステータスバーをフォームに配置してください。
またuse節に統合アーカイバコンポの付属のfiltersを入れてください。
カラムやステータスバーのパネルの設定は下の画像を参照してください。

fnameにフルパスで圧縮ファイル名を指定します。
procedure arc_file_show(fname:string);
var ArchiveFile:TArchiveFile; // 書庫ファイル
 IndivisualInfo:TIndivisualInfo; // 書庫内項目情報
 done,osize,psize,co,i,po,nagasa:integer;
 item:tlistitem;
 ratio: Word;
 sratio,sosize,spsize,sat,smode,sname,spath,stime,kari:string;
begin
 form1.ListView1.Items.Clear;
 form1.ListView1.Items.BeginUpdate;
 co:=0;
 ArchiveFile := TArchiveFile.Create(form1);
 ArchiveFile.FileName:=fname;

 ArchiveFile.FindOpen(form1.Handle,0 );
 done := ArchiveFile.FindFirst( '*.*',IndivisualInfo );
 while done = 0 do
  begin

  //path情報とファイル名を分離する。Delphi2まで
   po:=0;
   kari:=IndivisualInfo.szFileName;
   i:=length(kari);
   nagasa:=length(kari);
   if (kari[i]<>'/')and (kari[i]<>'\')then
    begin
     for i:= i downto 1 do
      begin
       if (bytetype(kari,i)=mbsinglebyte)and((kari[i]='/')or (kari[i]='\')) then
        begin
         po:=i;
         break;
        end;
      end;
  //ここまで


  //path情報とファイル名を分離する。
  //Delphi3以降ならlastdelimiter関数が使えるので、こっちの方が良い
   po := lastdelimiter('/\',IndivisualInfo.szFileName);
   spath := copy(
IndivisualInfo.szFileName,1,po);
   sname:= copy(
IndivisualInfo.szFileName,po+1,length(IndivisualInfo.szFileName));
  //ここまで


   stime :=datetimetostr(DosDateTimeToDateTime(IndivisualInfo.wDate,IndivisualInfo.wtime));
   osize:=IndivisualInfo.dwOriginalSize;
   psize:=IndivisualInfo.dwCompressedSize;
   ratio:=IndivisualInfo.wRatio;
   sratio:=(floattostr(ratio /10))+'%';
   smode:= IndivisualInfo.szMode;
   sat:= IndivisualInfo.szAttribute;
   if osize<=1024 then sosize:=(inttostr(osize))+'byte'
    else sosize:=formatFloat('#,##0.00',osize/1024 )+'kB';
   if psize<=1024 then spsize:=(inttostr(psize))+'byte'
    else spsize:=formatFloat('#,##0.00',psize/1024 )+'kB';

    item:=form1.ListView1.Items.Add;
    item.Caption:=sname;
    item.SubItems.add(sosize);
    item.SubItems.add(spsize);
    item.SubItems.add(sratio);
    item.SubItems.add(stime);
    item.SubItems.add(smode);
    item.SubItems.add(sat);
    item.SubItems.add(spath);
    co:=co+1;
   end; // if kari
  done := ArchiveFile.FindNext( IndivisualInfo );
 end; //while do
ArchiveFile.FindClose;
ArchiveFile.free;
form1.ListView1.Items.EndUpdate;
form1.StatusBar1.Panels[1].Text:='';
form1.StatusBar1.Panels[1].Text:=inttostr(co);
//総ファイル数
form1.StatusBar1.Panels[3].Text:='';
form1.StatusBar1.Panels[3].Text:=get_filesize_str(fname);

                       //かなりよく使う小技のページを参照
end;

かなりややこしいっすね(^^;;;)
上手な人が書けばもっとスマートになるんでしょうけど、
運が悪かったと思ってあきらめてください。(爆)

 

 

5.自己解凍型に変換

自己解凍型圧縮ファイル(EXEファイル)は、圧縮したファイルの先頭に
解凍ルーチンをくっつけているものと考えてください。
ですからこれを作る場合は、一気には出来ませんので変換と表現しました。
またunlha32.dll、cab32.dllはこれのみで自己解凍型を作れますが、
ZIPはSfx32gui.datが、Tar形式ではKmterself.exeが別途必要です。
それぞれpathの通ったディレクトリに置くか、プログラム自身と同じディレクトリに
置くとよいでしょう。

以下サンプル文です。

procedure sfx;
var ArchiveFile:TArchiveFile;
begin
 ArchiveFile := TArchiveFile.Create(form1);
//form1はコンポを落としたフォームの名前です
 ArchiveFile.FileName := ArcName;
//arcnameには圧縮済みファイル(フルパス付き)の名前です。
 ArchiveFile.Options.x := 1;
// ディレクトリ情報を残す
 ArchiveFile.Options.gu := 1;
//全てのファイルを格納
 ArchiveFile.OutputSize := 8192; // 出力バッファサイズを指定
 ArchiveFile.Options.n := 0;
// 経過表示にする
 ArchiveFile.MakeSfxFile( form1.Handle,sfx_dir );
//sfx_dir変換後の保存先です。
 ArchiveFile.Free;
end;

またLZH形式の時は以下のオプションなども使えます。

ArchiveFile.Options.jw := 3; // WinSFXM 形式を指定
ArchiveFile.Options.gw := 3;
// WinSFX32M 形式を指定

 

 以上です。

Last UpDate 2003/11/28

戻る

2008 SugaharaTatamiten AllrightRecived