'************************************************************************************** ' ' Wrapper class for unrar.dll ' If anyone finds any problems, I'd appreciate an email. ' ' marcel_madonna@ajmsoft.com ' ' If you make changes, remember that GC tends to interfere with callbacks from ' unmanaged code. Test very very larges archives (1GB+), archives with many ' files (5000+), archives on separate volumes and password protected archives ' ' CHANGE HISTORY ' ' 06/01/2010 ' Added logic to load 64-bit version of unrar (unrar64.dll) when running on ' a 64-bit OS. ' ' ' Added another parameter to the Unpacking EVENT to allow Cancel ' Added an error code for cancel ' Changed Error code to a public enum ' Enabled progress tracking when unpacking by file ' '************************************************************************************** Imports System.Runtime.InteropServices Imports System.Text Public Class Decompressor 'generate an event after each file is unpacked Public Event OnUnpack(ByVal r As RAREntry) Public Shared Event Unpacking(ByVal fTotalSize As Long, ByVal fUnpackedSize As Long, ByRef Disposition As RarDisposition) Public Enum RarErrors ERAR_END_ARCHIVE = 10 ERAR_NO_MEMORY = 11 ERAR_BAD_DATA = 12 ERAR_BAD_ARCHIVE = 13 ERAR_UNKNOWN_FORMAT = 14 ERAR_EOPEN = 15 ERAR_ECREATE = 16 ERAR_ECLOSE = 17 ERAR_EREAD = 18 ERAR_EWRITE = 19 ERAR_SMALL_BUF = 20 ERAR_CANCELLED = 21 end enum Const RAR_OM_LIST As Integer = 0 Const RAR_OM_EXTRACT As Integer = 1 Const RAR_SKIP As Integer = 0 Const RAR_TEST As Integer = 1 Const RAR_EXTRACT As Integer = 2 Const UCM_CHANGEVOLUME As Integer = 0 Const UCM_PROCESSDATA As Integer = 1 Const UCM_NEEDPASSWORD As Integer = 2 Const RAR_VOL_ASK As Integer = 0 Const RAR_VOL_NOTIFY As Integer = 1 Public Enum RarOperations OP_EXTRACT = 0 OP_TEST = 1 OP_LIST = 2 End Enum Public Enum RarDisposition OP_CANCEL = -1 OP_CONTINUE = +1 End Enum _ Public Structure RARHeaderData 'mdm 06/01/2010 made Public _ Public ArcName As String _ Public FileName As String Public Flags As Integer Public PackSize As Integer Public UnpSize As Integer Public HostOS As Integer Public FileCRC As Integer Public FileTime As Integer Public UnpVer As Integer Public Method As Integer Public FileAttr As Integer Public CmtBuf As String Public CmtBufSize As Integer Public CmtSize As Integer Public CmtState As Integer End Structure _ Public Structure RARHeaderDataEx 'mdm 06/01/2010 made Public _ Public ArcName As String _ Public ArcNameW As Byte() _ Public FileName As String _ Public FileNameW As Byte() Public Flags As Integer Public PackSize As Integer Public PackSizeHigh As Integer Public UnpSize As Integer Public UnpSizeHigh As Integer Public HostOS As Integer Public FileCRC As Integer Public FileTime As Integer Public UnpVer As Integer Public Method As Integer Public FileAttr As Integer Public CmtBuf As String Public CmtBufSize As Integer Public CmtSize As Integer Public CmtState As Integer Public Reserved As Byte End Structure Public Structure RAROpenArchiveData Public ArcName As String Public OpenMode As Integer Public OpenResult As Integer Public CmtBuf As String Public CmtBufSize As Integer Public CmtSize As Integer Public CmtState As Integer End Structure Public Structure RAROpenArchiveDataEx Public ArcName As String Public ArcNameW As Byte() Public OpenMode As Integer Public OpenResult As Integer Public CmtBuf As String Public CmtBufSize As Integer Public CmtSize As Integer Public CmtState As Integer Public Flags As Integer Public Reserved As Byte End Structure 'mdm 06/01/2010 ' Add vectors for each routine in Unrar Private _delRARReadHeader As dRARReadHeader Private _delRARReadHeaderEx As dRARReadHeaderEx Private _delRAROpenArchive As dRAROpenArchive Private _delRAROpenArchiveEx As dRAROpenArchiveEx Private _delRARCloseArchive As dRARCloseArchive Private _delRARProcessFile As dRARProcessFile Private _delRARSetPassword As dRARSetPassword Private _delRARGetDllVersion As dRARGetDllVersion Private _delRARSetCallBack As dRARSetCallBack Const KERNEL As String = "kernel32.dll" 'mdm 06/01/2010 'mdm 06/01/2010 ' Add definitions for needed kernel routines _ Private Shared Function LoadLibraryEx(ByVal dllFilePath As String, ByVal hFile As IntPtr, ByVal dwFlags As Integer) As IntPtr End Function _ Private Shared Function FreeLibrary(ByVal dllPointer As IntPtr) As Boolean End Function _ Private Shared Function GetProcAddress(ByVal dllPointer As IntPtr, ByVal functionName As String) As IntPtr End Function ' mdm 06/01/2010 ' Redefined all Function declarations to use delegates to allow ' dynamic load of the unrar library and avoid static calls ' 'Const MYLIB As String = "E:\MyProjects\Utilities\UnRAR\debug\unrar.dll" ' _ 'Private Shared Function RARReadHeader(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderData) As Integer 'End Function _ Public Delegate Function dRARReadHeader(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderData) As Integer Private Function RARReadHeader(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderData) As Integer Return _delRARReadHeader.Invoke(hArcData, HeaderData) End Function ' _ 'Private Shared Function RARReadHeaderEx(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderDataEx) As Integer 'End Function Public Delegate Function dRARReadHeaderEx(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderDataEx) As Integer Private Function RARReadHeaderEx(ByVal hArcData As IntPtr, ByRef HeaderData As RARHeaderDataEx) As Integer Return _delRARReadHeaderEx.Invoke(hArcData, HeaderData) End Function ' _ 'Private Shared Function RAROpenArchive(ByRef ArchiveData As RAROpenArchiveData) As IntPtr 'End Function Public Delegate Function dRAROpenArchive(ByRef ArchiveData As RAROpenArchiveData) As IntPtr Private Function RARRAROpenArchive(ByRef ArchiveData As RAROpenArchiveData) As Integer Return _delRAROpenArchive.Invoke(archiveData) End Function ' _ 'Private Shared Function RAROpenArchiveEx(ByRef ArchiveData As RAROpenArchiveDataEx) As IntPtr 'End Function Private Delegate Function dRAROpenArchiveEx(ByRef ArchiveData As RAROpenArchiveDataEx) As IntPtr Private Function RAROpenArchiveEx(ByRef ArchiveData As RAROpenArchiveDataEx) As IntPtr Return _delRAROpenArchiveEx.Invoke(ArchiveData) End Function ' _ 'Private Shared Function RARCloseArchive(ByVal hArcData As IntPtr) As Integer 'End Function Private Delegate Function dRARCloseArchive(ByVal hArcData As IntPtr) As Integer Private Function RARCloseArchive(ByVal hArcData As IntPtr) As Integer Return _delRARCloseArchive.Invoke(hArcData) End Function ' _ 'Private Shared Function RARProcessFile(ByVal hArcData As IntPtr, ByVal Operation As Integer, ByVal DestPath As String, ByVal DestName As String) As Integer 'End Function Private Delegate Function dRARProcessFile(ByVal hArcData As IntPtr, ByVal Operation As Integer, ByVal DestPath As String, ByVal DestName As String) As Integer Private Function RARProcessFile(ByVal hArcData As IntPtr, ByVal Operation As Integer, ByVal DestPath As String, ByVal DestName As String) As Integer Return _delRARProcessFile.Invoke(hArcData, Operation, DestPath, DestName) End Function ' _ 'Private Shared Sub RARSetPassword(ByVal hArcData As IntPtr, ByVal Password As String) 'End Sub Private Delegate Sub dRARSetPassword(ByVal hArcData As IntPtr, ByVal Password As String) Private Sub RARSetPassword(ByVal hArcData As IntPtr, ByVal Password As String) _delRARSetPassword.Invoke(hArcData, Password) End Sub ' _ ' Private Shared Function RARGetDllVersion() As Integer 'End Function Private Delegate Function dRARGetDllVersion() As Integer Private Function RARGetDllVersion() As Integer Return _delRARGetDllVersion.Invoke() End Function 'Public Delegate Function RARCallBack(ByVal msg As Integer, ByVal userdata As Integer, ByVal P1 As IntPtr, ByVal P2 As Integer) As Integer ' _ 'Private Shared Sub RARSetCallback(ByVal hArcData As IntPtr, ByVal EP As RARCallBack, ByVal UserData As Long) 'End Sub Public Delegate Function RARCallBack(ByVal msg As Integer, ByVal userdata As Integer, ByVal P1 As IntPtr, ByVal P2 As Integer) As Integer Public Delegate Sub dRARSetCallBack(ByVal hArcData As IntPtr, ByVal EP As RARCallBack, ByVal UserData As Long) Private Sub RARSetCallback(ByVal hArcData As IntPtr, ByVal EP As RARCallBack, ByVal UserData As Long) _delRARSetCallBack(hArcData, EP, UserData) End Sub Public Structure RARHead Public ArcName As String Public ArcNameW As String Public CmtBuf As String Public CmtBufSize As Integer Public CmtSize As Integer Public CmtState As Integer End Structure Public Structure RAREntry Public FileName As String Public FileNameW As String Public Flags As Integer Public PackSize As Long Public UnpSize As Long Public HostOS As Integer Public FileCRC As Integer Public FileTime As Integer Public UnpVer As Integer Public Method As Integer Public FileAttr As Integer End Structure ' Local Variables Private mDllVersion As Integer Private mRARFiles As Collection Private mheader As RARHead Private mRARFile As String Private mPassword As String Private mTotalArchiveSize As Long Private mTotalPackedSize As Long Private mRARHandle As IntPtr 'List of files in the archive ReadOnly Property RARFiles() As Collection Get Return mRARFiles End Get End Property 'Archive header ReadOnly Property RARHeader() As RARHead Get Return mheader End Get End Property 'Total Files ReadOnly Property RARTotalFiles() As Integer Get Return mRARFiles.Count End Get End Property 'Total File Size ReadOnly Property TotalArchiveSize() As Long Get Return mTotalArchiveSize End Get End Property Private uRAREx As RAROpenArchiveDataEx Private uHeaderEx As RARHeaderDataEx Public Sub New(ByVal RARFile As String) mRARFile = RARFile Init() End Sub Public Sub New(ByVal RARFile As String, ByVal Password As String) mRARFile = RARFile mPassword = Password Init() End Sub Public Function UnPack(ByVal fName As String, ByVal fDest As String) As Boolean Dim sz(0) As String sz(0) = fName Return ExtractFile(sz, fDest) End Function Public Function UnPack(ByVal fName As String(), ByVal fDest As String) As Boolean Return ExtractFile(fName, fDest) End Function Public Function UnPackAll(ByVal fDest As String) As Boolean Return ExtractAll(fDest) End Function Public Function TestArchive(ByVal fName As String) As Boolean Dim sz(0) As String sz(0) = fName Return TestFile(sz) End Function Public Function TestArchive(ByVal fName As String()) As Boolean Return TestFile(fName) End Function Public Function TestAll() As Boolean Return TestAllFiles() End Function Private Sub Init() 'mdm 06/01/2010 ' Load the appropriate version of unrar.dll the routine ' will throw an exception if it's not found Try LoadLibrary() Catch ex As Exception MsgBox(ex.Message) mDllVersion = -1 'indicate error End Try Try mDllVersion = RARGetDllVersion() Catch ex As Exception mDllVersion = -1 'most likely entry point not found End Try uRAREx.CmtBuf = Space(16384) uRAREx.CmtBufSize = 16384 uRAREx.ArcName = mRARFile uHeaderEx.CmtBuf = Space(16384) mRARFiles = New Collection LoadFileList() mTotalArchiveSize = 0 For Each r As RAREntry In mRARFiles mTotalArchiveSize += r.UnpSize Next End Sub Private Sub LoadFileList() Dim iStatus As Integer Dim Ret As Integer uRAREx.OpenMode = RAR_OM_LIST mRARHandle = RAROpenArchiveEx(uRAREx) If uRAREx.OpenResult <> 0 Then OpenError(uRAREx.OpenResult, mRARFile) If mPassword <> "" Then RARSetPassword(mRARHandle, mPassword) Dim hr As New RARCallBack(AddressOf RARCB) Call RARSetCallback(mRARHandle, hr, 0) iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) mheader.ArcName = uHeaderEx.ArcName mheader.ArcNameW = Encoding.Unicode.GetString(uHeaderEx.ArcNameW) mheader.CmtBuf = uRAREx.CmtBuf mheader.CmtBufSize = uRAREx.CmtBufSize mheader.CmtSize = uRAREx.CmtSize mheader.CmtState = uRAREx.CmtState Do Until iStatus <> 0 Dim RARE As RAREntry = FormatFileEntry() mRARFiles.Add(RARE) Ret = RARProcessFile(mRARHandle, RAR_SKIP, "", "") If Ret <> 0 Then ProcessError(Ret) iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) Loop RARCloseArchive(mRARHandle) GC.KeepAlive(hr) End Sub Private Function FormatFileEntry() As RAREntry Dim RARE As RAREntry RARE.FileName = uHeaderEx.FileName RARE.FileNameW = Encoding.Unicode.GetString(uHeaderEx.FileNameW) RARE.Flags = uHeaderEx.Flags RARE.PackSize = MakeLong(uHeaderEx.PackSize, uHeaderEx.PackSizeHigh) RARE.UnpSize = MakeLong(uHeaderEx.UnpSize, uHeaderEx.UnpSizeHigh) RARE.HostOS = uHeaderEx.HostOS RARE.FileCRC = uHeaderEx.FileCRC RARE.FileTime = uHeaderEx.FileTime RARE.UnpVer = uHeaderEx.UnpVer RARE.Method = uHeaderEx.Method RARE.FileAttr = uHeaderEx.FileAttr Return RARE End Function Private Function MakeLong(ByVal iLow As Integer, ByVal iHigh As Integer) As Long Return IIf(iLow >= 0, iLow, iLow + 4294967296) + (CLng(iHigh) << 32) End Function Private Function ExtractFile(ByVal szFile As String(), ByVal szDest As String) As Boolean Return ProcessFile(szFile, szDest, RAR_EXTRACT) End Function Private Function TestFile(ByVal szFile As String()) As Boolean Return ProcessFile(szFile, "", RAR_TEST) End Function Private Function ProcessFile(ByVal szFile As String(), ByVal szDest As String, ByVal RARMode As Integer) As Boolean Dim iStatus As Integer Dim Ret As Integer uRAREx.OpenMode = RAR_OM_EXTRACT mRARHandle = RAROpenArchiveEx(uRAREx) If uRAREx.OpenResult <> 0 Then OpenError(uRAREx.OpenResult, mRARFile) If mPassword <> "" Then RARSetPassword(mRARHandle, mPassword) Dim hr As New RARCallBack(AddressOf RARCB) Call RARSetCallback(mRARHandle, hr, 0) iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) Dim UnpackCount As Integer = 0 Do Until iStatus <> 0 Or UnpackCount = szFile.Length Do For i As Integer = 0 To szFile.Length - 1 If uHeaderEx.FileName.Trim = szFile(i) Then Dim RARE As RAREntry = FormatFileEntry() fTotalSize = RARE.UnpSize fUnpackedSize = 0 Ret = RARProcessFile(mRARHandle, RARMode, szDest, "") If Ret <> 0 Then ProcessError(Ret) UnpackCount += 1 RaiseEvent OnUnpack(RARE) 'Signal file has been unpacked Exit Do End If Next Ret = RARProcessFile(mRARHandle, RAR_SKIP, "", "") If Ret <> 0 Then ProcessError(Ret) Exit Do Loop iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) Loop RARCloseArchive(mRARHandle) GC.KeepAlive(hr) Return True End Function Private Function ExtractAll(ByVal szDest As String) As Boolean Return ProcessAll(szDest, RAR_EXTRACT) End Function Private Function TestAllFiles() As Boolean Return ProcessAll("", RAR_TEST) End Function Private Function ProcessAll(ByVal szDest As String, ByVal RARMMode As Integer) As Boolean Dim iStatus As Integer Dim Ret As Integer uRAREx.OpenMode = RAR_OM_EXTRACT mRARHandle = RAROpenArchiveEx(uRAREx) If uRAREx.OpenResult <> 0 Then OpenError(uRAREx.OpenResult, mRARFile) If mPassword <> "" Then RARSetPassword(mRARHandle, mPassword) Dim hr As New RARCallBack(AddressOf RARCB) Call RARSetCallback(mRARHandle, hr, 0) iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) Do Until iStatus <> 0 Dim RARE As RAREntry = FormatFileEntry() fTotalSize = RARE.UnpSize fUnpackedSize = 0 Ret = RARProcessFile(mRARHandle, RAR_EXTRACT, szDest, "") If Ret <> 0 Then ProcessError(Ret) RaiseEvent OnUnpack(RARE) 'Signal file has been unpacked iStatus = RARReadHeaderEx(mRARHandle, uHeaderEx) Loop RARCloseArchive(mRARHandle) GC.KeepAlive(hr) Return True End Function Private Sub OpenArc(ByRef mH As IntPtr, ByRef h As RAROpenArchiveDataEx) ' ' Open the archive and establish the callback mH = RAROpenArchiveEx(h) If uRAREx.OpenResult <> 0 Then OpenError(h.OpenResult, mRARFile) If mPassword <> "" Then RARSetPassword(mH, mPassword) Dim hr As New RARCallBack(AddressOf RARCB) GC.KeepAlive(hr) Call RARSetCallback(mH, hr, 0) End Sub Shared fUnpackedSize As Long 'Total Bytes Unpacked so Far for current File Shared fTotalSize As Long 'Total File Size Public Shared Function RARCB(ByVal msg As Integer, ByVal userdata As Integer, ByVal P1 As IntPtr, ByVal P2 As Integer) As Integer Select Case msg Case UCM_CHANGEVOLUME Select Case P2 Case RAR_VOL_ASK 'need a new volume - for production use, add a dialog to allow new drive 'name and pass it back as a null-terminated string in address pointed at 'by P1 (See Password example below) Dim szVol As String = Marshal.PtrToStringAnsi(P1) If MsgBox("Load Volume: " & szVol, MsgBoxStyle.OkCancel, "UnRAR") <> MsgBoxResult.Ok Then Return -1 Return +1 ' Case RAR_VOL_NOTIFY Return +1 End Select Case UCM_PROCESSDATA 'I can peek at data here or make a progress bar Dim Disposition As RarDisposition = RarDisposition.OP_CONTINUE fUnpackedSize += P2 RaiseEvent Unpacking(fTotalSize, fUnpackedSize, Disposition) Select Case Disposition Case RarDisposition.OP_CANCEL Return -1 Case Else Return +1 End Select Case UCM_NEEDPASSWORD 'I need a password Dim f As New pwDlg f.ShowDialog() Dim pwB As Byte() = Encoding.ASCII.GetBytes(f.pw & Chr(0)) P2 = f.pw.Length f.Close() Marshal.Copy(pwB, 0, P1, pwB.Length) Return +1 '?? Case Else MsgBox("Oops!!, I don't know what I doing here") End Select End Function Private Sub OpenError(ByVal ErroNum As RarErrors, ByVal ArcName As String) Dim szMsg As String = "" Select Case ErroNum Case RarErrors.ERAR_NO_MEMORY szMsg = "Not enough memory" Case RarErrors.ERAR_EOPEN szMsg = "Cannot open " & ArcName Case RarErrors.ERAR_BAD_ARCHIVE szMsg = ArcName & " is not RAR archive" Case RarErrors.ERAR_BAD_DATA szMsg = ArcName & ": archive header broken" End Select RaiseError(ErroNum, szMsg) End Sub Private Sub ProcessError(ByVal ErroNum As RarErrors) Dim szMsg As String Select Case ErroNum Case RarErrors.ERAR_UNKNOWN_FORMAT szMsg = "Unknown archive format" Case RarErrors.ERAR_BAD_ARCHIVE szMsg = "Bad volume" Case RarErrors.ERAR_ECREATE szMsg = "File create error" Case RarErrors.ERAR_EOPEN szMsg = "Volume open error" Case RarErrors.ERAR_ECLOSE szMsg = "File close error" Case RarErrors.ERAR_EREAD szMsg = "Read error" Case RarErrors.ERAR_EWRITE szMsg = "Write error" Case RarErrors.ERAR_BAD_DATA szMsg = "CRC error" 'looks like bad password comes here as well Case RarErrors.ERAR_CANCELLED szMsg = "Extract Cancelled" Case Else szMsg = "Error " & ErroNum End Select RaiseError(ErroNum, szMsg) End Sub Private Sub RaiseError(ByVal errnum As Integer, ByVal msg As String) Try 'RARCloseArchive(mRARHandle) Catch ex As Exception 'just in case End Try Err.Raise(errnum + vbObjectError, , msg) End Sub 'mdm 06/01/2010 ' This routine will dynamically load unrar.dll or unrar64.dll ' depending on the OS Private Sub LoadLibrary() Dim szLibrary As String = "unrar.dll" If System.Runtime.InteropServices.Marshal.SizeOf(New IntPtr) = 8 Then szLibrary = "unrar64.dll" Dim pUnrar As IntPtr pUnrar = LoadLibraryEx(szLibrary, IntPtr.Zero, 0) If pUnrar = IntPtr.Zero Then Dim errorCode As Integer = Marshal.GetLastWin32Error() Throw New ApplicationException(String.Format("DLL Load error: {0}, error - {1}", szLibrary, errorCode)) End If ' Let's load all the vectors at one time. ' This routine assumes all routines are available in unrar. If ' you're using a really old version or if names change in a future ' version, we'll add a test to insure we have a compatible version ' of unrar. Dim pAddr As IntPtr pAddr = GetProcAddress(pUnrar, "RARReadHeader") _delRARReadHeader = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARReadHeader)), dRARReadHeader) pAddr = GetProcAddress(pUnrar, "RARReadHeaderEx") _delRARReadHeaderEx = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARReadHeaderEx)), dRARReadHeaderEx) pAddr = GetProcAddress(pUnrar, "RAROpenArchive") _delRAROpenArchive = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRAROpenArchive)), dRAROpenArchive) pAddr = GetProcAddress(pUnrar, "RAROpenArchiveEx") _delRAROpenArchiveEx = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRAROpenArchiveEx)), dRAROpenArchiveEx) pAddr = GetProcAddress(pUnrar, "RARCloseArchive") _delRARCloseArchive = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARCloseArchive)), dRARCloseArchive) pAddr = GetProcAddress(pUnrar, "RARProcessFile") _delRARProcessFile = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARProcessFile)), dRARProcessFile) pAddr = GetProcAddress(pUnrar, "RARSetPassword") _delRARSetPassword = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARSetPassword)), dRARSetPassword) pAddr = GetProcAddress(pUnrar, "RARGetDllVersion") _delRARGetDllVersion = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARGetDllVersion)), dRARGetDllVersion) pAddr = GetProcAddress(pUnrar, "RARSetCallback") _delRARSetCallBack = DirectCast(Marshal.GetDelegateForFunctionPointer(pAddr, GetType(dRARSetCallBack)), dRARSetCallBack) End Sub End Class