ActivePerlでLHA（99/1/8）

by Hippo2000(1999/1/8)

Microsoft社のVBScriptは、VBやVBAからいくつか機能が削られています。
それでもファイル関連の処理やプログラムの起動はFileSystemObjectやWSHといった別オブジェクトの力によって、
同じことを実現できるようになっています。
でも不思議なことにDLLを直接呼び出すことは、相変わらずできないままのようです。

ActivePerlではWin32::APIモジュールを使って、DLLも呼び出すことができます。
ここではUNLHA32.DLLの呼び出しについて書こうと思います。

ＰｅｒｌでもDLLが呼び出せないと思ってunlhacom.dllなんて作ったのにぃー。

目次

1.PerlからUNLHA32.DLLを呼び出す
1.1　必要なパッケージをインストール
1.2　プログラミング
1.3　プログラム例

参考資料

1.PerlからUNLHA32.DLLを呼び出す

ActivePerlではWin32::APIモジュールを使って、DLLも呼び出すことができます。
ここではUNLHA32.DLLの呼び出しについて書こうと思います。

1.1　必要なパッケージをインストールする

DLLを呼び出すためにはWin32::APIというモジュールを使います。
ActivePerlでは標準でインストールされています。

パッケージ名 説　　　　明
Win32::API DLLの呼び出しを可能とします。

1.2　プログラミング

DLLを呼び出すためには、Win32::APIオブジェクトの作成（DLLの宣言）、実際の呼び出しという手順を踏みます。

Win32::APIオブジェクトの作成（DLLの宣言）は...
$oNewAPI = new Win32::API(ライブラリ名, 関数名, 引数の型宣言, 戻り値の型宣言);
※　引数の型宣言はリストのリファレンスで指定します。
実際の呼び出しは
戻り値　= $oNewAPI->Call(引数);

となります。

引数や戻り値の型は以下の文字で指定します。

型文字 型
N 数値（LONG）
I 数値（Integer）
P その他（文字列、構造体など）

例えばUNLHA32.DLLのUnlhaGetVersion, UnLha関数はVBで宣言すると...

Declare Function UnlhaGetVersion Lib "unlha32" () As Integer
Declare Function Unlha Lib "unlha32"_
               (ByVal hwnd As Long, ByVal szCmdLine As String, _ 
                ByVal szOutput As String, ByVal dwSize As Long) As Long

をPerlで宣言、実行すると、以下のようになります。

$GetVer = new Win32::API("unlha32",  "UnlhaGetVersion", [], I);
$nRes = $GetVer->Call();
$nRes &= 0xFFFF;	        #後ろ2バイトだけが有効なので（頭にゴミが入るようなので）
$Lha = new Win32::API("unlha32", "Unlha", [N, P, P, N], N);
$sBuff = "\x00" x 2000;	#領域を確保(2000というのは適当に）
$nRes = $Lha->Call(0, 'a -rx c:\\kabaya.lzh "c:\\My Documents\\" *.htm', $sBuff, 2000);    
$sBuff =~ s/\x00+$//;	#余分な空白を削除

また構造体は対しては、pack、unpackを使ってデータの設定、取得をおこなうことができます。

1.2　プログラム例

UNLHA32.DLLを使って、ファイルの圧縮や解凍、一覧表示をおこなう例です。

use File::Path;        #ファイル削除のためだけなのでLHAには必要ではありません
use Win32::API;

#1. バージョンの取得
# DLLの宣言
my $GetVer = new Win32::API("unlha32",  "UnlhaGetVersion", [], I);
$nRes = $GetVer->Call();
$nRes &= 0xFFFF;		#intの場合、後ろ2バイトしか有効でないので
			#どうもゴミがはいるようなので
print "Ver: $nRes\n";

#2. ファイル数の取得
# DLLの宣言
my $GetF = new Win32::API("unlha32",  "UnlhaGetFileCount", [P], N);
my $nCnt = $GetF->Call('c:\\tt1.lzh');
print "Count: $nCnt\n";

#3.LHAのコマンド
# DLLの宣言
$Lha = new Win32::API("unlha32", "Unlha", [N, P, P, N], N);
#(1)ファイルの圧縮
#c:\My Documents配下にあるHTMファイルを再帰的に検索し、圧縮する
unlink('c:\\kabaya.lzh');
$sBuff = "\x00" x 2000;	#領域を確保
$nRes = $Lha->Call(0, 'a -rx c:\\kabaya.lzh "c:\\My Documents\\" *.htm', $sBuff, 2000);
$sBuff =~ s/\x00+$//;	#余分な空白を削除
print $sBuff, "\n";

#(2)ファイルの解凍
rmtree('c:\\lhaext\\');		#c:\lhaext配下をサブディレクトリも含めてすべて削除
mkdir('c:\\lhaext', 0777);
$sBuff = "\x00" x 2000;	#領域を確保
$nRes = $Lha->Call(0, 'x c:\\kabaya.lzh c:\\lhaext\\', $sBuff, 2000);
$sBuff =~ s/\x00+$//;	#余分な空白を削除
print $sBuff, "\n";

#4.OpenArc系の処理
my $lhaOpenArc   = new Win32::API("unlha32",  "UnlhaOpenArchive", [N, P, N], N);
my $lhaFindFirst = new Win32::API("unlha32",  "UnlhaFindFirst", [N, P, P], N);
my $lhaFindNext  = new Win32::API("unlha32",  "UnlhaFindNext",  [N, P], N);
my $lhaCloseArc  = new Win32::API("unlha32",  "UnlhaCloseArchive",  [N], N);

#4.1 Open
my $nArc = $lhaOpenArc->Call(0, "c:\\kabaya.lzh", 0);

#4.2 最初の情報を取り出す（FindFirst）
$oPack= "\x00" x 558;
my $nRes = $lhaFindFirst->Call($nArc, "*", $oPack);

while($nRes ==0) {
    #構造体はunpackで分解します。
    ($nSize, $nCmpSize, $nCrc, $nUFlag, $nOStype, $iRatio, $iDate, $iTime, 
       $sFileName, $sDummy, $sAttr, $sMode)
       = unpack("LLLLLSSSa513a3a8a8", $oPack);

    $sFileName =~ s/\x00+$//;  #後ろの0X00を削除する
    print "File:$sFileName SIZE:$nSize -> $nCmpSize (", $iRatio / 10, ")\n";
    #日付、時刻の変換
    $iNen  = (($iDate>>9) & 127) + 1980; # 上位7Bitが80年からの年数
    $iTuki = ($iDate>>5) & 15;	        # 次の4Bitが月数
    $iHi   = $iDate & 31;	                # 残り5Bitが日数
    $iHour = ($iTime>>11) & 31;          # 上位5Bitが時間
    $iMin  = ($iTime>>5)  & 63;          # 次の6Bitが分
    $iSec  = ($iTime & 31) * 2;          # 残り5Bitが秒を２で割ったもの
#    printf "  Date:%4d/%2d/%2d %2d:%02d:%02d\n", 
#                    $iNen, $iTuki, $iHi, $iHour, $iMin, $iSec;

    #    print "CRC :$nCrc FLAG:$nUFlag OS  :$nOStype\n";
    #    print "Attr:$sAttr Mode:$sMode\n";

    #4.3 次の情報を取り出す（FindNext）
    $nRes = $lhaFindNext->Call($nArc, $oPack);
}
#4.4 クローズ(Close)
$lhaCloseArc->Call($nArc);

実行結果の例

C:\User>perl lha.pl
Ver: 126
Count: 15

Creating archive : c:/kabaya.lzh

Frozen   ==>  43% index.htm
Frozen   ==>  47% prm.htm
Frozen   ==>  14% unlharef.htm
Frozen   ==>  59% texp.htm
Frozen   ==>  29% perlmail.htm
Frozen   ==>  44% index.htm
Frozen   ==>  24% ppm.htm
Frozen   ==>  28% perlora.htm
Frozen   ==>  33% rcvmail.htm


Extracting from archive : c:/kabaya.lzh

mkdir  c:/lhaext/Nifty
Melted   index.htm                  
Melted   prm.htm                    
mkdir  c:/lhaext/Nifty/v150
Melted   unlharef.htm               
Melted   texp.htm                   
mkdir  c:/lhaext/Nifty/PerlTips
Melted   perlmail.htm               
Melted   index.htm                  
Melted   ppm.htm                    
Melted   perlora.htm                
Melted   rcvmail.htm                


File:Nifty/index.htm SIZE:3029 -> 1314 (43.4)
File:Nifty/prm.htm SIZE:3259 -> 1551 (47.6)
File:Nifty/v150/unlharef.htm SIZE:61353 -> 8904 (14.5)
File:Nifty/texp.htm SIZE:1538 -> 920 (59.8)
File:Nifty/PerlTips/perlmail.htm SIZE:18760 -> 5574 (29.7)
File:Nifty/PerlTips/index.htm SIZE:2331 -> 1040 (44.6)
File:Nifty/PerlTips/ppm.htm SIZE:14902 -> 3589 (24.1)
File:Nifty/PerlTips/perlora.htm SIZE:29187 -> 8168 (28)
File:Nifty/PerlTips/rcvmail.htm SIZE:15563 -> 5151 (33.1)                   

C:\User>

　

参考資料

ここで扱ったモジュールのHTMLファイル名を以下の表に示します。

パッケージ名 モジュール名 説　　　　明
Win32::API Win32::API C:\Perl\html\lib\Win32\API.html　

この文書をつくるのにあたり、以下のサイトのお世話になりました.

ホーム　Perlの小技

ご意見、ご質問はこちらの掲示板で受け付けています。
またメールは河馬屋(Nifty)にお願いします。