243 lines
7.1 KiB
Plaintext
243 lines
7.1 KiB
Plaintext
VERSION 5.00
|
|
Begin VB.Form Form1
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "UnRAR.dll Visual Basic Example"
|
|
ClientHeight = 5325
|
|
ClientLeft = 45
|
|
ClientTop = 345
|
|
ClientWidth = 6990
|
|
ControlBox = 0 'False
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 5325
|
|
ScaleWidth = 6990
|
|
StartUpPosition = 2 'CenterScreen
|
|
Begin VB.CommandButton Command5
|
|
Cancel = -1 'True
|
|
Caption = "&Exit"
|
|
Default = -1 'True
|
|
Enabled = 0 'False
|
|
Height = 375
|
|
Left = 120
|
|
TabIndex = 1
|
|
Top = 4920
|
|
Width = 6735
|
|
End
|
|
Begin VB.ListBox List1
|
|
Height = 4740
|
|
Left = 120
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 6735
|
|
End
|
|
End
|
|
Attribute VB_Name = "Form1"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
'******************************************************************
|
|
'
|
|
' Ported to Visual Basic by Pedro Lamas
|
|
'
|
|
'E-mail: sniper@hotpop.com
|
|
'HomePage (dedicated to VB): www.terravista.pt/portosanto/3723/
|
|
'
|
|
'******************************************************************
|
|
|
|
Const ERAR_END_ARCHIVE = 10
|
|
Const ERAR_NO_MEMORY = 11
|
|
Const ERAR_BAD_DATA = 12
|
|
Const ERAR_BAD_ARCHIVE = 13
|
|
Const ERAR_UNKNOWN_FORMAT = 14
|
|
Const ERAR_EOPEN = 15
|
|
Const ERAR_ECREATE = 16
|
|
Const ERAR_ECLOSE = 17
|
|
Const ERAR_EREAD = 18
|
|
Const ERAR_EWRITE = 19
|
|
Const ERAR_SMALL_BUF = 20
|
|
|
|
Const RAR_OM_LIST = 0
|
|
Const RAR_OM_EXTRACT = 1
|
|
|
|
Const RAR_SKIP = 0
|
|
Const RAR_TEST = 1
|
|
Const RAR_EXTRACT = 2
|
|
|
|
Const RAR_VOL_ASK = 0
|
|
Const RAR_VOL_NOTIFY = 1
|
|
|
|
Enum RarOperations
|
|
OP_EXTRACT = 0
|
|
OP_TEST = 1
|
|
OP_LIST = 2
|
|
End Enum
|
|
|
|
Private 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
|
|
|
|
Private 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
|
|
|
|
Private Declare Function RAROpenArchive Lib "unrar.dll" (ByRef ArchiveData As RAROpenArchiveData) As Long
|
|
Private Declare Function RARCloseArchive Lib "unrar.dll" (ByVal hArcData As Long) As Long
|
|
Private Declare Function RARReadHeader Lib "unrar.dll" (ByVal hArcData As Long, ByRef HeaderData As RARHeaderData) As Long
|
|
Private Declare Function RARProcessFile Lib "unrar.dll" (ByVal hArcData As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
|
|
Private Declare Sub RARSetChangeVolProc Lib "unrar.dll" (ByVal hArcData As Long, ByVal Mode As Long)
|
|
Private Declare Sub RARSetPassword Lib "unrar.dll" (ByVal hArcData As Long, ByVal Password As String)
|
|
|
|
Private Sub Command5_Click()
|
|
End
|
|
End Sub
|
|
|
|
Private Sub RARExecute(Mode As RarOperations, RarFile As String, Optional Password As String)
|
|
' Description:-
|
|
' Extract file(s) from RAR archive.
|
|
' Parameters:-
|
|
' Mode = Operation to perform on RAR Archive
|
|
' RARFile = RAR Archive filename
|
|
' sPassword = Password (Optional)
|
|
Dim lHandle As Long
|
|
Dim iStatus As Integer
|
|
Dim uRAR As RAROpenArchiveData
|
|
Dim uHeader As RARHeaderData
|
|
Dim sStat As String, Ret As Long
|
|
|
|
uRAR.ArcName = RarFile
|
|
uRAR.CmtBuf = Space(16384)
|
|
uRAR.CmtBufSize = 16384
|
|
|
|
If Mode = OP_LIST Then
|
|
uRAR.OpenMode = RAR_OM_LIST
|
|
Else
|
|
uRAR.OpenMode = RAR_OM_EXTRACT
|
|
End If
|
|
|
|
lHandle = RAROpenArchive(uRAR)
|
|
If uRAR.OpenResult <> 0 Then OpenError uRAR.OpenResult, RarFile
|
|
|
|
If Password <> "" Then RARSetPassword lHandle, Password
|
|
|
|
If (uRAR.CmtState = 1) Then MsgBox uRAR.CmtBuf, vbApplicationModal + vbInformation, "Comment"
|
|
|
|
iStatus = RARReadHeader(lHandle, uHeader)
|
|
Show
|
|
Do Until iStatus <> 0
|
|
sStat = Left(uHeader.FileName, InStr(1, uHeader.FileName, vbNullChar) - 1)
|
|
Select Case Mode
|
|
Case RarOperations.OP_EXTRACT
|
|
List1.AddItem "Extracting " & sStat
|
|
Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", uHeader.FileName)
|
|
Case RarOperations.OP_TEST
|
|
List1.AddItem "Testing " & sStat
|
|
Ret = RARProcessFile(lHandle, RAR_TEST, "", uHeader.FileName)
|
|
Case RarOperations.OP_LIST
|
|
List1.AddItem "File: " & sStat & vbTab & vbTab & vbTab & "Size: " & uHeader.UnpSize
|
|
Ret = RARProcessFile(lHandle, RAR_SKIP, "", "")
|
|
End Select
|
|
|
|
If Ret = 0 Then
|
|
List1.List(List1.ListCount - 1) = List1.List(List1.ListCount - 1) & vbTab & vbTab & "OK"
|
|
Else
|
|
ProcessError Ret
|
|
End If
|
|
|
|
iStatus = RARReadHeader(lHandle, uHeader)
|
|
Refresh
|
|
Loop
|
|
|
|
If iStatus = ERAR_BAD_DATA Then Erro ("File header broken")
|
|
|
|
RARCloseArchive lHandle
|
|
End Sub
|
|
|
|
Private Sub Form_Load()
|
|
Dim Vals() As String, Msg As String
|
|
If Command = "" Then
|
|
Msg = "VBUNRAR.EXE. This is a simple example of UNRAR.DLL usage" & vbCrLf & vbCrLf
|
|
Msg = Msg & "Syntax:" & vbCrLf
|
|
Msg = Msg & "VBUNRAR X <Archive> <Password> extract archive contents" & vbCrLf
|
|
Msg = Msg & "VBUNRAR T <Archive> <Password> test archive contents" & vbCrLf
|
|
Msg = Msg & "VBUNRAR L <Archive> <Password> view archive contents"
|
|
MsgBox Msg, vbApplicationModal + vbInformation, "VBUnRAR"
|
|
End
|
|
End If
|
|
Vals = Split(Command, " ")
|
|
|
|
ReDim Preserve Vals(2)
|
|
If Vals(0) = "" Or Vals(1) = "" Then Erro ("Missing arguments!")
|
|
Select Case UCase(Vals(0))
|
|
Case "X"
|
|
RARExecute OP_EXTRACT, Vals(1), Vals(2)
|
|
Case "T"
|
|
RARExecute OP_TEST, Vals(1), Vals(2)
|
|
Case "L"
|
|
RARExecute OP_LIST, Vals(1), Vals(2)
|
|
Case Else
|
|
Erro "Invalid Arguments!"
|
|
End Select
|
|
Command5.Enabled = True
|
|
End Sub
|
|
|
|
Private Sub OpenError(ErroNum As Long, ArcName As String)
|
|
Select Case ErroNum
|
|
Case ERAR_NO_MEMORY
|
|
Erro "Not enough memory"
|
|
Case ERAR_EOPEN:
|
|
Erro "Cannot open " & ArcName
|
|
Case ERAR_BAD_ARCHIVE:
|
|
Erro ArcName & " is not RAR archive"
|
|
Case ERAR_BAD_DATA:
|
|
Erro ArcName & ": archive header broken"
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub ProcessError(ErroNum As Long)
|
|
Select Case ErroNum
|
|
Case ERAR_UNKNOWN_FORMAT
|
|
Erro "Unknown archive format"
|
|
Case ERAR_BAD_ARCHIVE:
|
|
Erro "Bad volume"
|
|
Case ERAR_ECREATE:
|
|
Erro "File create error"
|
|
Case ERAR_EOPEN:
|
|
Erro "Volume open error"
|
|
Case ERAR_ECLOSE:
|
|
Erro "File close error"
|
|
Case ERAR_EREAD:
|
|
Erro "Read error"
|
|
Case ERAR_EWRITE:
|
|
Erro "Write error"
|
|
Case ERAR_BAD_DATA:
|
|
Erro "CRC error"
|
|
End Select
|
|
End Sub
|
|
|
|
Private Sub Erro(Msg As String)
|
|
MsgBox Msg, vbApplicationModal + vbExclamation, "Error"
|
|
End
|
|
End Sub
|