Стартовый пул

unrar/Examples/VBasic Sample 2/CTKUnrar.cls

@@ -0,0 +1,321 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+  Persistable = 0  'NotPersistable
+  DataBindingBehavior = 0  'vbNone
+  DataSourceBehavior  = 0  'vbNone
+  MTSTransactionMode  = 0  'NotAnMTSObject
+END
+Attribute VB_Name = "CTKUnrar"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = True
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = True
+Option Explicit
+
+'// ADDED
+'// Converts strings from Unicode to OEM encoding to make sure
+'// certain characters in paths are handled properly by RARProcessFile
+Private Declare Sub CharToOem Lib "user32" Alias "CharToOemA" _
+ (ByVal StrFrom As String, ByVal StrTo As String)
+
+'// ADDED
+'// For use by LongToUnsigned
+Private Const OFFSET_4 = 4294967296#
+
+Event OpenError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+Event ProcessError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+Event CommentError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+Event CommentFound(strFilename As String, strComment As String)
+Event ProcessingFile(strFilename As String, dblFileSize As Double, datFileTime As Date, intMajorVer As Integer, intMinorVer As Integer, lngPackingMethod As Long, lngFileAttr As Long)
+Event NextVolumne(strFilename As String, ByRef blnContinue As Boolean)
+Event MissingFile(strFilename As String, ByRef strNewFilename As String)
+Event MissingPassword(ByRef strNewPassword As String)
+Event Progress(dblFileSize As Double, dblExtracted As Double)
+
+' Private variables
+Private m_dblLastFileSize As Double
+Private m_dblLastFileUnpacked As Double
+Private m_intLastPercentStep As Integer
+Private m_blnPasswordProtected As Boolean
+' Properties
+Private m_intProgressSteps As Integer
+Private m_strLastErrorMsg As String
+
+Public Function LongToUnsigned(Value As Long) As Double
+    '// ADDED
+    '// This functions makes sure the unsigned integers
+    '// that unrar.dll returns are handled properly as
+    '// VB does not support unsigned integers natively
+    '// See KB article 189323 for more info
+    '// http://support.microsoft.com/?kbid=189323
+    '
+    'The function takes an unsigned Long from an API and
+    'converts it to a Double for display or arithmetic purposes
+    '
+    If Value < 0 Then
+        LongToUnsigned = Value + OFFSET_4
+    Else
+        LongToUnsigned = Value
+    End If
+    '
+End Function
+Private Sub Class_Initialize()
+    m_intProgressSteps = 4
+    m_strLastErrorMsg = ""
+    m_blnPasswordProtected = False
+End Sub
+
+Private Sub Class_Terminate()
+'
+End Sub
+
+Public Function ListRarFiles(strRarFile As String, arrstrFilenames() As String, Optional strPassword As String = "") As Boolean
+    ListRarFiles = HandleRarFiles(strRarFile, OP_LIST, arrstrFilenames, , strPassword)
+End Function
+
+Public Function TestRarFiles(strRarFile As String, Optional strPassword As String = "") As Boolean
+    TestRarFiles = HandleRarFiles(strRarFile, OP_TEST, , , strPassword)
+End Function
+
+Public Function ExtractRarFiles(strRarFile As String, strDestPath As String, Optional strPassword As String = "") As Boolean
+    ExtractRarFiles = HandleRarFiles(strRarFile, OP_EXTRACT, , strDestPath, strPassword)
+End Function
+
+Private Function HandleRarFiles(strRarFile As String, opMode As RarOperations, Optional arrstrFilenames As Variant, Optional strDestPath As String = "", Optional strPassword As String = "") As Boolean
+    Dim uRAR As RAROpenArchiveData
+    Dim uHeaderEx As RARHeaderDataEx
+    Dim lngRarHandle As Long
+    Dim intStatus As Integer
+    Dim intReturn As Integer
+    Dim strCurrentFilename As String
+    Dim strLastFilename As String
+    Dim lngpFilenames As Long
+    Dim strTmp As String
+
+    HandleRarFiles = False
+
+    '// ADDED
+    '// See API declaration
+    CharToOem strDestPath, strDestPath
+
+    ' Fill the rar header structure
+    uRAR.ArcName = strRarFile
+    uRAR.CmtBuf = Space(16384)
+    uRAR.CmtBufSize = 16384
+    If opMode = OP_LIST Then
+        uRAR.OpenMode = RAR_OM_LIST
+    ElseIf opMode = OP_TEST Or opMode = OP_EXTRACT Then
+        uRAR.OpenMode = RAR_OM_EXTRACT
+    Else
+        RaiseEvent ProcessError(ERAR_UNKNOWN_ERROR, "Unknown extracion mode", strRarFile)
+        m_strLastErrorMsg = "Unknown extracion mode"
+        Exit Function
+    End If
+
+    If opMode = OP_LIST Then
+        lngpFilenames = 0
+        If UBound(arrstrFilenames) = 0 Then
+            RaiseEvent ProcessError(ERAR_DEST_ARR_TO_SMALL, "Supplied array to small to fit all files", strCurrentFilename)
+            m_strLastErrorMsg = "Supplied array to small to fit all files"
+            Exit Function
+        End If
+    End If
+
+    ' Open the archive
+    lngRarHandle = RAROpenArchive(uRAR)
+    If uRAR.OpenResult <> 0 Then
+        ' Something went wrong
+        Call OpenError(uRAR.OpenResult, strRarFile)
+    Else
+        ' Set the callback
+        Call RARSetCallback(lngRarHandle, AddressOf MyCallBack, ObjPtr(Me))
+        ' If the user supplied a password, set it
+        If Len(strPassword) > 0 Then
+            Call RARSetPassword(lngRarHandle, strPassword)
+            m_blnPasswordProtected = True
+        End If
+        If uRAR.CmtState = 0 Then
+            ' No comment
+        ElseIf uRAR.CmtState = 1 Then
+            ' Comment
+            RaiseEvent CommentFound(strRarFile, uRAR.CmtBuf)
+        Else
+            Call CommentError(uRAR.CmtState, strRarFile)
+        End If
+
+        strLastFilename = ""
+        m_dblLastFileSize = 0
+        m_dblLastFileUnpacked = 0
+        m_intLastPercentStep = 0
+        ' Start processing the files
+        intStatus = RARReadHeaderEx(lngRarHandle, uHeaderEx)
+        strTmp = Left(uHeaderEx.ArcName, InStr(1, uHeaderEx.ArcName, vbNullChar) - 1)
+        Call NextVolume(strTmp)
+        Do Until intStatus <> 0
+            ' Get the current filename
+            strCurrentFilename = Left(uHeaderEx.FileName, InStr(1, uHeaderEx.FileName, vbNullChar) - 1)
+            
+            '// ADDED
+            '// Makes sure unsigned ints are handled properly
+            '// see function LongToUnsigned for more info
+            UnpSizeHighEx = LongToUnsigned(uHeaderEx.UnpSizeHigh)
+            UnpSizeEx = LongToUnsigned(uHeaderEx.UnpSize)
+            
+            If strLastFilename <> strCurrentFilename Then
+                m_dblLastFileSize = MakeDouble(uHeaderEx.UnpSizeHigh, uHeaderEx.UnpSize)
+                m_dblLastFileUnpacked = 0
+                m_intLastPercentStep = 0
+                RaiseEvent ProcessingFile(strCurrentFilename, m_dblLastFileSize, Now(), uHeaderEx.UnpVer / 10, uHeaderEx.UnpVer Mod 10, uHeaderEx.Method, uHeaderEx.FileAttr)
+                strLastFilename = strCurrentFilename
+                If opMode = OP_LIST Then
+                    If lngpFilenames > UBound(arrstrFilenames) Then
+                        RaiseEvent ProcessError(ERAR_DEST_ARR_TO_SMALL, "Supplied array to small to fit all files", strCurrentFilename)
+                        m_strLastErrorMsg = "Supplied array to small to fit all files"
+                        HandleRarFiles = False
+                        Exit Do
+                    End If
+                    arrstrFilenames(lngpFilenames) = strCurrentFilename
+                    lngpFilenames = lngpFilenames + 1
+                End If
+            End If
+            intReturn = ERAR_UNKNOWN_ERROR
+            If opMode = OP_LIST Then
+                intReturn = RARProcessFile(lngRarHandle, RAR_SKIP, "", "")
+            ElseIf opMode = OP_TEST Then
+                intReturn = RARProcessFile(lngRarHandle, RAR_TEST, "", "")
+            ElseIf opMode = OP_EXTRACT Then
+                intReturn = RARProcessFile(lngRarHandle, RAR_EXTRACT, strDestPath, "")
+            End If
+            If intReturn = 0 Then
+                HandleRarFiles = True
+            Else
+                ' Handle error and quit
+                Call ProcessError(CLng(intReturn), strCurrentFilename)
+                HandleRarFiles = False
+                Exit Do
+            End If
+            ' Handle next file
+            intStatus = RARReadHeaderEx(lngRarHandle, uHeaderEx)
+        Loop
+'        RaiseEvent Progress(m_dblLastFileUnpacked, m_dblLastFileUnpacked)
+        Call RARCloseArchive(lngRarHandle)
+    End If
+End Function
+
+Friend Sub ProcessingLength(lngBufferSize As Long)
+    ' Keep control of how much data we have extracted
+    m_dblLastFileUnpacked = m_dblLastFileUnpacked + lngBufferSize
+    If m_dblLastFileSize <> 0 Then
+        ' Send an event to the listener whenever we reach the next progress step (0%, x%, 2x%, 3x% etc)
+        If CInt(m_dblLastFileUnpacked / m_dblLastFileSize * 100) > m_intLastPercentStep + m_intProgressSteps Then
+            RaiseEvent Progress(m_dblLastFileSize, m_dblLastFileUnpacked)
+            ' Keep track of last percentage step
+            m_intLastPercentStep = m_intLastPercentStep + m_intProgressSteps
+        End If
+    End If
+End Sub
+
+Friend Function NextVolume(strFilename As String) As Boolean
+    Dim blnContinue As Boolean
+
+    RaiseEvent NextVolumne(strFilename, blnContinue)
+    NextVolume = blnContinue
+End Function
+
+Friend Function FindMissingFile(strFilename As String) As String
+    Dim strNewFile As String
+
+    RaiseEvent MissingFile(strFilename, strNewFile)
+    FindMissingFile = strNewFile
+End Function
+
+Friend Function MissingPassword() As String
+    Dim strNewPassword As String
+
+    m_blnPasswordProtected = True
+    RaiseEvent MissingPassword(strNewPassword)
+    MissingPassword = strNewPassword
+End Function
+
+Private Sub CommentError(lngErrorNum As Long, strRarName As String)
+    Dim strErrorMsg As String
+
+    Select Case lngErrorNum
+        Case ERAR_NO_MEMORY
+            strErrorMsg = "Not enough memory"
+        Case ERAR_BAD_DATA:
+            strErrorMsg = "Broken comment"
+        Case ERAR_UNKNOWN_FORMAT:
+            strErrorMsg = "Unknown comment format"
+        Case ERAR_SMALL_BUF:
+            strErrorMsg = "Buffer too small, comments not completely read"
+        Case Else
+            strErrorMsg = "Unknown error"
+    End Select
+    m_strLastErrorMsg = strErrorMsg
+    RaiseEvent CommentError(lngErrorNum, strErrorMsg, strRarName)
+End Sub
+
+Private Sub OpenError(lngErrorNum As Long, strRarName As String)
+    Dim strErrorMsg As String
+
+    Select Case lngErrorNum
+        Case ERAR_NO_MEMORY
+            strErrorMsg = "Not enough memory"
+        Case ERAR_EOPEN:
+            strErrorMsg = "Cannot open file"
+        Case ERAR_BAD_ARCHIVE:
+            strErrorMsg = "File is not RAR archive"
+        Case ERAR_BAD_DATA:
+            strErrorMsg = "Archive header broken"
+        Case Else
+            strErrorMsg = "Unknown error"
+    End Select
+    m_strLastErrorMsg = strErrorMsg
+    RaiseEvent OpenError(lngErrorNum, strErrorMsg, strRarName)
+End Sub
+
+Private Sub ProcessError(lngErrorNum As Long, strRarName As String)
+    Dim strErrorMsg As String
+
+    Select Case lngErrorNum
+        Case ERAR_UNKNOWN_FORMAT
+            strErrorMsg = "Unknown archive format"
+        Case ERAR_BAD_ARCHIVE:
+            strErrorMsg = "Bad volume"
+        Case ERAR_ECREATE:
+            strErrorMsg = "File create error"
+        Case ERAR_EOPEN:
+            strErrorMsg = "Volume open error"
+        Case ERAR_ECLOSE:
+            strErrorMsg = "File close error"
+        Case ERAR_EREAD:
+            strErrorMsg = "Read error"
+        Case ERAR_EWRITE:
+            strErrorMsg = "Write error"
+        Case ERAR_BAD_DATA:
+            If m_blnPasswordProtected Then
+                strErrorMsg = "CRC error - Wrong password?"
+            Else
+                strErrorMsg = "CRC error"
+            End If
+        Case Else
+            strErrorMsg = "Unknown error"
+    End Select
+    m_strLastErrorMsg = strErrorMsg
+    RaiseEvent ProcessError(lngErrorNum, strErrorMsg, strRarName)
+End Sub
+
+' The intProgressSteps property
+Property Get intProgressSteps() As Integer
+    intProgressSteps = m_intProgressSteps
+End Property
+Property Let intProgressSteps(ByVal newValue As Integer)
+    m_intProgressSteps = newValue
+End Property
+
+' The strLastErrorMsg property
+Property Get strLastErrorMsg() As String
+    strLastErrorMsg = m_strLastErrorMsg
+End Property

unrar/Examples/VBasic Sample 2/Group1.vbg

@@ -0,0 +1,3 @@
+VBGROUP 5.0
+Project=TKUnrar.vbp
+StartupProject=demo\Project1.vbp

unrar/Examples/VBasic Sample 2/MTKUnrar.bas

@@ -0,0 +1,277 @@
+Attribute VB_Name = "MTKUnrar"
+Option Explicit
+
+Const RAR_DLL_VERSION As Integer = 2
+Const RAR_CONTINUE As Integer = 1
+Const RAR_ABORT As Integer = -1
+
+Public Enum ERAR
+    ERAR_END_ARCHIVE = 10
+    ERAR_NO_MEMORY
+    ERAR_BAD_DATA
+    ERAR_BAD_ARCHIVE
+    ERAR_UNKNOWN_FORMAT
+    ERAR_EOPEN
+    ERAR_ECREATE
+    ERAR_ECLOSE
+    ERAR_EREAD
+    ERAR_EWRITE
+    ERAR_SMALL_BUF
+    ' Private error definitions
+    ERAR_DEST_ARR_TO_SMALL = 5000
+    ERAR_UNKNOWN_DESTINATION
+    ERAR_UNKNOWN_ERROR
+End Enum
+
+Public Enum RAR_OM
+    RAR_OM_LIST = 0
+    RAR_OM_EXTRACT
+End Enum
+ 
+Public Enum RAR
+    RAR_SKIP = 0
+    RAR_TEST
+    RAR_EXTRACT
+End Enum
+
+Public Enum UCM
+    UCM_CHANGEVOLUME = 0
+    UCM_PROCESSDATA
+    UCM_NEEDPASSWORD
+End Enum
+
+Public Enum RAR_VOL
+    RAR_VOL_ASK = 0
+    RAR_VOL_NOTIFY
+End Enum
+
+Public Enum RarOperations
+    OP_EXTRACT = 0
+    OP_TEST
+    OP_LIST
+End Enum
+
+Public Type RARHeaderData
+    ArcName As String * 260
+    FileName As String * 260
+    flags As Long
+    PackSize As Long
+    UnpSize As Long
+    HostOS As Long
+    FileCRC As Long
+    FileTime As Long
+    UnpVer As Long
+    Method As Long
+    FileAttr As Long
+    CmtBuf As String
+    CmtBufSize As Long
+    CmtSize As Long
+    CmtState As Long
+End Type
+
+Public Type RARHeaderDataEx
+    ArcName As String * 1024
+    ArcNameW As String * 2048
+    FileName As String * 1024
+    FileNameW As String * 2048
+    flags As Long
+    PackSize As Long
+    PackSizeHigh As Long
+    UnpSize As Long
+    UnpSizeHigh As Long
+    HostOS As Long
+    FileCRC As Long
+    FileTime As Long
+    UnpVer As Long
+    Method As Long
+    FileAttr As Long
+    CmtBuf As String
+    CmtBufSize As Long
+    CmtSize As Long
+    CmtState As Long
+    Reserved(1024) As Integer
+End Type
+
+Public Type RAROpenArchiveData
+    ArcName As String
+    OpenMode As Long
+    OpenResult As Long
+    CmtBuf As String
+    CmtBufSize As Long
+    CmtSize As Long
+    CmtState As Long
+End Type
+
+Public Declare Function RAROpenArchive Lib "unrar.dll" (ByRef ArchiveData As RAROpenArchiveData) As Long
+Public Declare Function RARCloseArchive Lib "unrar.dll" (ByVal hArcData As Long) As Long
+Public Declare Function RARReadHeader Lib "unrar.dll" (ByVal hArcData As Long, ByRef HeaderData As RARHeaderData) As Long
+Public Declare Function RARReadHeaderEx Lib "unrar.dll" (ByVal hArcData As Long, ByRef HeaderData As RARHeaderDataEx) As Long
+Public Declare Function RARProcessFile Lib "unrar.dll" (ByVal hArcData As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
+Public Declare Sub RARSetCallback Lib "unrar.dll" (ByVal hArcData As Long, ByVal CallbackProc As Long, ByVal UserData As Long)
+Public Declare Sub RARSetPassword Lib "unrar.dll" (ByVal hArcData As Long, ByVal Password As String)
+Public Declare Function RARGetDllVersion Lib "unrar.dll" () As Long
+
+Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
+Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
+Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
+'
+
+Public Function MakeDouble(ByVal HiWord As Long, ByVal LoWord As Long) As Double
+    MakeDouble = CDbl(LoWord) + CDbl(HiWord) * 4294967296#
+End Function
+
+Public Function MyCallBack(ByVal msg As Long, ByVal UserData As Long, ByVal P1 As Long, ByVal P2 As Long) As Integer
+    Dim strPassword As String
+    Dim strNewVolume As String
+
+    If msg = UCM_CHANGEVOLUME Then
+        If P2 = RAR_VOL_ASK Then
+            strNewVolume = CallFunctionFromUserdata(UserData).FindMissingFile(PointerToStringA(P1)) & Chr(0)
+            If Len(strNewVolume) > 1 Then
+                CopyMemory ByVal P1, ByVal StrPtr(StrConv(strNewVolume, vbFromUnicode)), Len(strNewVolume)
+                MyCallBack = RAR_CONTINUE
+            Else
+                MyCallBack = RAR_ABORT
+            End If
+        ElseIf P2 = RAR_VOL_NOTIFY Then
+            If CallFunctionFromUserdata(UserData).NextVolume(PointerToStringA(P1)) Then
+                MyCallBack = RAR_CONTINUE
+            Else
+                MyCallBack = RAR_ABORT
+            End If
+        End If
+
+    ElseIf msg = UCM_PROCESSDATA Then
+        Call CallFunctionFromUserdata(UserData).ProcessingLength(P2)
+'        Debug.Print "Size of data = " & P2
+'        Debug.Print HexDump(P1, P2)
+        MyCallBack = RAR_CONTINUE
+
+    ElseIf msg = UCM_NEEDPASSWORD Then
+        strPassword = CallFunctionFromUserdata(UserData).MissingPassword() & Chr(0)
+        If Len(strPassword) = 1 Then
+            ' If the user supplies an empty password, we have to generate a fake one, else we
+            ' won't receieve a CRC error message from RARProcessFile. Bug?
+            strPassword = "CTKUnrar" & Now() & Chr(0)
+        End If
+        CopyMemory ByVal P1, ByVal StrPtr(StrConv(strPassword, vbFromUnicode)), IIf(Len(strPassword) > P2, P2, Len(strPassword))
+    Else
+        Debug.Print "Unknown msg"
+    End If
+End Function
+
+' resolve the passed object pointer into an object reference.
+' DO NOT PRESS THE "STOP" BUTTON WHILE IN THIS PROCEDURE!
+Private Function CallFunctionFromUserdata(ByVal UserData As Long) As CTKUnrar
+    Dim CwdEx As CTKUnrar
+
+    CopyMemory CwdEx, UserData, 4&
+    Set CallFunctionFromUserdata = CwdEx
+    CopyMemory CwdEx, 0&, 4&
+End Function
+
+Public Function PointerToStringW(ByVal lpString As Long) As String
+   Dim sText As String
+   Dim lLength As Long
+
+   If lpString Then
+      lLength = lstrlenW(lpString)
+      If lLength Then
+         sText = Space$(lLength)
+         CopyMemory ByVal StrPtr(sText), ByVal lpString, lLength * 2
+      End If
+   End If
+   PointerToStringW = sText
+End Function
+
+Public Function IsUnicode(s As String) As Boolean
+    IsUnicode = Not (Len(s) = LenB(s))
+End Function
+
+Public Function PointerToStringA(lpStringA As Long) As String
+   Dim Buffer() As Byte
+   Dim nLen As Long
+
+   If lpStringA Then
+      nLen = lstrlenA(ByVal lpStringA)
+      If nLen Then
+         ReDim Buffer(0 To (nLen - 1)) As Byte
+         CopyMemory Buffer(0), ByVal lpStringA, nLen
+         PointerToStringA = StrConv(Buffer, vbUnicode)
+      End If
+   End If
+End Function
+
+Public Function PointerToDWord(ByVal lpDWord As Long) As Long
+   Dim nRet As Long
+   If lpDWord Then
+      CopyMemory nRet, ByVal lpDWord, 4
+      PointerToDWord = nRet
+   End If
+End Function
+
+Private Function HexDump(ByVal lpBuffer As Long, ByVal nBytes As Long) As String
+   Dim i As Long, j As Long
+   Dim ba() As Byte
+   Dim sRet As String
+   Dim dBytes As Long
+   
+   ' Size recieving buffer as requested,
+   ' then sling memory block to buffer.
+   ReDim ba(0 To nBytes - 1) As Byte
+   Call CopyMemory(ba(0), ByVal lpBuffer, nBytes)
+   sRet = String(81, "=") & vbCrLf & _
+          "lpBuffer = &h" & Hex$(lpBuffer) & _
+          "   nBytes = " & nBytes
+   
+   ' Buffer may well not be even multiple of 16.
+   ' If not, we need to round up.
+   If nBytes Mod 16 = 0 Then
+      dBytes = nBytes
+   Else
+      dBytes = ((nBytes \ 16) + 1) * 16
+   End If
+   
+   ' Loop through buffer, displaying 16 bytes per
+   ' row. Preface with offset, trail with ASCII.
+   For i = 0 To (dBytes - 1)
+      ' Add address and offset from beginning
+      ' if at the start of new row.
+      If (i Mod 16) = 0 Then
+         sRet = sRet & vbCrLf & Right$("00000000" _
+                & Hex$(lpBuffer + i), 8) & "  " & _
+                Right$("0000" & Hex$(i), 4) & "  "
+      End If
+      
+      ' Append this byte.
+      If i < nBytes Then
+         sRet = sRet & Right$("0" & Hex(ba(i)), 2)
+      Else
+         sRet = sRet & "  "
+      End If
+      
+      ' Special handling...
+      If (i Mod 16) = 15 Then
+         ' Display last 16 characters in
+         ' ASCII if at end of row.
+         sRet = sRet & "  "
+         For j = (i - 15) To i
+            If j < nBytes Then
+               If ba(j) >= 32 And ba(j) <= 126 Then
+                  sRet = sRet & Chr$(ba(j))
+               Else
+                  sRet = sRet & "."
+               End If
+            End If
+         Next j
+      ElseIf (i Mod 8) = 7 Then
+         ' Insert hyphen between 8th and
+         ' 9th bytes of hex display.
+         sRet = sRet & "-"
+      Else
+         ' Insert space between other bytes.
+         sRet = sRet & " "
+      End If
+   Next i
+   HexDump = sRet & vbCrLf & String(81, "=") & vbCrLf
+End Function

unrar/Examples/VBasic Sample 2/TKUnrar.vbp

@@ -0,0 +1,39 @@
+Type=OleDll
+Class=CTKUnrar; CTKUnrar.cls
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#D:\WINNT\System32\stdole2.tlb#OLE Automation
+Module=MTKUnrar; MTKUnrar.bas
+Startup="(None)"
+HelpFile=""
+ExeName32="TKUnrar.dll"
+Path32="..\..\MyProjects\TKUnrar"
+Command32=""
+Name="TKUnrar"
+HelpContextID="0"
+CompatibleMode="1"
+CompatibleEXE32="..\..\MyProjects\TKUnrar\TKUnrar.dll"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=1
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+ThreadingModel=1
+DebugStartupOption=0
+
+[MS Transaction Server]
+AutoRefresh=1

unrar/Examples/VBasic Sample 2/demo/Form1.frm

@@ -0,0 +1,93 @@
+VERSION 5.00
+Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
+Begin VB.Form Form1 
+   Caption         =   "Form1"
+   ClientHeight    =   4110
+   ClientLeft      =   60
+   ClientTop       =   345
+   ClientWidth     =   11025
+   LinkTopic       =   "Form1"
+   ScaleHeight     =   4110
+   ScaleWidth      =   11025
+   StartUpPosition =   3  'Windows Default
+   Begin VB.CommandButton Command1 
+      Caption         =   "Command1"
+      Height          =   615
+      Left            =   2640
+      TabIndex        =   1
+      Top             =   1200
+      Width           =   3135
+   End
+   Begin MSComctlLib.ProgressBar ProgressBar1 
+      Height          =   495
+      Left            =   840
+      TabIndex        =   0
+      Top             =   2640
+      Width           =   9735
+      _ExtentX        =   17171
+      _ExtentY        =   873
+      _Version        =   393216
+      Appearance      =   1
+   End
+End
+Attribute VB_Name = "Form1"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = True
+Attribute VB_Exposed = False
+Option Explicit
+
+Dim WithEvents objTKUnrar As TKUnrar.CTKUnrar
+Attribute objTKUnrar.VB_VarHelpID = -1
+'
+
+Private Sub Command1_Click()
+    Debug.Print objTKUnrar.TestRarFiles("m:\test.rar")
+End Sub
+
+Private Sub Form_Load()
+    Dim arrstrFilenames(100) As String
+
+    Set objTKUnrar = New TKUnrar.CTKUnrar
+End Sub
+
+Private Sub objTKUnrar_CommentError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+    Debug.Print "CommentError: " & strFilename & " - " & strErrorMsg
+End Sub
+
+Private Sub objTKUnrar_MissingFile(strFilename As String, strNewFilename As String)
+    Debug.Print "MissingFile: " & strFilename
+    strNewFilename = ""
+End Sub
+
+Private Sub objTKUnrar_MissingPassword(strNewPassword As String)
+    Debug.Print "MissingPassword"
+    strNewPassword = ""
+End Sub
+
+Private Sub objTKUnrar_NextVolumne(strFilename As String, blnContinue As Boolean)
+    Debug.Print "NextVolumne: " & strFilename
+    blnContinue = True
+End Sub
+
+Private Sub objTKUnrar_OpenError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+    Debug.Print "OpenError: " & strFilename & " - " & strErrorMsg
+End Sub
+
+Private Sub objTKUnrar_ProcessError(lngErrorNo As Long, strErrorMsg As String, strFilename As String)
+    Debug.Print "ProcessError: " & strFilename & " - " & strErrorMsg
+End Sub
+
+Private Sub objTKUnrar_CommentFound(strFilename As String, strComment As String)
+    Debug.Print "CommentFound: " & strFilename & "-" & strComment
+End Sub
+
+Private Sub objTKUnrar_ProcessingFile(strFilename As String, dblFileSize As Double, datFileTime As Date, intMajorVer As Integer, intMinorVer As Integer, lngPackingMethod As Long, lngFileAttr As Long)
+    Debug.Print "ProcessingFile: " & strFilename & " " & dblFileSize & " bytes"
+    ProgressBar1.Value = 0
+End Sub
+
+Private Sub objTKUnrar_Progress(dblFileSize As Double, dblExtracted As Double)
+    Debug.Print dblFileSize, dblExtracted, dblExtracted / dblFileSize * 100
+    ProgressBar1.Value = dblExtracted / dblFileSize * 100
+End Sub

unrar/Examples/VBasic Sample 2/demo/Project1.vbp

@@ -0,0 +1,34 @@
+Type=Exe
+Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#D:\WINNT\System32\stdole2.tlb#OLE Automation
+Reference=*\G{3BE86BA9-337C-4087-B2AC-4DD21A4547B2}#1.0#0#..\..\..\MyProjects\TKUnrar\TKUnrar.dll#
+Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
+Form=Form1.frm
+Startup="Form1"
+Command32=""
+Name="Project1"
+HelpContextID="0"
+CompatibleMode="0"
+MajorVer=1
+MinorVer=0
+RevisionVer=0
+AutoIncrementVer=0
+ServerSupportFiles=0
+VersionCompanyName="."
+CompilationType=0
+OptimizationType=0
+FavorPentiumPro(tm)=0
+CodeViewDebugInfo=0
+NoAliasing=0
+BoundsCheck=0
+OverflowCheck=0
+FlPointCheck=0
+FDIVCheck=0
+UnroundedFP=0
+StartMode=0
+Unattended=0
+Retained=0
+ThreadPerObject=0
+MaxNumberOfThreads=1
+
+[MS Transaction Server]
+AutoRefresh=1

unrar/Examples/VBasic Sample 2/demo/Project1.vbw

@@ -0,0 +1 @@
+Form1 = 110, 110, 878, 754, Z, 88, 88, 856, 732, C