'[先引用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
参考资料: