Zuerst muss die Dateiliste für den Parameter der Funktion MakeOneFile vorbereitet werden. Die einzelnen Dateinamen müssen samt Pfad, durch das Zeichen Chr(0) getrennt, in einer Variable gespeichert werden. Beispiel: "C:\Datei1.exe" & Chr(0) & "C:\Datei2.exe" & Chr(0) & "C:\Datei3.exe" Die Funktionen: Function MakeOneFile(pFiles As String, _ Optional ByVal sPath As String = "") As Boolean Dim ff As Integer ' FreeFile zum öffnen der Dateien Dim i As Integer ' Zählervariable Dim sName As String * 128 ' String mit Dateiname (128 Zeichen Länge) Dim sSize As String * 10 ' String mit Dateigröße (10 Zeichen Länge) Dim sData As String ' String mit Dateiinhalt Dim sFiles() As String ' Dateipfade/namen On Error GoTo ErrHandler ' Dateipfad festlegen: Applikationsverzeichnis + ' Dateiname ("files.dat") ' Die Änderung des Pfades/Dateinamens ist ' problemlos möglich If sPath = "" Then sPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & _ "files.dat" End If ' Wenn vorhanden Trennzeichen (Chr(0)) am Ende entfernen If Right(pFiles, 1) = Chr(0) Then pFiles = _ Left(pFiles, Len(pFiles) - 1) ' Prüfen, ob Parameter mehr als eine Datei enthält If InStr(1, pFiles, Chr(0)) > 0 Then ' Parameter pFiles in einzelne Dateinamen splitten ' (Trennzeichne ist Chr(0)) sFiles = Split(pFiles, Chr(0)) ' Wenn die Ergebnisdatei schon existiert, soll ' diese gelöscht werden If Dir(sPath) <> "" Then Kill sPath ' Alle Dateien im Array sFiles durchlaufen For i = 0 To UBound(sFiles) ' Prüfen, ob Datei existiert, wenn nicht zur ' nächsten Datei gehen If Dir(sFiles(i)) <> "" Then ' sName wird auf den Dateinamen (ohne ' Pfadangabe) gesetzt sName = Right(sFiles(i), Len(sFiles(i)) - _ InStrRev(sFiles(i), "\")) ' sSize wird auf die Dateigröße gesetzt sSize = FileLen(sFiles(i)) ' Dateinummer zum Öffnen bestimmen ff = FreeFile ' Datei öffnen und Inhalt in der Variable ' sData speichern Open sFiles(i) For Binary As ff sData = Space(LOF(ff)) Get #ff, , sData Close ff ' Dateinummer zum Öffnen bestimmen ff = FreeFile ' Enddatei öffnen und ans Ende springen Open sPath For Binary As ff Seek #ff, LOF(ff) + 1 ' Den Namen, die Größe und den Dateiinhalt am ' Ende der Datei speichern Put #ff, , CStr(sName & sSize & sData) Close ff End If Next MakeOneFile = True Else MsgBox "Eine oder keine Dateien angegeben!" & vbCrLf & _ "Zusammenfassen der Datei(en) nicht nötig/möglich", _ vbCritical, "Fehler" MakeOneFile = False End If Exit Function ErrHandler: MsgBox Err.Number & ": " & Err.Description, _ vbCritical, "Fehler" MakeOneFile = False End Function Function ExtractFiles(sFilePath As String, _ Optional ByVal sPath As String = "") As Boolean Dim sFileData As String ' Dateiinhalt der .dat-Datei Dim sName As String ' Dateiname Dim sSize As String ' Dateigröße (wichtig zum extrahieren) Dim sData As String ' Dateiinhalt der extrahierten Datei Dim ff As Integer ' FreeFile zum öffnen der Dateien ' Bei einem Fehler zur definierten Sprungmarke gehen On Error GoTo ErrHandler ' Pfad zur Extraktion setzen. Dieser ist problemlos ' änderbar (Wichtig ist das "\" am Ende) If sPath = "" Then sPath = App.Path sPath = sPath & IIf(Right(sPath, 1) = "\", "", "\") ' Dateinummer zum Öffnen bestimmen ff = FreeFile ' Datei öffnen und Inhalt in Variable ' sFileData speichern Open sFilePath For Binary As ff sFileData = Space(LOF(ff)) Get #ff, , sFileData Close ff While Len(sFileData) > 0 ' Dateinamen aus sFileData filtern und ' rechtsstehende Leerzeichen abtrennen sName = RTrim(Left(sFileData, 128)) ' Dateigröße aus sFileData filtern und ' rechtsstehende Leerzeichen abtrennen sSize = RTrim(Mid(sFileData, 129, 10)) ' Dateiinhalt aus sFileData lesen sData = Mid(sFileData, 139, sSize) ' Dateinummer zum Öffnen bestimmen ff = FreeFile ' Wenn die zu extrahierende Datei bereits besteht, ' diese löschen If Dir(sPath & sName) <> "" Then Kill sPath & sName ' Datei öffnen und Dateiinhalt abspeichern Open sPath & sName For Binary As ff Put #ff, , CStr(sData) Close ff ' Bereits extrahierten Teil aus sFileData entfernen sFileData = Right(sFileData, Len(sFileData) - _ 138 - sSize) ExtractFiles = True Wend Exit Function ErrHandler: MsgBox Err.Number & ": " & Err.Description, _ vbCritical, "Fehler" ExtractFiles = False End Function Dieser Tipp wurde bereits 17.871 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (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 März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevCommand 4.0 Professionelle Schaltflächen im modernen Design! Mit nur wenigen Mausklicks statten auch Sie Ihre Anwendungen ab sofort mit grafischen Schaltflächen im modernen Look & Feel aus (WinXP, Office, Vista oder auch Windows 8), inkl. große Symbolbibliothek. |
||||||||||||||||
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. |