アーカイバAPI Tips - [Arc]Open(Close)Archive/[Arc]FindFirst(Next)

3F	[Arc]Open(Close)Archive/[Arc]FindFirst(Next)
Last Updated：2002/11/03
■トップ ■ダウンロード ■圧縮解凍の部屋 ■オンラインソフトの部屋　 ■サポート掲示板　 ■リンク１

■[Arc]OpenArchive　(使用頻度：★★★★)
書庫を開くAPI。
■[Arc]OpenArchive2　(使用頻度：★★★★)
書庫を開くAPI。(オプションに対応)
■[Arc]CloseArchive　(使用頻度：★★★★)
書庫を閉じるAPI。
■[Arc]FindFirst　(使用頻度：★★★★)
書庫の最初の内容を取得するAPI。
■[Arc]FindNext　(使用頻度：★★★★)
書庫の2番目以降を取得するAPI
■どんな処理をするのか？
書庫の内容を取得する。
■準備
「標準 EXE」でプロジェクトを作成し、クラスモジュール、標準モジュールを追加後、表示されたフォーム上にドライブリストボックス、ディレクトリリストボックス、ファイルリストボックス、テキストボックス、２つのコマンドボタンを作成する。
■ソース　(標準モジュール／クラスモジュール／フォームモジュール／ダウンロード)
(tips010.bas) Option Explicit ' 設定の定数 Public Const VB_TRUE As Long = 1 Public Const VB_FALSE As Long = 0 ' INDIVIDUALINFO 構造体 Public Const FNAME_MAX32 As Long = 512 Public Const FNAME_MAX32PLUS1 As Long = FNAME_MAX32 + 1 Public Function DelNull(strData As String) As String Dim lngret As Long ' Null文字を検索 lngret = InStr(1, strData, Chr(0), vbBinaryCompare) ' 検索結果 If lngret > 0 Then ' 検索したNull文字の手前までを抽出 DelNull = Left(strData, lngret - 1) Else ' 見つからない場合は変更せずに返す。 DelNull = strData End If End Function Public Function bsl(CurPath As String) As String ' パスに"\"が存在? If Right(CurPath, 1) <> "\" Then ' ない bsl = "\" Else ' ある bsl = "" End If End Function
(tips010.cls) Option Explicit ' UnlhaCheckArchive 用の定数 Private Const CHECKARCHIVE_RAPID As Long = 0 Private Const CHECKARCHIVE_BASIC As Long = 1 Private Const CHECKARCHIVE_FULLCRC As Long = 2 ' 以下の定数は上と組み合わせて利用 Private Const CHECKARCHIVE_RECOVERY As Long = 4 Private Const CHECKARCHIVE_SFX As Long = 8 Private Const CHECKARCHIVE_ALL As Long = 16 Private Type INDIVIDUALINFO dwOriginalSize As Long '// ファイルのサイズ dwCompressedSize As Long '// 圧縮後のサイズ dwCRC As Long '// 格納ファイルのチェックサム uFlag As Long '// 処理結果 uOSType As Long '// 書庫作成に使われたＯＳ wRatio As Integer '// 圧縮率 wDate As Integer '// 格納ファイルの日付(DOS 形式-1) wTime As Integer '// 格納ファイルの時刻(〃-1) szFileName As String * FNAME_MAX32PLUS1 '// 書庫名 dummy1 As String * 3 '// ダミー szAttribute As String * 8 '// 格納ファイルの属性書庫固有-1 szMode As String * 8 '// 格納ファイルの格納モード〃-1 End Type 'UnlhaCheckArchive Private Const M_ERROR_MESSAGE_OFF As Long = &H800000 Private Declare Function Unlha Lib "Unlha32" _ (ByVal hWnd As Long, _ ByVal szCmdLine As String, _ ByVal szOutput As String, _ ByVal dwSize As Long) As Long Private Declare Function UnlhaOpenArchive Lib "Unlha32" _ (ByVal hWnd As Long, _ ByVal szFileName As String, _ ByVal dwMode As Long) As Long Private Declare Function UnlhaCloseArchive Lib "Unlha32" _ (ByVal harc As Long) As Long Private Declare Function UnlhaFindFirst Lib "Unlha32" _ (ByVal harc As Long, _ ByVal szWildName As String, _ lpSubInfo As INDIVIDUALINFO) As Long Private Declare Function UnlhaFindNext Lib "Unlha32" _ (ByVal harc As Long, _ lpSubInfo As INDIVIDUALINFO) As Long Private Declare Function UnlhaCheckArchive Lib "Unlha32" _ (ByVal szFileName As String, _ ByVal iMode As Long) As Long Public Function GetFile(hWnd As Long, CurPath As String, FileName As String) As Long Dim lngret As Long Dim lngFileCnt As Long Dim lngArcHandle As Long Dim strbsl As String Dim strFile As String Dim INDinfo As INDIVIDUALINFO Dim strFindFile As String 'フルパス取得 strFile = CurPath & bsl(CurPath) & FileName '書庫でなければ抜ける If UnlhaCheckArchive(strFile, 1) = 0 Then GetFile = 0 Exit Function End If 'ハンドルをリセット lngArcHandle = 0 '書庫を開く lngArcHandle = UnlhaOpenArchive(hWnd, strFile, M_ERROR_MESSAGE_OFF) 'ハンドルが有効 If lngArcHandle > 0 Then '最初のファイルをチェック lngret = UnlhaFindFirst(lngArcHandle, ".", INDinfo) If lngret = 0 Then '格納変数をおく strFindFile = "" Do 'ファイル数のチェック lngFileCnt = lngFileCnt + 1 'Null文字を削除 strFindFile = DelNull(INDinfo.szFileName) 'リストボックスに追加 Form1.List1.AddItem strFindFile '再びチェック Loop While UnlhaFindNext(lngArcHandle, INDinfo) = 0 End If End If '書庫を閉じる UnlhaCloseArchive (lngArcHandle) 'ファイル数を返す GetFile = lngFileCnt End Function Public Function UnlhaProc(hWnd As Long, szCmdLine As String, szOutput As String, dwSize As Long) As Long UnlhaProc = Unlha(hWnd, szCmdLine, szOutput, dwSize) End Function
(tips008.frm) Option Explicit Private Sub Command2_Click() ' 終了 End End Sub Private Sub Dir1_Change() ' 連動処理 File1.Path = Dir1.Path If File1.ListCount > 0 Then 'リストの先頭を選択 File1.ListIndex = 0 End If End Sub Private Sub Dir1_Click() ' 1クリック処理 Dir1.Path = Dir1.List(Dir1.ListIndex) End Sub Private Sub Drive1_Change() ' ドライブのルートを設定 Dir1.Path = Drive1.Drive End Sub Private Sub File1_Click() Dim CArc As Class1 Dim FileCnt As Long Dim strbsl As String ' ドライブなどの操作を無効にする SetVBCtl (False) ' CArc クラスを生成 Set CArc = New Class1 ' リストをクリア List1.Clear ' ファイル名を表示 Text1.Text = Dir1.Path & bsl(Dir1.Path) & File1.FileName Me.Refresh ' ファイル取得処理 List1.AddItem "【書庫内容】" FileCnt = CArc.GetFile(Me.hWnd, Dir1.Path, File1.FileName) ' ファイル数をチェック If FileCnt > 0 Then '書庫である List1.AddItem "【全" & FileCnt & "ファイル】" Else '書庫でない List1.AddItem "エラー:書庫じゃない" End If ' クラスを破棄 Set CArc = Nothing ' 操作を有効に SetVBCtl (True) End Sub Private Sub File1_DblClick() Dim lngret As Long Dim CArc As Class1 Dim szCmd As String Dim szBuf As String * 32767 ' 解凍処理 (全ファイル) ' CArc クラスを生成 Set CArc = New Class1 ' コマンドラインを作成 szCmd = "x -y1 " & Chr(34) & File1.FileName & Chr(34) & " " & Chr(34) & Dir1.Path & bsl(Dir1.Path) & Chr(34) lngret = CArc.UnlhaProc(Me.hWnd, szCmd, szBuf, 32767) ' クラスを破棄 Set CArc = Nothing End Sub Private Sub Form_Load() ' ディレクトリイベントを実行しておく Dir1_Change End Sub Private Sub List1_DblClick() Dim lngret As Long Dim CArc As Class1 Dim szCmd As String Dim szBuf As String * 32767 ' 解凍処理 (単一ファイル) ' CArc クラスを生成 Set CArc = New Class1 ' リストの先頭や末尾をクリックした場合は無効。 If List1.ListIndex > 0 And List1.ListIndex < List1.ListCount - 1 Then ' コマンドラインを作成 szCmd = "x -y1 " & Chr(34) & File1.FileName & Chr(34) & " " & Chr(34) & Dir1.Path & bsl(Dir1.Path) & Chr(34) & " " & List1.List(List1.ListIndex) ' 処理を開始 lngret = CArc.UnlhaProc(Me.hWnd, szCmd, szBuf, 32767) End If ' クラスを破棄 Set CArc = Nothing End Sub Private Sub SetVBCtl(Switch As Boolean) ' スイッチを適用 Drive1.Enabled = Switch Dir1.Enabled = Switch File1.Enabled = Switch List1.Enabled = Switch ' 更新 Me.Refresh End Sub
■ダウンロード(VB6.0用)
－ tips010.zip (5KB)：ファイルリストから選択すると書庫の内容を表示し、クリックで解凍。
■関連するAPI
[Arc]GetArcFileName()　[Arc]GetArcFileSize()　[Arc]GetArcOriginalSize()　[Arc]GetArcCompressedSize() 　[Arc]GetArcFileSizeEx()　[Arc]GetArcOriginalSizeEx()　[Arc]GetArcCompressedSizeEx()　[Arc]GetArcReadSize() 　[Arc]GetArcReadSizeEx()　[Arc]GetArcRatio()　[Arc]GetArcDate()　[Arc]GetArcTime()　[Arc]GetArcWriteTimeEx() 　[Arc]GetArcCreateTimeEx()　[Arc]GetArcAccessTimeEx()　[Arc]GetArcOSType()　[Arc]IsSFXFile() 　[Arc]GetFileName()　[Arc]GetMethod()　[Arc]GetOriginalSize()　[Arc]GetCompressedSize() 　[Arc]GetOriginalSizeEx()　[Arc]GetCompressedSizeEx()　[Arc]GetRatio()　[Arc]GetDate()　[Arc]GetTime() 　[Arc]GetWriteTime()　[Arc]GetAccessTime()　[Arc]GetCreateTime()　[Arc]GetWriteTimeEx() 　[Arc]GetCreateTimeEx()　[Arc]GetAccessTimeEx()　[Arc]GetCRC()　[Arc]GetAttribute　[Arc]GetOSType() 　(これらは[Arc]FindFirst()/[Arc]FindNext()で一括取得できるが個別に情報を取得したい場合に利用)
■　←BACK　■　■　ホームページに戻る ■　■　Tipsに戻る ■　■　NEXT→　■

[Arc]Open(Close)Archive/[Arc]FindFirst(Next)

Last Updated：2002/11/03

■トップ ■ダウンロード ■圧縮解凍の部屋 ■オンラインソフトの部屋　 ■サポート掲示板　 ■リンク１

　■[Arc]OpenArchive　(使用頻度：★★★★)

　書庫を開くAPI。

　■[Arc]OpenArchive2　(使用頻度：★★★★)

　書庫を開くAPI。(オプションに対応)

　■[Arc]CloseArchive　(使用頻度：★★★★)

　書庫を閉じるAPI。

　■[Arc]FindFirst　(使用頻度：★★★★)

　書庫の最初の内容を取得するAPI。

　■[Arc]FindNext　(使用頻度：★★★★)

　書庫の2番目以降を取得するAPI

　■どんな処理をするのか？

　書庫の内容を取得する。

　■準備

　「標準 EXE」でプロジェクトを作成し、クラスモジュール、標準モジュールを追加後、表示されたフォーム上にドライブリストボックス、ディレクトリリストボックス、ファイルリストボックス、テキストボックス、２つのコマンドボタンを作成する。

　■ソース　(標準モジュール／クラスモジュール／フォームモジュール／ダウンロード)

　(tips010.bas)

Option Explicit

' 設定の定数
Public Const VB_TRUE As Long = 1
Public Const VB_FALSE As Long = 0

' INDIVIDUALINFO 構造体
Public Const FNAME_MAX32 As Long = 512
Public Const FNAME_MAX32PLUS1 As Long = FNAME_MAX32 + 1

Public Function DelNull(strData As String) As String
    Dim lngret As Long
    
    ' Null文字を検索
    lngret = InStr(1, strData, Chr(0), vbBinaryCompare)
       
    ' 検索結果
    If lngret > 0 Then
        ' 検索したNull文字の手前までを抽出
        DelNull = Left(strData, lngret - 1)
    Else
        ' 見つからない場合は変更せずに返す。
        DelNull = strData
    End If
End Function

Public Function bsl(CurPath As String) As String
    ' パスに"\"が存在?
    If Right(CurPath, 1) <> "\" Then
        ' ない
        bsl = "\"
    Else
        ' ある
        bsl = ""
    End If
End Function

　(tips010.cls)

Option Explicit

' UnlhaCheckArchive 用の定数
Private Const CHECKARCHIVE_RAPID As Long = 0
Private Const CHECKARCHIVE_BASIC As Long = 1
Private Const CHECKARCHIVE_FULLCRC As Long = 2

' 以下の定数は上と組み合わせて利用
Private Const CHECKARCHIVE_RECOVERY As Long = 4
Private Const CHECKARCHIVE_SFX As Long = 8
Private Const CHECKARCHIVE_ALL As Long = 16

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

'UnlhaCheckArchive
Private Const M_ERROR_MESSAGE_OFF As Long = &H800000


Private Declare Function Unlha Lib "Unlha32" _
                (ByVal hWnd As Long, _
                ByVal szCmdLine As String, _
                ByVal szOutput As String, _
                ByVal dwSize As Long) As Long

Private Declare Function UnlhaOpenArchive Lib "Unlha32" _
                (ByVal hWnd As Long, _
                 ByVal szFileName As String, _
                 ByVal dwMode As Long) As Long
                
Private Declare Function UnlhaCloseArchive Lib "Unlha32" _
                (ByVal harc As Long) As Long
                
Private Declare Function UnlhaFindFirst Lib "Unlha32" _
                (ByVal harc As Long, _
                 ByVal szWildName As String, _
                 lpSubInfo As INDIVIDUALINFO) As Long
                 
Private Declare Function UnlhaFindNext Lib "Unlha32" _
                (ByVal harc As Long, _
                 lpSubInfo As INDIVIDUALINFO) As Long

Private Declare Function UnlhaCheckArchive Lib "Unlha32" _
                (ByVal szFileName As String, _
                ByVal iMode As Long) As Long
    
Public Function GetFile(hWnd As Long, CurPath As String, FileName As String) As Long
    Dim lngret As Long
    Dim lngFileCnt As Long
    Dim lngArcHandle As Long
    Dim strbsl As String
    Dim strFile As String
    Dim INDinfo As INDIVIDUALINFO
    Dim strFindFile As String

    'フルパス取得
    strFile = CurPath & bsl(CurPath) & FileName
    
    '書庫でなければ抜ける
    If UnlhaCheckArchive(strFile, 1) = 0 Then
        GetFile = 0
        Exit Function
    End If
    
    'ハンドルをリセット
    lngArcHandle = 0
    
    '書庫を開く
    lngArcHandle = UnlhaOpenArchive(hWnd, strFile, M_ERROR_MESSAGE_OFF)
    
    'ハンドルが有効
    If lngArcHandle > 0 Then
        '最初のファイルをチェック
        lngret = UnlhaFindFirst(lngArcHandle, "*.*", INDinfo)
        If lngret = 0 Then
            '格納変数をおく
            strFindFile = ""
            Do
                'ファイル数のチェック
                lngFileCnt = lngFileCnt + 1
                
                'Null文字を削除
                strFindFile = DelNull(INDinfo.szFileName)
                
                'リストボックスに追加
                Form1.List1.AddItem strFindFile
                
                '再びチェック
            Loop While UnlhaFindNext(lngArcHandle, INDinfo) = 0
        End If
    End If
    
    '書庫を閉じる
    UnlhaCloseArchive (lngArcHandle)
    
    'ファイル数を返す
    GetFile = lngFileCnt
End Function

Public Function UnlhaProc(hWnd As Long, szCmdLine As String, szOutput As String, dwSize As Long) As Long
    UnlhaProc = Unlha(hWnd, szCmdLine, szOutput, dwSize)
End Function

　(tips008.frm)

Option Explicit

Private Sub Command2_Click()
    ' 終了
    End
End Sub

Private Sub Dir1_Change()
    ' 連動処理
    File1.Path = Dir1.Path
   
    If File1.ListCount > 0 Then
        'リストの先頭を選択
        File1.ListIndex = 0
    End If
End Sub

Private Sub Dir1_Click()
    ' 1クリック処理
    Dir1.Path = Dir1.List(Dir1.ListIndex)
End Sub

Private Sub Drive1_Change()
    ' ドライブのルートを設定
    Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
    Dim CArc As Class1
    Dim FileCnt As Long
    Dim strbsl As String
    
    ' ドライブなどの操作を無効にする
    SetVBCtl (False)

    ' CArc クラスを生成
    Set CArc = New Class1
    
    ' リストをクリア
    List1.Clear
    
    ' ファイル名を表示
    Text1.Text = Dir1.Path & bsl(Dir1.Path) & File1.FileName
    
    Me.Refresh
        
    ' ファイル取得処理
    List1.AddItem "【書庫内容】"
    FileCnt = CArc.GetFile(Me.hWnd, Dir1.Path, File1.FileName)
    
    ' ファイル数をチェック
    If FileCnt > 0 Then
        '書庫である
        List1.AddItem "【全" & FileCnt & "ファイル】"
    Else
        '書庫でない
        List1.AddItem "エラー:書庫じゃない"
    End If
    
    ' クラスを破棄
    Set CArc = Nothing

    ' 操作を有効に
    SetVBCtl (True)
End Sub

Private Sub File1_DblClick()
    Dim lngret As Long
    Dim CArc As Class1
    Dim szCmd As String
    Dim szBuf As String * 32767
    ' 解凍処理 (全ファイル)
    ' CArc クラスを生成
    Set CArc = New Class1
    
    ' コマンドラインを作成
    szCmd = "x -y1 " & Chr(34) & File1.FileName & Chr(34) & " " & Chr(34) & Dir1.Path & bsl(Dir1.Path) & Chr(34)
    lngret = CArc.UnlhaProc(Me.hWnd, szCmd, szBuf, 32767)
    
    ' クラスを破棄
    Set CArc = Nothing
End Sub

Private Sub Form_Load()
    ' ディレクトリイベントを実行しておく
    Dir1_Change
End Sub

Private Sub List1_DblClick()
    Dim lngret As Long
    Dim CArc As Class1
    Dim szCmd As String
    Dim szBuf As String * 32767
    
    ' 解凍処理 (単一ファイル)
    ' CArc クラスを生成
    Set CArc = New Class1
    
    ' リストの先頭や末尾をクリックした場合は無効。
    If List1.ListIndex > 0 And List1.ListIndex < List1.ListCount - 1 Then
        ' コマンドラインを作成
        szCmd = "x -y1 " & Chr(34) & File1.FileName & Chr(34) & " " & Chr(34) & Dir1.Path & bsl(Dir1.Path) & Chr(34) & " " & List1.List(List1.ListIndex)
        
        ' 処理を開始
        lngret = CArc.UnlhaProc(Me.hWnd, szCmd, szBuf, 32767)
    End If
        
    ' クラスを破棄
    Set CArc = Nothing
End Sub

Private Sub SetVBCtl(Switch As Boolean)
    ' スイッチを適用
    Drive1.Enabled = Switch
    Dir1.Enabled = Switch
    File1.Enabled = Switch
    List1.Enabled = Switch
    
    ' 更新
    Me.Refresh
End Sub

　■ダウンロード(VB6.0用)

　　－ tips010.zip (5KB)：ファイルリストから選択すると書庫の内容を表示し、クリックで解凍。

　■関連するAPI

　[Arc]GetArcFileName()　[Arc]GetArcFileSize()　[Arc]GetArcOriginalSize()　[Arc]GetArcCompressedSize()
　[Arc]GetArcFileSizeEx()　[Arc]GetArcOriginalSizeEx()　[Arc]GetArcCompressedSizeEx()　[Arc]GetArcReadSize()
　[Arc]GetArcReadSizeEx()　[Arc]GetArcRatio()　[Arc]GetArcDate()　[Arc]GetArcTime()　[Arc]GetArcWriteTimeEx()
　[Arc]GetArcCreateTimeEx()　[Arc]GetArcAccessTimeEx()　[Arc]GetArcOSType()　[Arc]IsSFXFile()
　[Arc]GetFileName()　[Arc]GetMethod()　[Arc]GetOriginalSize()　[Arc]GetCompressedSize()
　[Arc]GetOriginalSizeEx()　[Arc]GetCompressedSizeEx()　[Arc]GetRatio()　[Arc]GetDate()　[Arc]GetTime()
　[Arc]GetWriteTime()　[Arc]GetAccessTime()　[Arc]GetCreateTime()　[Arc]GetWriteTimeEx()
　[Arc]GetCreateTimeEx()　[Arc]GetAccessTimeEx()　[Arc]GetCRC()　[Arc]GetAttribute　[Arc]GetOSType()
　(これらは[Arc]FindFirst()/[Arc]FindNext()で一括取得できるが個別に情報を取得したい場合に利用)

■　←BACK　■　■　ホームページに戻る ■　■　Tipsに戻る ■　■　NEXT→　■