Mit dem heutigen Tipp können Sie kostenlos ein einfaches RAR-Archiv entpacken. Dazu benötigen Sie nur die UnRAR.dll von RAR-Labs. Diese können Sie hier kostenlos herunterladen: Nun müssen Sie nur noch folgenden Code in ein Modul packen: ' Allgemeine Deklarationen zum entpacken 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) ' Konstanten 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 OP_TESTT = 3 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 Die nachfolgende Funktion dient zum Entpacken von Dateien. Wenn Sie alle Dateien entpacken möchten, geben Sie einfach bei FileToExtract nichts an. ' RAR-Archiv entpacken Public Function ExtractFileFromRAR( _ RarFile As String, _ FileToExtract As String, _ Destination As String, _ Optional Password As String = "") On Error GoTo fehler Dim lHandle As Long Dim iStatus As Integer Dim uRAR As RAROpenArchiveData Dim uHeader As RARHeaderData Dim sStat As String, Ret As Long With uRAR .ArcName = RarFile .CmtBuf = Space(16384) .CmtBufSize = 16384 .OpenMode = RAR_OM_EXTRACT lHandle = RAROpenArchive(uRAR) If .OpenResult <> 0 Then OpenError .OpenResult, RarFile If Password <> "" Then RARSetPassword lHandle, Password If (.CmtState = 1) Then MsgBox .CmtBuf, vbApplicationModal + vbInformation, "Comment" iStatus = RARReadHeader(lHandle, uHeader) With uHeader Do sStat = Left$(.FileName, InStr(1, .FileName, vbNullChar) - 1) ' MsgBox sStat & vbLf & FileToExtract If InStr(1, sStat, FileToExtract, vbTextCompare) <> 0 or FileToExtract = "" Then Ret = RARProcessFile(lHandle, RAR_EXTRACT, "", Destination & "\" & .FileName) If Not FileToExtract = "" Then RARCloseArchive lHandle Exit Function End If Else Ret = RARProcessFile(lHandle, RAR_SKIP, "", "") End If If Ret = 0 Then ' Wenn kein Fehler aufgetreten ist Else ProcessError Ret End If RARReadHeader lHandle, uHeader iStatus = iStatus + 1 Loop End With End With If iStatus = ERAR_BAD_DATA Then Erro ("File header broken") RARCloseArchive lHandle Exit Function fehler: RARCloseArchive lHandle End Function ' Fehlerbehandlungsroutine Private Sub OpenError(ErroNum As Long, ArcName As String) Select Case ErroNum Case ERAR_NO_MEMORY Erro "Not enough memory", ERAR_NO_MEMORY Case ERAR_EOPEN: Erro "Cannot open " & ArcName, ERAR_EOPEN Case ERAR_BAD_ARCHIVE: Erro ArcName & " is not RAR archive", ERAR_BAD_ARCHIVE Case ERAR_BAD_DATA: Erro ArcName & ": archive header broken", ERAR_BAD_DATA End Select End Sub Private Sub ProcessError(ErroNum As Long) Select Case ErroNum Case ERAR_UNKNOWN_FORMAT Erro "Unknown archive format", ERAR_UNKNOWN_FORMAT Case ERAR_BAD_ARCHIVE: Erro "Bad volume", ERAR_BAD_ARCHIVE Case ERAR_ECREATE: Erro "File create error", ERAR_ECREATE Case ERAR_EOPEN: Erro "Volume open error", ERAR_EOPEN Case ERAR_ECLOSE: Erro "File close error", ERAR_ECLOSE Case ERAR_EREAD: Erro "Read error", ERAR_EREAD Case ERAR_EWRITE: Erro "Write error", ERAR_EWRITE Case ERAR_BAD_DATA: Erro "CRC error", ERAR_BAD_DATA End Select End Sub Private Sub Erro(Msg As String, Optional Num As Long = 0) MsgBox "Ein Fehler ist aufgetreten." & vbLf & Msg End Sub Anwendungsbeispiel: ExtractFileFromRAR App.Path & "\Test.rar", _ "testdatei.txt", App.Path & "\extract" Hier wird die Datei "Test.rar" entpackt, und zwar in den Ordner "extract". Wenn Sie alle Dateien extrahieren möchten: ExtractFileFromRAR App.Path & "\Test.rar", "", App.Path & "\extract" Dieser Tipp wurde bereits 26.372 mal aufgerufen.
Anzeige
![]() ![]() ![]() (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats ![]() Dieter Otter sevTabStrip: Rechtsklick auf Reiter erkennen Eine Funktion, mit der sich prüfen lässt, auf welchen Tab-Reiter ein Mausklick erfolgte Neu! sevDTA 3.0 Pro ![]() SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |