File2PBSource v1.21

Frogger · Beitrag von **Frogger** » 18.04.2006 21:39

So, hab etwas Zeit gefunden um an diesem Programm etwas herum zu feilen.
Der erzeugte Code ist für PB3.90.

Hinzugekommen ist:
- Dateilisten speichern und laden
- Ordnerinhalt hinzufügen (optional mit Unterordner)
- Kompremierung der Dateien mit dem PureBasic-Packer
- und ein Dialog zum Extrahieren im Quellcode (so ähnlich wie ein selbst entpackendes Archiv)

Für die nächste Version will ich eine Auswahlmöglichkeit zwischen mehreren PB-Versionen einbauen. Je nachdem welche gewählt wird, soll ein Code erstellt werden, der auf diese PB-Version abgestimmt ist.
Doch dazu brauche ich eure Hilfe.
Ich wäre dankbar, wenn ihr den folgenden Code auf andere PB-Versionen
umschreibt und hier postet.

Code: Alles auswählen

Procedure Extract_Test_txt(Zielpfad.s, Modus.l) ;Modus.l -> 0=Datei Extrahieren ; 1=Speicheradresse als Rückgabewert ; 2=Dateilänge als Rückgabewert ; 3=Kompressionsstatus als Rückgabewert (1=komprimiert, 0=unkompriniert)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  StartBuffer.l   = ?File1
  BufferLength.l  = ?Ende1-?File1
  Restore start1
  Read OriginalLength.l
  Read KompressStatus.b
  If Modus.l = 1   ;Speicheradresse als Rückgabewert
    If KompressStatus.b = 0
      ProcedureReturn StartBuffer.l
    Else
      *FileBuffer = AllocateMemory(OriginalLength)
      If *FileBuffer
        Unpacklength.l = UnpackMemory(StartBuffer, *FileBuffer)
        If Unpacklength.l = OriginalLength
          ProcedureReturn *FileBuffer
        EndIf
      EndIf
    EndIf
  ElseIf Modus.l = 2   ;Dateilänge als Rückgabewert
    ProcedureReturn OriginalLength.l
  ElseIf Modus.l = 3 ;Kompressionsstatus als Rückgabewert (1=komprimiert, 0=unkompriniert)
    ProcedureReturn KompressStatus.b
  ElseIf Modus = 0 ;Extrahiere die Datei
    If FileExists(Zielpfad.s+"Test.txt") = 1
      ProcedureReturn 2
    EndIf
    If KompressStatus = 0
      If CreateFile(0, Zielpfad.s+"Test.txt")
        WriteData(StartBuffer.l, OriginalLength)
        CloseFile(0)
      EndIf
    ElseIf KompressStatus = 1 ;Entpacke erst die daten
      *ZielBuffer = AllocateMemory(OriginalLength)
      If *ZielBuffer
        Unpacklength.l = UnpackMemory(StartBuffer, *ZielBuffer)
        If Unpacklength.l = OriginalLength
          If CreateFile(0, Zielpfad.s+"Test.txt")
            WriteData(*ZielBuffer, Unpacklength.l)
            CloseFile(0)
            FreeMemory(*ZielBuffer)
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf

  DataSection
  start1:
  Data.l 178   ;Originallänge der Datei in Byte
  Data.b 1   ;Datei ist komprimiert
  File1:   ; Packrate: 91.01%  OriginalSize: 178  PackSize: 162
  Data.l 11682634, 467468288, -323600931, 189604053, 1422778962, -1677417756, -331952987, -1609290650, -1776850015, 1633333526, -1246711293, -570061356, 653038990, 1845659372, 374652961, -1526183024, -748483072, -2131694130, -153053483, -613480659, -468081222, 540558595, -2051265226, -919531766, -1951861296, -1001779449, 692456656, 180409197, 1077162866, -1217284078, -772994174, 185794565, 22035822, -761223047, 1730754880, -1833208097, 553542070, -1591463159, 1242958529, 46171, 38656
  Ende1:
  EndDataSection
  ProcedureReturn 1
EndProcedure


Procedure Extract_All(Zielpfad.s)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  Extract_Test_txt(Zielpfad.s, 0)
 ProcedureReturn 1
EndProcedure

Procedure Delete_All(Zielpfad.s)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  If FileSize(Zielpfad.s+"Test.txt") > 0
    DeleteFile(Zielpfad.s+"Test.txt")
  EndIf
  ProcedureReturn 1
EndProcedure




Enumeration
  #Window_F2PBS_Entpacken
EndEnumeration
Enumeration
  #Frame3D_F2PBS_Entpacken
  #Text_F2PBS_TXT
  #String_F2PBS_Pfad
  #Button_F2PBS_Ordner_Suchen
  #Button_F2PBS_Exit
  #Button_F2PBS_Extrahieren
EndEnumeration
Procedure Open_Window_F2PBS_Entpacken()
  If OpenWindow(#Window_F2PBS_Entpacken, 321, 421, 345, 101,  #PB_Window_SystemMenu | #PB_Window_TitleBar , "Entpacken")
    If CreateGadgetList(WindowID())
      Frame3DGadget(#Frame3D_F2PBS_Entpacken, 5, 5, 335, 60, "Entpacken")
      TextGadget(#Text_F2PBS_TXT, 15, 20, 55, 15, "Pfad:")
      StringGadget(#String_F2PBS_Pfad, 15, 35, 295, 18, "")
      ButtonGadget(#Button_F2PBS_Ordner_Suchen, 315, 35, 18, 18, ">>")
      ButtonGadget(#Button_F2PBS_Exit, 270, 70, 70, 25, "Exit")
      ButtonGadget(#Button_F2PBS_Extrahieren, 5, 70, 70, 25, "Extrahieren") 
    EndIf 
    
    Exit = 0
    If WindowID()
      Repeat
        
        Select WaitWindowEvent()
          Case #PB_Event_Gadget
            Select EventGadgetID() 
              Case #Button_F2PBS_Ordner_Suchen : Path.s = PathRequester("Pfad", "") : If Path.s <> "" : SetGadgetText(#String_F2PBS_Pfad, Path.s) : EndIf 
              Case #Button_F2PBS_Exit : Exit = 1
              Case #Button_F2PBS_Extrahieren : If Len(Path.s)>=2 : Extract_All(Path.s) : MessageRequester("Info", "Vorgang abgeschlossen!") : Exit = 1 : EndIf
            EndSelect 
          Case #PB_EventCloseWindow
            Exit = 1
        EndSelect 
      Until Exit = 1 
      
    EndIf 
  EndIf
EndProcedure

Open_Window_F2PBS_Entpacken()

hardfalcon · Beitrag von **hardfalcon** » 18.04.2006 21:52

Ich hab mir das Programm zwar nit angeschaut, aber mal ne Frage:
Warum nit einfach das hier?

Code: Alles auswählen

DataSection
  MapLabel:
    IncludeBinary "Data\map.data"
EndDataSection

//EDIT: Sry, hab erst jetzt bemerkt, dass das ganze komprimiert hinzugefügt wird.

Frogger · Beitrag von **Frogger** » 18.04.2006 22:17

Und außerdem sind alle Dateien direkt im Code und nach dem Compilieren in der EXE.
Mit IncludeBinary muss die Datei irgendwo auf der Festplatte sein.

Das ist eine andere Lösung für das gleiche Problem aber mir gefällt sie am besten.

ts-soft · Beitrag von **ts-soft** » 18.04.2006 22:54

Kann man auch den Menüpunkt: IncludeBinary in jaPBe verwenden, bzw. das
erste Programm dieser Art, PureBin2Data by me

roherter · Beitrag von **roherter** » 18.04.2006 23:29

Habs mal durch die beta von PB4 laufen lassen und die sachen geändert die der debugger mir angezeigt hat obs funktioniert musste mal testen,FileExists habe ich ausgeklammert!

Code: Alles auswählen

Procedure Extract_Test_txt(Zielpfad.s, Modus.l) ;Modus.l -> 0=Datei Extrahieren ; 1=Speicheradresse als Rückgabewert ; 2=Dateilänge als Rückgabewert ; 3=Kompressionsstatus als Rückgabewert (1=komprimiert, 0=unkompriniert)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  StartBuffer.l   = ?File1
  BufferLength.l  = ?Ende1-?File1
  Restore start1
  Read OriginalLength.l
  Read KompressStatus.b
  If Modus.l = 1   ;Speicheradresse als Rückgabewert
    If KompressStatus.b = 0
      ProcedureReturn StartBuffer.l
    Else
      *FileBuffer = AllocateMemory(OriginalLength)
      If *FileBuffer
        Unpacklength.l = UnpackMemory(StartBuffer, *FileBuffer)
        If Unpacklength.l = OriginalLength
          ProcedureReturn *FileBuffer
        EndIf
      EndIf
    EndIf
  ElseIf Modus.l = 2   ;Dateilänge als Rückgabewert
    ProcedureReturn OriginalLength.l
  ElseIf Modus.l = 3 ;Kompressionsstatus als Rückgabewert (1=komprimiert, 0=unkompriniert)
    ProcedureReturn KompressStatus.b
  ElseIf Modus = 0 ;Extrahiere die Datei
   ; If FileExists(Zielpfad.s+"Test.txt") = 1
     ; ProcedureReturn 2
    ;EndIf
    If KompressStatus = 0
      If CreateFile(0, Zielpfad.s+"Test.txt")
        WriteData(0,StartBuffer.l, OriginalLength)
        CloseFile(0)
      EndIf
    ElseIf KompressStatus = 1 ;Entpacke erst die daten
      *ZielBuffer = AllocateMemory(OriginalLength)
      If *ZielBuffer
        Unpacklength.l = UnpackMemory(StartBuffer, *ZielBuffer)
        If Unpacklength.l = OriginalLength
          If CreateFile(0, Zielpfad.s+"Test.txt")
            WriteData(0,*ZielBuffer, Unpacklength.l)
            CloseFile(0)
            FreeMemory(*ZielBuffer)
          EndIf
        EndIf
      EndIf
    EndIf
  EndIf

  DataSection
  start1:
  Data.l 178   ;Originallänge der Datei in Byte
  Data.b 1   ;Datei ist komprimiert
  File1:   ; Packrate: 91.01%  OriginalSize: 178  PackSize: 162
  Data.l 11682634, 467468288, -323600931, 189604053, 1422778962, -1677417756, -331952987, -1609290650, -1776850015, 1633333526, -1246711293, -570061356, 653038990, 1845659372, 374652961, -1526183024, -748483072, -2131694130, -153053483, -613480659, -468081222, 540558595, -2051265226, -919531766, -1951861296, -1001779449, 692456656, 180409197, 1077162866, -1217284078, -772994174, 185794565, 22035822, -761223047, 1730754880, -1833208097, 553542070, -1591463159, 1242958529, 46171, 38656
  Ende1:
  EndDataSection
  ProcedureReturn 1
EndProcedure


Procedure Extract_All(Zielpfad.s)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  Extract_Test_txt(Zielpfad.s, 0)
 ProcedureReturn 1
EndProcedure

Procedure Delete_All(Zielpfad.s)
  If Right(Zielpfad.s, 1) <> "\"
    Zielpfad.s+"\"
  EndIf
  If FileSize(Zielpfad.s+"Test.txt") > 0
    DeleteFile(Zielpfad.s+"Test.txt")
  EndIf
  ProcedureReturn 1
EndProcedure




Enumeration
  #Window_F2PBS_Entpacken
EndEnumeration
Enumeration
  #Frame3D_F2PBS_Entpacken
  #Text_F2PBS_TXT
  #String_F2PBS_Pfad
  #Button_F2PBS_Ordner_Suchen
  #Button_F2PBS_Exit
  #Button_F2PBS_Extrahieren
EndEnumeration
Procedure Open_Window_F2PBS_Entpacken()
  If OpenWindow(#Window_F2PBS_Entpacken, 321, 421, 345, 101, "Entpacken",  #PB_Window_SystemMenu | #PB_Window_TitleBar )
    If CreateGadgetList(WindowID(#Window_F2PBS_Entpacken))
      Frame3DGadget(#Frame3D_F2PBS_Entpacken, 5, 5, 335, 60, "Entpacken")
      TextGadget(#Text_F2PBS_TXT, 15, 20, 55, 15, "Pfad:")
      StringGadget(#String_F2PBS_Pfad, 15, 35, 295, 18, "")
      ButtonGadget(#Button_F2PBS_Ordner_Suchen, 315, 35, 18, 18, ">>")
      ButtonGadget(#Button_F2PBS_Exit, 270, 70, 70, 25, "Exit")
      ButtonGadget(#Button_F2PBS_Extrahieren, 5, 70, 70, 25, "Extrahieren")
    EndIf
   
    Exit = 0
    If WindowID(#Window_F2PBS_Entpacken)
      Repeat
       
        Select WaitWindowEvent()
          Case #PB_Event_Gadget
            Select EventGadget()
              Case #Button_F2PBS_Ordner_Suchen : Path.s = PathRequester("Pfad", "") : If Path.s <> "" : SetGadgetText(#String_F2PBS_Pfad, Path.s) : EndIf
              Case #Button_F2PBS_Exit : Exit = 1
              Case #Button_F2PBS_Extrahieren : If Len(Path.s)>=2 : Extract_All(Path.s) : MessageRequester("Info", "Vorgang abgeschlossen!") : Exit = 1 : EndIf
            EndSelect
          Case #PB_Event_CloseWindow
            Exit = 1
        EndSelect
      Until Exit = 1
     
    EndIf
  EndIf
EndProcedure

Frogger · Beitrag von **Frogger** » 19.04.2006 01:33

ts-soft hat geschrieben:Kann man auch den Menüpunkt: IncludeBinary in jaPBe verwenden, bzw. das
erste Programm dieser Art, PureBin2Data by me

Soso, magst also keine Konkurrenz

Und wie findest du dieses makellose, bis ins kleinste Detail ausgeklügelte Programm sonst so?

@roherter
Danke für die Mühe.
Das Problem ist, dass ich es ohne PB4.0 nicht testen kann.

Du kannst es aber entpacken und wenn ein normaler Text und keine Hieroglyphen in der Textdatei sind, dann läuft es richtig.
Die anderen 3 Parameter für den Modus.l müssten dann auch getestet werden.

Ps: Gibt es in PB4.0 kein Ersatz für FileExists()?

ts-soft · Beitrag von **ts-soft** » 19.04.2006 01:45

>> Ps: Gibt es in PB4.0 kein Ersatz für FileExists()?
Unter Windows empfehle ich dies:

Code: Alles auswählen

Procedure FileExists(szFileName.s)
  Protected Result.l, Find.WIN32_FIND_DATA
  Result = FindFirstFile_(@szFileName,Find)
  FindClose_(Result)
  If Result <> #INVALID_HANDLE_VALUE
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Ansonsten kann man sich auch mit FileSize behelfen, was aber langsamer ist.

sen-me · Beitrag von **sen-me** » 19.04.2006 12:16

Bei PB 3.94

Code: Alles auswählen

If FileExists(Zielpfad.s+"Test.txt") = 1

mit

Code: Alles auswählen

If FileSize(Zielpfad.s+"Test.txt") > -1

ersetzen und es klappt!

Frogger · Beitrag von **Frogger** » 11.06.2006 14:27

Dank eurer Hilfe ist die Version 1.2 online.

Merkmale:
- Komprimierung der Dateien vor dem Umwandeln
- Einfügen von ganzen Ordnern samt Unterordner
- Drag&Drop bei Dateien und Ordnern
- speichern und laden der Dateilisten
- Auswahl zwischen PB 3.9x und PB 4.00 Code
- Die Fensterposition und alle Einstellungen bleiben nach dem Beenden des Programms erhalten
- der erstellte Code enthält ausschließlich PB-Funktionen (keine Funktionen aus anderen UserLibs)
- optimierte Geschwindigkeit beim Umwandeln

Das Programm wurde nach PB 4.00 umgeschrieben.
Screenshot des Programms ist auf Seite 1.

File2PBSource v1.2: http://purefrogger.pu.ohost.de/Programm ... _v1.21.php

Bitte um Feedback

[EDIT] Drag&Drop
Einfach eine Datei oder ein Ordner ins Fenster verschieben.
Bei Verknüpfungen (*.ink) wird nicht die eigentliche Zieldatei übernommen, sondern die *.ink Datei.

Frogger · Beitrag von **Frogger** » 16.06.2006 16:52

Sorry wegen dem Doppelpost aber mich würde es interessieren ob überhaupt jemand das Tool benutzt
und wenn ja, was daran verbessert/hinzugefügt werden soll?