Lzh書庫内のファイルの情報を取り出す方法について

Visual BasicからLZHファイルを扱おうとすれば、UnLHA32.DLLを利用するのが手っ取り早い。しかし、書庫ファイルの情報を取り出す方法はVisual Basicでの利用方法の具体的な方法があまり発表されていないと思います。

まず、UnLHA32.DLLに同梱されている各ドキュメントを眺めます。おもなAPIの仕様はAPI.TXTに書かれています。またUNLHA32.Hも参考にします。

書庫ファイルの情報を取り出すには、 UnlhaOpenArchive, UnlhaCloseArchive, UnlhaFindFirst, UnlhaFindNextを使用します。宣言は、 

Private Declare Function UnlhaOpenArchive Lib "UnLHA32.DLL" _
                                (ByVal hwnd As Long, _
                                 ByVal szFilename As String, _
                                 ByVal dwMode As Long) As Long
Private Declare Function UnlhaCloseArchive Lib "UnLHA32.DLL" _
                                (ByVal harc As Long) As Long
Private Declare Function UnlhaFindFirst Lib "UnLHA32.DLL" _
                                (ByVal harc As Long, _
                                 ByVal szWildName As String, _
                                 lpSubInfo As tagINDIVIDUALINFO) As Long
Private Declare Function UnlhaFindNext Lib "UnLHA32.DLL" _
                                (ByVal harc As Long, _
                                 lpSubInfo As tagINDIVIDUALINFO) As Long

となります。tagINDIVIDUALINFOは、

Private Type tagINDIVIDUALINFO
    dwOriginalSize   As Long                      ' /* ファイルのサイズ */
    dwCompressedSize As Long                      ' /* 圧縮後のサイズ */
    dwCRC            As Long                      ' /* 格納ファイルのチェックサム */
    uFlag            As Long                      ' /* 処理結果 */
    uOSType          As Long                      ' /* 書庫作成に使われたＯＳ */
    wRatio           As Integer                   ' /* 圧縮率 */
    wDate            As Integer                   ' /* 格納ファイルの日付(DOS 形式) */
    wTime            As Integer                   ' /* 格納ファイルの時刻(〃) */
    szFilename       As String * FNAME_MAX32PLUS1 ' /* 書庫名 */
    dummy1           As String * 3
    szAttribute      As String * 8                ' /* 格納ファイルの属性 書庫固有 */
    szMode           As String * 8                ' /* 格納ファイルの格納モード 〃 */
End Type

となります。

APIのコールの流れとしては、

' 変数の宣言
Dim udtINDIVIDUALINFO As tagINDIVIDUALINFO
Dim strFileName       As String   ' 書庫ファイル名
Dim lngArcHandle      As Long     ' 書庫ファイルのハンドル
Dim lngResult         As Long     ' APIの戻り値用

' 書庫ファイル名を格納。
strFileName = "C:\My Documents\HEROPA\VBDeFM\vbdfm01f.lzh"
' 書庫ファイルとハンドルを関連付ける。
lngArcHandle = UnlhaOpenArchive(Me.hwnd, strFileName, 0)
If lngArcHandle <> 0 Then
    ' 最初の書庫内のファイルの情報を取り出す。
    If UnlhaFindFirst(lngArcHandle, "*.*", udtINDIVIDUALINFO) = 0 Then
        Do
            ' (udtINDIVIDUALINFOを処理するルーチンをここに書く)



        ' 次の格納ファイルの情報を取り出す。
        Loop While UnlhaFindNext(lngArcHandle, udtINDIVIDUALINFO) = 0
    End If
    ' 書庫ファイルハンドルを閉じる。
    lngResult = UnlhaCloseArchive(lngArcHandle)
End If

という感じでするのですが、INDIVIDUALINFO構造体の処理の中でも、wDate, wTimeの処理がちょっと面倒です。DOS形式の日付・時間と言われても、DOS時代のことなんか知らないのでさっぱりです。

しかし、Windows APIには、DOS形式の日付と時間をFILETIME形式に変換するDosDateTimeToFileTimeがあります。FILETIME形式にすれば、今度はFileTimeToSystemTimeに変更すれば、個々の時間の値は簡単に取り出せます。

もう少し欲を出して、FILETIME形式から直接Visual Basicの日付型に変更する方法を考えてみます。

FILETIMEはPlatform SDKによれば、64ビットのLARGE_INTEGERで1601/01/01からの100ナノ秒で表された値とあります。一方、Visual Basicの日付型は1899/12/30が0で表される浮動小数点の変数とあります。

とすれば、1601年から1899年までの日数を引けばVisual Basicの日付型に変更できます。APIの宣言では同じ64ビットの変数であるCurrency(通貨型)で受け、その値を処理することにします。

通貨型は15 桁の整数部分と 4 桁の小数部分を持つ固定小数点数なので、LARGE_INTEGERを通貨型で受けると、1/10000の値になってしまうが、値自体は10000倍すれば問題なく使えそうです。

つまり、1日のミリ秒数で割り、1601年以降の日数を取得すれば、それは日付型になります。

1日のミリ秒は、10,000,000ナノ秒×60秒×60分×24時間÷10,000となる。

よって、Visual Basicでの変換は、

dteArcFileDate = CDate((udtFILETIME / 10000000# * 60# * 60# * 24# / 10000#) - CDbl(#1899-12-30# - #1601-01-01#))

実際に使う場合は、演算結果を定数にしておけば、若干動作は速くなるだろうから、

Const conDayZeroBios As Double = 109205#
Const conMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#

dteArcFileDate = CDate((udtFILETIME / conMillisecondPerDay) - conDayZeroBios)

とすることにします。

具体的にコードを書くと、こんな感じでしょうか？

Option Explicit

Private Const FNAME_MAX32 = 512
Private Const FNAME_MAX32PLUS1 = FNAME_MAX32 + 1

' INDIVIDUALINFO構造体
Private Type tagINDIVIDUALINFO
    dwOriginalSize      As Long         ' /* ファイルのサイズ */
    dwCompressedSize    As Long         ' /* 圧縮後のサイズ */
    dwCRC               As Long         ' /* 格納ファイルのチェックサム */
    uFlag               As Long         ' /* 処理結果 */
    uOSType             As Long         ' /* 書庫作成に使われたＯＳ */
    wRatio              As Integer      ' /* 圧縮率 */
    wDate               As Integer      ' /* 格納ファイルの日付(DOS 形式) */
    wTime               As Integer      ' /* 格納ファイルの時刻(〃) */
    szFilename          As String * FNAME_MAX32PLUS1 ' /* 書庫名 */
    dummy1              As String * 3
    szAttribute         As String * 8   ' /* 格納ファイルの属性 書庫固有  */
    szMode              As String * 8   ' /* 格納ファイルの格納モード 〃  */
End Type

' ハンドルと書庫ファイルを結び付けます。
Private Declare Function UnlhaOpenArchive Lib "UnLHA32.DLL" _
                                (ByVal hwnd As Long, _
                                 ByVal szFilename As String, _
                                 ByVal dwMode As Long) As Long
' UnlhaOpenArchive() で割り付けたハンドルを解放する。
Private Declare Function UnlhaCloseArchive Lib "UnLHA32.DLL" _
                                (ByVal harc As Long) As Long
' 最初の格納ファイルの情報を得ます。
Private Declare Function UnlhaFindFirst Lib "UnLHA32.DLL" _
                                (ByVal harc As Long, _
                                 ByVal szWildName As String, _
                                 lpSubInfo As tagINDIVIDUALINFO) As Long
' ２番目以降の格納ファイルの情報を得ます。
Private Declare Function UnlhaFindNext Lib "UnLHA32.DLL" _
                                (ByVal harc As Long, _
                                 lpSubInfo As tagINDIVIDUALINFO) As Long
' DOS形式の日付時間をFILETIMEに変換します。
Private Declare Function DosDateTimeToFileTime Lib "kernel32" _
                                (ByVal wFatDate As Long, _
                                 ByVal wFatTime As Long, _
                                 lpFileTime As Currency) As Long

' ローカル時刻は1601年1月1日以降のナノ秒で表される。
' Currencyではミリ秒で表される。
' 1日のミリ秒数で割り、1601年以降の日数を取得する。
' 1601年から1899年までの日数を引き、ＶＢの日数を計算する。
'
' 10,000,000ナノ秒×60秒×60分×24時間÷10,000 = 86,4000,000
' (10,000はCurrencyで固定小数点を調整する)
'
' ＶＢの日付とWin32の日付の違い
' (#1899-12-30# - #1601-01-01#)
Private Const conDayZeroBios As Double = 109205#
Private Const conMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#
'
' 実際の使用にあたっては、書庫ファイルのデータは、
' 配列かコレクションに格納したりして使います。
'
Private Sub Command1_Click()
    ' 変数の宣言
    Dim udtINDIVIDUALINFO   As tagINDIVIDUALINFO
    Dim udtFILETIME         As Currency ' 構造体なんだけど通貨型で宣言
    Dim strFileName         As String   ' 書庫ファイル名
    Dim lngArcHandle        As Long     ' 書庫ファイルのハンドル
    Dim lngResult           As Long     ' APIの戻り値用
    Dim strArcFileName      As String   ' 格納ファイル名
    Dim lngArcFileOriginalSize As Long  ' 格納ファイルのサイズ
    Dim lngArcFileCompressedSize As Long ' 格納ファイルの圧縮後のサイズ
    Dim sglArcFileRatio     As Single   ' 圧縮率
    Dim dteArcFileDate      As Date     ' 格納ファイルの日時
    Dim strArcFileAttr      As String   ' 格納ファイルの属性
    Dim strArcFileType      As String   ' 格納ファイルの格納モード
    Dim lngArcFileCRC       As Long     ' 格納ファイルのチェックサム

    ' 書庫ファイル名を格納。
    strFileName = "C:\My Documents\HEROPA\VBDeFM\vbdfm01f.lzh"
    ' 書庫ファイルとハンドルを関連付ける。
    lngArcHandle = UnlhaOpenArchive(Me.hwnd, strFileName, 0)
    If lngArcHandle <> 0 Then
        ' 最初の書庫内のファイルの情報を取り出す。
        If UnlhaFindFirst(lngArcHandle, "*.*", udtINDIVIDUALINFO) = 0 Then
            Do
                ' ファイル名
                strArcFileName = Left$(udtINDIVIDUALINFO.szFilename, InStr(udtINDIVIDUALINFO.szFilename, vbNullChar) - 1)
                ' ファイルのサイズ
                lngArcFileOriginalSize = udtINDIVIDUALINFO.dwOriginalSize
                ' 圧縮後のサイズ
                lngArcFileCompressedSize = udtINDIVIDUALINFO.dwCompressedSize
                ' 圧縮率
                sglArcFileRatio = udtINDIVIDUALINFO.wRatio / 10
                ' 格納ファイルの日付を取得する。
                ' DOS形式の時間をFILETIMEに変換する。
                lngResult = DosDateTimeToFileTime(CLng(udtINDIVIDUALINFO.wDate), CLng(udtINDIVIDUALINFO.wTime), udtFILETIME)
                ' FILETIMEをVBのDate型に変換する。
                dteArcFileDate = CDate((udtFILETIME / conMillisecondPerDay) - conDayZeroBios)
                ' 属性
                strArcFileAttr = Left$(udtINDIVIDUALINFO.szAttribute, InStr(udtINDIVIDUALINFO.szAttribute, vbNullChar) - 1)
                ' 格納ファイルの格納モード
                strArcFileType = Left$(udtINDIVIDUALINFO.szMode, InStr(udtINDIVIDUALINFO.szMode, vbNullChar) - 1)
                ' 格納ファイルのチェックサム
                lngArcFileCRC = udtINDIVIDUALINFO.dwCRC
                ' 結果をデバッグウィンドウに表示。
                Debug.Print strArcFileName, _
                            lngArcFileOriginalSize, _
                            lngArcFileCompressedSize, _
                            Format$(sglArcFileRatio, "0.0") & "%", _
                            Format$(dteArcFileDate, "yyyy/mm/dd hh:nn:ss"), _
                            strArcFileAttr, _
                            strArcFileType, _
                            Right$("0000" & Hex$(lngArcFileCRC), 4)
            ' 次の格納ファイルの情報を取り出す。
            Loop While UnlhaFindNext(lngArcHandle, udtINDIVIDUALINFO) = 0
        End If
        ' 書庫ファイルハンドルを閉じる。
        lngResult = UnlhaCloseArchive(lngArcHandle)
    End If
End Sub
BackHome