• Home
 · 
• Miscellaneous
 · 
• Compresses or uncompresses (depending on which procedure you call) a file using the WinRAR DOS Exec

Compresses or uncompresses (depending on which procedure you call) a file using the WinRAR DOS Exec

Compresses or uncompresses (depending on which procedure you call) a file using the WinRAR DOS Executables. NOTE: Send me an email for a copy

API Declarations


' Constants
Global Const STILL_ACTIVE = &H103
Global Const PROCESS_QUERY_INFORMATION = &H400

' Vars
Global gsRARPath As String
Global gsUnRARPath As String

' Declares
Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long



Rate Compresses or uncompresses (depending on which procedure you call) a file using the WinRAR DOS Exec

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    Dim lRetVal As Long
    Dim hProcess As Long
    Dim sCommandLine As String
    Dim fso As New Scripting.FileSystemObject
    
    If fso.FileExists(CreateFullPath(sArchive, sNewPath)) = True Then
        fso.DeleteFile CreateFullPath(sArchive, sNewPath), True
    End If
    DoEvents
    
    sCommandLine = """" & gsRARPath & """ a -r """ & CreateFullPath(sArchive, sNewPath) & """ """ & sFile & """"
    Debug.Print sCommandLine
    
    If sCommandLine <> "" Then
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(sCommandLine, vbHide))
        
        Do
          GetExitCodeProcess hProcess, lRetVal
          DoEvents
        Loop While lRetVal = STILL_ACTIVE
    End If
End Sub
Sub UNZIPFiles(sFileName As String, sNewPath As String)
    Dim lRetVal As Long
    Dim hProcess As Long
    Dim sCommandLine As String
        
    sCommandLine = """" & CreateFullPath("unrar.exe", App.Path) & """ e -o+ """ & sFileName & """ """ & sNewPath & """" '..\unrar.exe e update.rar ..\temp"
    
    If sCommandLine <> "" Then
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(sCommandLine, vbHide))
        
        Do
          GetExitCodeProcess hProcess, lRetVal
          DoEvents
        Loop While lRetVal = STILL_ACTIVE
    End If
End Sub