vb6使用WinRAR压缩和解压文件

'[先引用Registry Access Functions library(RegObj.dll)]:

Function GetWINRARPath() As String
    Dim myReg As New Registry, KeyFound As Boolean
    
    KeyFound = myReg.GetKeyValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe", "Path", GetWINRARPath)
    
    If KeyFound = False Then
        'WINRAR.EXE 可以单独运行,所以可以拷贝到项目目录下使用
        GetWINRARPath = "WinRAR"
    End If
    If KeyFound = True Then
        GetWINRARPath = GetWINRARPath & "/WinRAR"
    End If
End Function

Sub compress(ByVal SOURCE As String, ByVal TARGET As String)
    Dim WINRARPath As String
    WINRARPath = GetWINRARPath
    If Dir(SOURCE) > "" Then
        On Error Resume Next
        Shell WINRARPath & " a -r " & TARGET & " " & SOURCE, vbHide
        If Err <> 0 Then
            MsgBox "系统未安装WINRAR.EXE!"
        End If
    End If
End Sub

Sub decompress(ByVal SOURCE As String, ByVal TARGET As String)
    Dim WINRARPath As String
    WINRARPath = GetWINRARPath
    If Dir(SOURCE) > "" Then
        On Error Resume Next
        Shell WINRARPath & " x -r " & SOURCE & " " & TARGET, vbHide
        If Err <> 0 Then
            MsgBox "系统未安装WINRAR.EXE!"
        End If
    End If
End Sub


Private Sub Command1_Click()
    '压缩Lock文件夹
    compress "Lock/", "Lock.rar"
End Sub

Private Sub Command2_Click()
    '解压到a文件夹
    decompress "Lock.rar", "a/"
End Sub

使用前导入注册表的引用Registry Access Functions
引用

参考资料:

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值