'Beispiel : Verwendung : FreeWare-DLL "unrar.dll". Passwortgeschuetzte Archive entpacken. ' Teil. 2. 'Hinweis 1: Kopieren Sie die Datei "unrar.dll" in Ihr Systemverzeichnis. 'Hinweis 2: Der Inhalt des passwortgeschuetzten Archives wird auch ohne Uebergabe ' eines Passwortes generiert, aber ohne dessen Dateiinhalt. ' In diesem Testbeispiel ist das Passwort des RAR - Archives = Onkel Private Declare Function RAROpenArchiveA Lib "UnRAR.dll" _ Alias "RAROpenArchive" _ (ByRef RarOpenArchiveData As RAR_OPENARCHIVEDATA) _ As Long Private Declare Function RARReadHeaderA Lib "UnRAR.dll" _ Alias "RARReadHeader" _ (ByVal recHwnd As Long, _ ByRef RarReadHeaderData As RAR_READHEADERDATA) _ As Long Private Declare Function RARCloseArchiveA Lib "UnRAR.dll" _ Alias "RARCloseArchive" _ (ByVal arcHwnd As Long) _ As Long Private Declare Function RARProcessFileA Lib "UnRAR.dll" _ Alias "RARProcessFile" _ (ByVal headerHwnd As Long, _ ByVal dwProcess As Long, _ ByVal sDestinationPath As String, _ ByVal sDestinationFileName As String) _ As Long Private Declare Function RARSetPassword Lib "UnRAR.dll" _ (ByVal arcHwnd As Long, _ ByVal spw As String) As Long Private Enum RarProcess rpRarOpenModeExtract = 1 rpRarExtract = 2 End Enum Private Const MAX_ARCHIVENAMELEN = 260 Private Const MAX_FILENAMELEN = 260 Private Type RAR_OPENARCHIVEDATA srarArchiveName As String lrarOpenMode As Long lrarResult As Long srarBuffer As String lrarBufferSize As Long lrarSize As Long lrarState As Long End Type Private Type RAR_READHEADERDATA srarArchiveName As String * MAX_ARCHIVENAMELEN srarFileName As String * MAX_FILENAMELEN uFlags As Long lrarCompressedSize As Long lrarUncompressedSize As Long lrarOperatingSys As Long lrarFile As Long lrarFileTime As Long lrarUncompressedVersion As Long lrarWorkMethod As Long lrarFileAttributes As Long srarBuffer As String lrarBufferSize As Long lrarSize As Long lrarState As Long End Type Private Function fUncompressRarArchive(ByVal sSource As String, _ ByVal sDestination As String, _ ByVal spw As String) _ As Long Dim road As RAR_OPENARCHIVEDATA Dim rrhd As RAR_READHEADERDATA Dim lArchive As Long Dim iFile As Integer Dim iFiles As Integer fUncompressRarArchive = -1 road.srarArchiveName = sSource road.lrarOpenMode = RarProcess.rpRarOpenModeExtract lArchive = RAROpenArchiveA(road) If road.lrarResult <> 0 Then Exit Function If spw <> vbNullString And Not IsMissing(spw) Then RARSetPassword lArchive, spw End If iFiles = 0 iFile = RARReadHeaderA(lArchive, rrhd) Do Until iFile <> 0 Label1(0) = rrhd.srarFileName Label1(1) = rrhd.srarArchiveName Label1(2) = rrhd.lrarUncompressedSize & " Byte/s" Label1(3) = rrhd.lrarCompressedSize & " Bytes/s" Label1(4) = rrhd.lrarFileAttributes If RARProcessFileA(lArchive, RarProcess.rpRarExtract, "", sDestination + rrhd.srarFileName) = 0 Then iFiles = iFiles + 1 End If iFile = RARReadHeaderA(lArchive, rrhd) Loop RARCloseArchiveA lArchive fUncompressRarArchive = iFiles End Function Private Sub Command1_Click(Index As Integer) Select Case Index Case Is = 0: fUncompressRarArchive Text1, Text2, Text3 Case Is = 1: Unload Me End Select End Sub Private Sub Form_Load() Text1 = App.Path & "\test.rar" Text2 = App.Path & "\" End Sub