PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

File2PBSource v1.21

https://www.purebasic.fr/german/viewtopic.php?t=7569

Seite 2 von 3

Verfasst: 18.04.2006 21:39
von Frogger
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()

Verfasst: 18.04.2006 21:52
von hardfalcon
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.

Verfasst: 18.04.2006 22:17
von Frogger
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. :allright:

Verfasst: 18.04.2006 22:54
von ts-soft
Kann man auch den Menüpunkt: IncludeBinary in jaPBe verwenden, bzw. das
erste Programm dieser Art, PureBin2Data by me :wink:

Verfasst: 18.04.2006 23:29
von roherter
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

Verfasst: 19.04.2006 01:33
von Frogger
ts-soft hat geschrieben:Kann man auch den Menüpunkt: IncludeBinary in jaPBe verwenden, bzw. das
erste Programm dieser Art, PureBin2Data by me :wink:
Soso, magst also keine Konkurrenz :wink:
Und wie findest du dieses makellose, bis ins kleinste Detail ausgeklügelte Programm sonst so? :lol:


@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()?

Verfasst: 19.04.2006 01:45
von ts-soft
>> 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.

Verfasst: 19.04.2006 12:16
von sen-me
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!

Verfasst: 11.06.2006 14:27
von Frogger
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.

Verfasst: 16.06.2006 16:52
von Frogger
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?
Alle Zeiten sind UTC+02:00
Seite 2 von 3

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de