Code-Beispiel

Senden an: CAB-komprimierter Ordner

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	hhr	05.05.2019

Das Programm "Cabarc.exe" von Microsoft kann Cabinet-Dateien erzeugen, Inhalte auflisten und extrahieren. Hier wird ein Steuerprogramm für Cabarc.exe vorgestellt, das "Senden an: CAB-komprimierter Ordner" ermöglicht.

Man legt einen Ordner "testcab" an, kopiert testcab.bas hinein und kompiliert mit der 32Bit- oder der 64Bit-Version von FreeBasic. Von testcab.exe erstellt man eine Verknüpfung, benennt diese Verknüpfung in "CAB-komprimierter Ordner" um und wählt das Symbol aus %SystemRoot%\system32\cabview.dll. Diese Verknüpfung kopiert man in den Ordner "SendTo", der mit der Freebasic-Zeile
shell "explorer.exe shell:sendto"
geöffnet werden kann.

Cabarc.exe ist Bestandteil von "ieak.msi", das von
https://www.microsoft.com/en-us/download/details.aspx?id=40903
https://technet.microsoft.com/de-de/microsoft-edge/bb219517.aspx
https://technet.microsoft.com/en-us/microsoft-edge/bb219517.aspx
heruntergeladen werden kann.

Wie man ieak.msi entpacken kann, ohne zu installieren, wird in
http://www.computerbild.de/artikel/cb-Tipps-Software-Windows-MSI-Dateien-entpacken-Bordmittel-11748112.html
beschrieben:
msiexec /a Quelle /qn TARGETDIR=Ziel
In der FreeBasic-Zeile
shell "msiexec /a D:\ieak\ieak.msi /qn TARGETDIR=D:\ieak\ieak"
müssen die Pfadangaben angepasst werden. Um Probleme beim Entpacken zu vermeiden, kann man einen leeren Zielordner anlegen.

Wenn das Entpacken von ieak.msi gelungen ist, kopiert man Cabarc.exe in den Ordner testcab.
Der Ordner testcab enthält jetzt folgende Dateien:
cabarc.exe
testcab.bas
testcab.exe
CAB-komprimierter Ordner (Verknüpfung mit testcab.exe)

Im "Senden an"-Menü muss "CAB-komprimierter Ordner" zur Auswahl stehen.
Einzelne CAB-Dateien werden extrahiert, ansonsten wird komprimiert.
Zum Extrahieren wird von testcab.exe ein Zielordner "CabTemp" im Hauptverzeichnis angelegt, das kann man ändern.

Bemerkungen:
Im Cabinet-Format werden nur Dateien und Pfadangaben gespeichert. Leere Ordner werden nicht in die CAB-Datei aufgenommen. Wenn ein leerer Ordner aufgenommen werden soll, genügt es, in diesem eine leere Datei zu erzeugen.

Bei zu wenig Speicherplatz kann nicht auf den Datenträger geschrieben werden, es erscheinen die Meldungen:
Beim Komprimieren: FCIFlushCabinet() failed: code 6 [Could not create cabinet file]
Beim Extrahieren: FDICopy() failed: code 8 [Failure writing to target file]

Umlaute und Sonderzeichen werden im Ausgabefenster falsch geschrieben, bei Windows ist das in Ordnung.

Erstellt unter Windows 7

' testcab.bas - zu kompilieren mit -s console (Windows Console)

'=================================

If Len(Command(1)) = 0 Then End 'Beenden, wenn ohne Argumente aufgerufen.

'---------------------------------

Dim As String cabfile, file, files, sp, quotes, argument, result

Dim As Ulong attribute, number

sp = Chr(32) 'Space(1), Leerzeichen

quotes = Chr(34) 'Anführungszeichen

'---------------------------------

'Parameterzeile (Command) bearbeiten und in files zusammenstellen:

'- Hinter Ordnerangaben muss \* oder \*.* stehen.

'- Datei- und Ordnerangaben können Leerzeichen enthalten,

'  und müssen deshalb in Anführungszeichen stehen.

Do

   number += 1

   file = Command(number)

   'Dateiattribut lesen, bei Ordnern "\*.*" anfügen:

   Dir(file, &hFF, attribute)

   If Bit(attribute, 4) Then file &= "\*.*" 'Bei Ordnern ist Bit 4 gesetzt.

   'Einzelne Argumente in Anführungszeichen:

   file = quotes & file & quotes

   If number > 1 Then file = sp & file

   files &= file

Loop Until Len(Command(number + 1)) = 0

'======================================

If number = 1 And Not(Bit(attribute, 4)) And Right(Lcase(Command(1)), 4) = ".cab" Then

   'Wenn eine einzelne CAB-Datei aufgerufen wird, soll extrahiert werden.

   cabfile = files

   Dim As String dest_dir = Command(1)

   dest_dir = Left(dest_dir, Len(dest_dir) - 4) 'Erweiterung entfernen.

   dest_dir = Rtrim(dest_dir, Any sp & ".") 'Verbotene Zeichen entfernen.

   '---------------------------------

   'Zielordner wählen:

   'select case 0: working directory

   'select case 1: "CabTemp" in root directory

   'select case 2: "CabTemp" in working directory

   Select Case 1

   Case 1

      'Im Hauptverzeichnis wird ein Ordner "CabTemp" als Zielordner angelegt:

      dest_dir = Left(dest_dir, Instr(dest_dir, "\")) & "CabTemp\"_

      & Right(dest_dir, Len(dest_dir) - Instrrev(dest_dir, "\"))

   Case 2

      'Im Arbeitsverzeichnis wird ein Ordner "CabTemp" als Zielordner angelegt:

      dest_dir = Left(dest_dir, Instrrev(dest_dir, "\")) & "CabTemp\"_

      & Right(dest_dir, Len(dest_dir) - Instrrev(dest_dir, "\"))

   End Select

   '---------------------------------

   'Prüfen, ob der Name im Zielordner vergeben ist:

   result = Dir(dest_dir, &hFF, attribute)

   If Len(result) > 0 Then

      If Bit(attribute, 4) Then

         Print : Print "Im Zielordner ist ein Ordner '";Wstr(result);"' vorhanden:"

      Else

         Print : Print "Im Zielordner ist eine Datei '";Wstr(result);"' vorhanden:"

      End If

      Print : Print Wstr(dest_dir) 'Wstr wegen Umlauten und Sonderzeichen.

      Print : Print "Die CAB-Datei wird nicht extrahiert."

      Sleep : End

   End If

   dest_dir = quotes & dest_dir & quotes & "\"

   'Der Rückstrich darf in der Parameterzeile nicht in Anführungszeichen stehen.

   '---------------------------------

   'Parameterzeile für das Extrahieren:

   argument = "-p X" & sp & cabfile & sp & dest_dir

Else

   'Parameterzeile für das Komprimieren zusammenstellen:

   Dim As String options, ct, pathinf

   '---------------------------------

   ct = "LZX:21" 'compression type [LZX:<15..21>|MSZIP|NONE]

   '---------------------------------

   'Freien Dateinamen für die CAB-Datei suchen:

   Dim As Ulong label = 1

   cabfile = Command(1) & ".cab" 'Für den Dateinamen wird der erste Parameter verwendet.

   'Prüfen, ob eine Datei oder ein Ordner dieses Namens vorhanden ist.

   'Wenn vorhanden, wird eine Nummer in den Namen der zu erzeugenden Datei eingefügt:

   While Len(Dir(cabfile, &hFF)) > 0

      label += 1

      cabfile = Command(1) & sp & "(" & Str(label) & ")" & ".cab"

   Wend

   cabfile = quotes & cabfile & quotes

   '---------------------------------

   'Zu entfernende Pfadinformation erstellen:

   pathinf = Command(1)

   'Laufwerksinformation entfernen:

   pathinf = Right(pathinf, Len(pathinf) - Instr(pathinf, "\"))

   'select case 0: Folder Name not in CAB-File

   'select case 1: Folder Name in CAB-File

   Select Case 1

   Case 0

      'Bei einem einzelnen Ordner wird die gesamte Pfadinformation entfernt.

      'Bei Dateien oder mehreren Ordnern wird die Pfadinformation

      'bis zum letzten Rückstrich entfernt:

      If Not(number = 1 And Bit(attribute, 4)) Then

         pathinf = Left(pathinf, Instrrev(pathinf, "\") - 1)

      End If

   Case 1

      'Die Pfadinformation wird bis zum letzten Rückstrich entfernt:

      pathinf = Left(pathinf, Instrrev(pathinf, "\") - 1)

   End Select

   '---------------------------------

   options = "-r -p"

   If Len(pathinf) > 0 Then

      pathinf = quotes & pathinf & quotes & "\"

      options &= sp & "-P" & sp & pathinf

   End If

   options &= sp & "-m" & sp & ct

   'Parameterzeile für das Komprimieren:

   argument = options & sp & "N" & sp & cabfile & sp & files

End If

'======================================

'Chain Exepath & "\cabarc.exe" 'Copyright und Bedienungshinweise von cabarc.exe anzeigen.

Print : Print Wstr(argument)

Err = Exec(Exepath & "\cabarc.exe", argument)

If Err = -1 Then Print : Print "Cabarc.exe konnte nicht gefunden werden."

Sleep

End 'testcab.bas

'

Im Ordner "FreeBASIC-1.05.0-winXX\examples\GUI\win32" befindet sich das Programm "shellfolder.bas".
Dieses Programm kann man kompilieren und starten.

Man kann "shellfolder.bas" in den Ordner testcab kopieren und die letzten beiden Zeilen mit Kommentarzeichen deaktivieren, sodass nur die beiden Funktionen aktiviert bleiben.
In Zeile 73 fügt man in
function = ""
zum Beispiel ein Fragezeichen ein:
function = "?".
Das ist der Rückgabewert bei "Cancel/Abbrechen", dieser soll sich von einem leeren Rückgabewert unterscheiden.

In testcab.bas macht man mit Return die erste Zeile frei und fügt

#include "shellfolder.bas"

ein.

Im Abschnitt "Zielordner wählen" fügt man dann

'select case 3: Browse for Folder / Ordner suchen

und

   Case 3

      Dim As String getfolder, defaultfolder = Left(dest_dir, Instrrev(dest_dir, "\"))

      Do

         getfolder = BrowseForFolder(NULL, "", BIF_RETURNONLYFSDIRS, defaultfolder)

         If Len(getfolder) = 0 Then Print : Print "An diesem Ort kann nicht gespeichert werden."

      Loop While Len(getfolder) = 0

      If getfolder = "?" Then End

      If Right(getfolder, 1) <> "\" Then getfolder &= "\"

      getfolder &= "CabTemp\"

      dest_dir = getfolder & Right(dest_dir, Len(dest_dir) - Instrrev(dest_dir, "\"))

ein.

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 25.05.2018 von hhr angelegt.
Die aktuellste Version wurde am 05.05.2019 von hhr gespeichert.

Bearbeiten

Versionen