| |
' ******************************************************
' UNZIP32
' 圧縮には ZIP32J.DLL+ZIP32.DLL要
' ******************************************************
Type INDIVIDUALINFO
dwOriginalSize As Long
dwCompressedSize As Long
dwCRC As Long
uFlag As Integer
uOSType As Integer
wDate0 As Integer
wTime0 As Integer
wRatio As Integer
wDate As Integer
wTime As Integer
szFileName As String * 513
dummy1 As String * 3
szAttribute As String * 8
szMode As String * 8
dummy2 As String * 512
End Type
' ------------------------------------------------------
' バージョン情報
' ------------------------------------------------------
Declare Function UnZipGetVersion Lib "unzip32.dll" () As Integer
' ------------------------------------------------------
' 書庫ファイルOPEN
' ------------------------------------------------------
Declare Function UnZipOpenArchive Lib "unzip32.dll" ( _
ByVal hWnd As Long, _
ByVal szFileName As String, _
ByVal dwMode As Long _
) As Long
' ------------------------------------------------------
' 書庫ファイルCLOSE
' ------------------------------------------------------
Declare Function UnZipCloseArchive Lib "unzip32.dll" ( _
ByVal harc As Long _
) As Integer
' ------------------------------------------------------
' 初回検索
' ------------------------------------------------------
Declare Function UnZipFindFirst Lib "unzip32.dll" ( _
ByVal harc As Long, _
ByVal szWildName As String, _
lpSubInfo As INDIVIDUALINFO _
) As Integer
' ------------------------------------------------------
' 2回目以降の検索
' ------------------------------------------------------
Declare Function UnZipFindNext Lib "unzip32.dll" ( _
ByVal harc As Long, _
lpSubInfo As INDIVIDUALINFO _
) As Integer
' ------------------------------------------------------
' 解凍
' ------------------------------------------------------
Declare Function UnZip Lib "unzip32.dll" ( _
ByVal hWnd As Long, _
ByVal szCmdLine As String, _
ByVal szOutput As String, _
ByVal dwSize As Long _
) As Integer
' ------------------------------------------------------
' 圧縮
' ------------------------------------------------------
Declare Function Zip Lib "zip32j.dll" ( _
ByVal hWnd As Long, _
ByVal szCmdLine As String, _
ByVal szOutput As String, _
ByVal dwSize As Long _
) As Integer
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Declare Function FileTimeToSystemTime Lib "kernel32" ( _
lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME _
) As Long
Declare Function DosDateTimeToFileTime Lib "kernel32" ( _
ByVal wFatDate As Long, _
ByVal wFatTime As Long, _
lpFileTime As FILETIME _
) As Long
Global harc As Variant
' ******************************************************
' アーカイブを開く
' ******************************************************
Public Function OpenZip(hWnd As Long, strPath As String)
Dim ret As Long
If TypeName(harc) <> "Empty" Then
Call UnZipCloseArchive(harc)
harc = Empty
End If
ret = UnZipOpenArchive(hWnd, strPath, 2)
harc = ret
End Function
' ******************************************************
' アーカイブを閉じる
' ******************************************************
Public Function CloseZip()
If TypeName(harc) <> "Empty" Then
Call UnZipCloseArchive(harc)
harc = Empty
End If
End Function
' ******************************************************
' アーカイブを読む
' ******************************************************
Public Function FindZip(strTarget, ByRef UnzipData As INDIVIDUALINFO) As Long
If strTarget <> "" Then
FindZip = UnZipFindFirst(harc, strTarget, UnzipData)
Else
FindZip = UnZipFindNext(harc, UnzipData)
End If
End Function
' ******************************************************
' ディレクトリ圧縮
' ******************************************************
Public Function ZipFreezeDir(hWnd As Long, strTargetDir, strTargetZip) As Long
Dim strCommand As String
Dim strOut As String * 512
Dim nSize As Long
strCommand = "-ur " & strTargetZip & " " & strTargetDir & "\*"
nSize = 512
ZipFreezeDir = Zip(hWnd, strCommand, strOut, nSize)
End Function
' ******************************************************
' レスポンスファイルによる圧縮
' ******************************************************
Public Function ZipFreeze(hWnd As Long, strTargetDir, strTargetList, strTargetZip) As Long
Dim strCommand As String
Dim strOut As String * 512
Dim nSize As Long
strCommand = "-u " & strTargetZip & " " & strTargetDir & "\ @" & strTargetList
nSize = 512
ZipFreeze = Zip(hWnd, strCommand, strOut, nSize)
End Function
' ******************************************************
' 書庫解凍
' ******************************************************
Public Function ZipMelt( _
hWnd As Long, _
strOption, _
strTargetZip, _
strTargetDir, _
strFileSpec _
) As Long
Dim strCommand As String
Dim strOut As String * 512
Dim nSize As Long
strCommand = strOption & " """ & strTargetZip & """ " & strTargetDir & "\ " & strFileSpec
nSize = 512
ZipMelt = UnZip(hWnd, strCommand, strOut, nSize)
End Function
' ******************************************************
' バイナリの日付を文字列に変換
' ******************************************************
Public Function GetDosDateTime(wDate As Integer, wTime As Integer) As String
Dim lpFileTime As FILETIME
Dim lpSystemTime As SYSTEMTIME
Call DosDateTimeToFileTime(wDate, wTime, lpFileTime)
Call FileTimeToSystemTime(lpFileTime, lpSystemTime)
GetDosDateTime = _
Format(lpSystemTime.wYear, "0000") & "/" & _
Format(lpSystemTime.wMonth, "00") & "/" & _
Format(lpSystemTime.wDay, "00") & " " & _
Format(lpSystemTime.wHour, "00") & ":" & _
Format(lpSystemTime.wMinute, "00") & ":" & _
Format(lpSystemTime.wSecond, "00")
End Function
| |
