Workaround - ZipPacker BUG [PB 5.21 LTS]

[Thorsten1867]

Solange das Bug in PB 5.21 nicht behoben ist, hier ein Workaround:

1. ZipPacker.dll (Pack-Routinen aus PB 5.11)
2. ZipPacker.pbi (Include)

ZipPacker.pbi

Code: Alles auswählen

;/ === ZipPacker - Include (DLL) ===
;/ by Thorsten Hoeppner (Thorsten1867)

Prototype.i PType_ZIP_ExaminePack(PackID.i)
Prototype.i PType_ZIP_NextPackEntry(PackID.i)
Prototype.s PType_ZIP_PackEntryName(PackID.i)
Prototype.i PType_ZIP_PackEntrySize(PackID.i, Modus.i=#PB_Packer_UncompressedSize)
Prototype.i PType_ZIP_PackEntryType(PackID.i)
Prototype.i PType_ZIP_UncompressMemory(*Buffer, Size.i, *Output, OutputSize.i)
Prototype.i PType_ZIP_CompressMemory(*Buffer, Size.i, *Output, OutputSize.i)
Prototype.i PType_ZIP_AddPackMemory(PackID.i, *Buffer, Size.i, PackFileName.s)
Prototype.i PType_ZIP_RemovePackFile(PackID.i, File.s)
Prototype.i PType_ZIP_UncompressPackFile(PackID.i, File.s, PackFileName.s)
Prototype.i PType_ZIP_AddPackFile(PackID.i, File.s, PackFileName.s)
Prototype   PType_ZIP_ClosePack(PackID.i)
Prototype.i PType_ZIP_OpenPack(PackID.i, ZipFile.s)
Prototype.i PType_ZIP_CreatePack(PackID.i, ZipFile.s)

ZipLib = OpenLibrary(#PB_Any, "ZipPacker.dll")
If ZipLib
  Global ZIP_ExaminePack.PType_ZIP_ExaminePack               = GetFunction(ZipLib, "ZIP_ExaminePack")
  Global ZIP_NextPackEntry.PType_ZIP_NextPackEntry           = GetFunction(ZipLib, "ZIP_NextPackEntry")
  Global ZIP_PackEntryName.PType_ZIP_PackEntryName           = GetFunction(ZipLib, "ZIP_PackEntryName")
  Global ZIP_PackEntrySize.PType_ZIP_PackEntrySize           = GetFunction(ZipLib, "ZIP_PackEntrySize")
  Global ZIP_PackEntryType.PType_ZIP_PackEntryType           = GetFunction(ZipLib, "ZIP_PackEntryType")
  Global ZIP_UncompressMemory.PType_ZIP_UncompressMemory     = GetFunction(ZipLib, "ZIP_UncompressMemory")
  Global ZIP_CompressMemory.PType_ZIP_CompressMemory         = GetFunction(ZipLib, "ZIP_CompressMemory")
  Global ZIP_AddPackMemory.PType_ZIP_AddPackMemory           = GetFunction(ZipLib, "ZIP_AddPackMemory")
  Global ZIP_RemovePackFile.PType_ZIP_RemovePackFile         = GetFunction(ZipLib, "ZIP_RemovePackFile")
  Global ZIP_UncompressPackFile.PType_ZIP_UncompressPackFile = GetFunction(ZipLib, "ZIP_UncompressPackFile")
  Global ZIP_AddPackFile.PType_ZIP_AddPackFile               = GetFunction(ZipLib, "ZIP_AddPackFile")
  Global ZIP_ClosePack.PType_ZIP_ClosePack                   = GetFunction(ZipLib, "ZIP_ClosePack")
  Global ZIP_OpenPack.PType_ZIP_OpenPack                     = GetFunction(ZipLib, "ZIP_OpenPack")
  Global ZIP_CreatePack.PType_ZIP_CreatePack                 = GetFunction(ZipLib, "ZIP_CreatePack")
EndIf

CompilerIf #PB_Compiler_IsMainFile
  
  #Pack = 1
  #Datei = 2
  PackFile$ = "E:\Temp\Zip_Test.zip"
  File$ = "E:\Temp\Test.txt"
  
  Procedure File2Pack(File.s)
    If ReadFile(#Datei, File)
      length = Lof(#Datei)
      *MemoryID = AllocateMemory(length)
      If *MemoryID
        If ReadData(#Datei, *MemoryID, length)
          ZIP_AddPackMemory(#Pack, *MemoryID, length, "Test.txt")
        EndIf
        FreeMemory(*MemoryID)
      EndIf
      CloseFile(#Datei)
    EndIf
  EndProcedure
  
  If ZIP_CreatePack(#Pack, PackFile$)
    File2Pack(File$)
    ZIP_ClosePack(#Pack)
  EndIf
  
CompilerEndIf

[ts-soft]

Mein Workaround wäre:

Code: Alles auswählen

EnableExplicit

UseZipPacker()
#Pack = 1
#Datei = 2
Define PackFile$ = GetTemporaryDirectory() + "Test.zip"
Define File$ = #PB_Compiler_Home + "SDK\CompilerInterface.txt"

Procedure File2Pack(File.s)
  Protected length, *MemoryID
  
  If ReadFile(#Datei, File)
    length = Lof(#Datei)

    *MemoryID = AllocateMemory(length)
    If *MemoryID
      ReadData(#Datei, *MemoryID, length)
    EndIf
    CloseFile(#datei)
    ProcedureReturn *MemoryID
  EndIf
EndProcedure

Define *mem
If CreatePack(#Pack, PackFile$, #PB_PackerPlugin_Zip)
  *mem = File2Pack(File$)
  AddPackMemory(#Pack, *mem, MemorySize(*mem), "Test.txt")
  ClosePack(#Pack)
  FreeMemory(*mem)
EndIf 

Warum der Umweg über den Speicher, ist mir zwar auch nicht klar, aber irgendeinen Grund wirste ja haben, warum
Du Dir das Leben schwer machst

Gruß
Thomas

[Thorsten1867]

Es gibt schon einen Grund, es ist also noch nicht die beginnende Programmiererdemenz.
Es war nur der einfachste Weg das Problem zu reproduzieren.

Ich hoffe hiermit kann ich dich von meiner geistigen Zurechnungsfähigkeit überzeugnen:

Code: Alles auswählen

#AESKey = "123456"
#AESExt = "ABCD"
Procedure.b WriteAESPack(PackID.l, File.s, DESPassword.s, FileID.s="KvGS", quiet.b=#False)
  Protected FileLength.l, SFId.l, key$= #AESKey, result.b = #False
  Protected *FileMemory, *Memory, *MemoryID
  Protected FileName.s = GetFilePart(File)
  Protected AesFile.s = FileNoExtension(FileName)+"."+#AESExt
  
  If FileSize(File) <= 0 : ProcedureReturn #False : EndIf
  
  SFId = ReadFile(#PB_Any, File)
  If SFId
    FileLength = Lof(SFId)                                     ; Dateilänge
    *FileMemory = AllocateMemory(FileLength)
    If *FileMemory
      If ReadData(SFId, *FileMemory, FileLength)
        ; Headergröße berechnen
        HeaderLen = StringByteLength(FileID) + StringByteLength(DESPassword) + StringByteLength(FileName) + 11
        ; Speicher für Header & Datei reservieren
        MemSize = HeaderLen + MemorySize(*FileMemory)
        *Memory = AllocateMemory(MemSize)
        If *Memory
          *MemoryID = *Memory
          ;{ Header schreiben
          PokeS(*MemoryID, FileID)                       ; FileID (z.B. "myProg")
          *MemoryID + StringByteLength(FileID) + 1
          PokeL(*MemoryID, FileLength)                       ; Länge der eigentlichen Datei
          *MemoryID + 4
          PokeS(*MemoryID, DESPassword)                  ; DES-Passwort
          *MemoryID + StringByteLength(DESPassword) + 1
          PokeS(*MemoryID, FileName)                         ; Dateiname
          *MemoryID + StringByteLength(FileName) + 1
          ;}
          If AESEncoder(*FileMemory, *MemoryID, MemorySize(*FileMemory), @key$, 128, 0, #PB_Cipher_ECB)
            RemovePackFile(PackID, AesFile) 
            If AddPackMemory(PackID, *Memory, MemSize, AesFile)
              result = #True
            EndIf
          EndIf
          FreeMemory(*Memory)
        EndIf
      ElseIf quiet = #False
        MessageRequester(" KvGS - Datei öffnen", "Datei konnte nicht gelesen werden!", #MB_OK|#MB_ICONERROR)
      EndIf
      FreeMemory(*FileMemory)
    EndIf
    CloseFile(SFId)
  EndIf
  ProcedureReturn result
EndProcedure

[Thorsten1867]

Mein Workaround wäre:

Warum funktioniert es bei dir???

Erst dachte ich es liegt an der Procedure und dem *Pointer.

Aber das ist der Code, bei dem mir der Fehler zuerst aufgefallen ist:

Code: Alles auswählen

Procedure kvDC_CloseContentXML()                                       ; XML-Datei (mit ggf. aktualiserten Daten) im FileContainer zurückschreiben 
  Protected *XmlMem, XmlSize.l, result.l = #False
  If IsXML(#XmlKvDC)
    XmlSize = ExportXMLSize(#XmlKvDC)
    *XmlMem = AllocateMemory(XmlSize)
    If *XmlMem
      If ExportXML(#XmlKvDC, *XmlMem, XmlSize)
        RemovePackFile(#PackKvDC, "content.xml")
        result = AddPackMemory(#PackKvDC, *XmlMem, XmlSize, "content.xml")
      EndIf  
      FreeMemory(*XmlMem)
    EndIf
    FreeXML(#XmlKvDC)
  EndIf
EndProcedure

Hier bleiben alle Pointer innerhalb der Procedure?!?

[ts-soft]

Auch den Code kann man in 2 Proceduren aufteilen und somit das Problem mit dem Packer umgehen.

Lustig finde ich immer diese Procedure.b, Du gibst #True oder #False zurück, das sind Longs!
(wüßte nicht, wann Procedure.b Sinn machen sollte, ein Integer auf dem Stack legen für die Rückgabe
ist immer noch das simpelste und schnellste)

Die libzip ist schon ein wenig merkwürdig, die wird uns wohl noch viele Probleme bereiten.

Gruß
Thomas

//edit
Dein letztes Posting noch nicht gelesen gehabt, bezog mich auf das vorherige.
Auch hier sollte das Trennen der XML Funktionen und der Packroutinen den Bug beseitigen.

[Thorsten1867]

Auch den Code kann man in 2 Proceduren aufteilen und somit das Problem mit dem Packer umgehen.

Warum funktioniert es wenn man es aufteilt???

Lustig finde ich immer diese Procedure.b, Du gibst #True oder #False zurück, das sind Longs!
(wüßte nicht, wann Procedure.b Sinn machen sollte, ein Integer auf dem Stack legen für die Rückgabe
ist immer noch das simpelste und schnellste)

Das liegt daran, dass ich absoluter Programmier-Laie bin, sprich beruflich nichts (direkt) mit Computern zu tun habe.
Aber ich lerne gerne dazu. (Das dürfte eine längere Suchen & Ersetzen Aktion werden)

[ts-soft]

Aber ich lerne gerne dazu. (Das dürfte eine längere Suchen & Ersetzen Aktion werden)

Die Arbeits brauchste Dir nicht machen, lohnt nicht. Aber in Zukunft einfach das .b weglassen.

Die Packlib bringt irgendwie Speicherbereiche und Handles durcheinander. Bisher hab ich durch Trennen der Vorbereitungs-
funktionen und dem eigentlichem Packen erfolg gehabt.

[Thorsten1867]

Die Arbeits brauchste Dir nicht machen, lohnt nicht. Aber in Zukunft einfach das .b weglassen.

Möchte mich sowieso irgendwann an einer 64Bit Version meines Programmes versuchen. Der erste Schritt, die 32Bit Libs zu ersetzten, ist ja schon auf einem guten Weg.
Der nächste Schritt wäre wohl dann etliche Variablen von Word und Long in Integer zu ändern.

[ts-soft]

Aber nicht einfach alle ändern, es gibt auch Situationen, wo der Typ wichtig ist.
Wichtig in Strukturen und Interfaces (hier machen auch Rückgabetypen wie .b Sinn).
Wichtig bei der Nutzung mit API.
Wichtig wenn << >> | & usw. genutzt werden.
Und natürlich, wenn Du mit Zeichen oder Speicher arbeitest.

Beim Rest sollte Integer das richtige sein (wenn Ganzzahlen erforderlich sind und die Größe ausreicht).

[Thorsten1867]

DANKE!
Mal schauen, welche Überraschungen (außer dem Packer-Dokumenten-Shredder) bei der Konvertierung nach PB 5.21 noch auftauchen.