Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Dateien und Laufwerke

Senden an: CAB-komprimierter Ordner

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Mitgliedhhr 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 Mitgliedhhr angelegt.
  • Die aktuellste Version wurde am 05.05.2019 von Mitgliedhhr gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen