Attribute VB_Name = "DLL"

Option Explicit

'2023/3/15 長草工場部品G水野修正　7-ZipのDLLを64バージョンに変更
'Declare に PtrSafe を追加
'hWnd のLongをLongPtrに変更
'参照するDLLを 7-zip64.dllに変更（置き場所:C:\Windows\System32に変更）

Private Declare PtrSafe Function SevenZip Lib "7-zip64.dll" ( _
    ByVal hWnd As LongPtr, _
    ByVal szCmdLine As String, _
    ByVal szOutput As String, _
    ByVal dwSize As Long) As Long
 
'ZIPファイルを作成
'引数 sSrsPath：圧縮するファイルまたはフォルダーのパス
'     sZIPFile：ZIPファイルのパス
'     sPassWord：パスワード　省略可
'返り値　成功したら True、失敗したらFalse
Public Function SendToZIP( _
    sSrsPath As String, sZIPFile As String, Optional sPassWord As String = "") As Boolean
Dim sCmd As String
    sCmd = "a -tzip -mx9 -hide "
    If sPassWord <> "" Then sCmd = sCmd & "-P" & sPassWord & " "
    sCmd = sCmd & Q2(sZIPFile) & " " & Q2(sSrsPath)
    SendToZIP = DoSevenZip(sCmd) = 0
End Function
 
'ZIPファイルを解凍
'引数 sDstPath：解凍先のフォルダーのパス
'     sZIPFile：ZIPファイルのパス
'     sPassWord：パスワード　省略可
'返り値　成功したら True、失敗したらFalse
Public Function ExtractZIP( _
    sDstPath As String, sZIPFile As String, Optional sPassWord As String = "") As Boolean
Dim sCmd As String
    sCmd = "X -hide -aoa "
    If sPassWord <> "" Then sCmd = sCmd & "-P" & sPassWord & " "
    sCmd = sCmd & Q2(sZIPFile) & " -o" & Q2(sDstPath)
    ExtractZIP = DoSevenZip(sCmd) = 0
End Function
 
Private Function DoSevenZip(sCmd As String) As Long
Dim sRet As String * 1024
    DoSevenZip = SevenZip(0, sCmd, sRet, 1024)
'    If DoSevenZip <> 0 Then MsgBox (Left(sRet, InStr(sRet, vbNullChar) - 1))
End Function
 
Public Function Q2(ByVal Text As String) As String
    Q2 = """" & Replace(Text, """", """""") & """"
End Function