Tool - DataSection+Data einer Datei per Drop auf den Editor

Du brauchst Grafiken, gute Programme oder Leute die dir helfen? Frag hier.
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von Bisonte »

@Stargate : Seit PB 5.20 lief das nicht mehr...

Ich habe da eine Lösung ;) Mit Danilos Hilfe hatte ich damals herausgefunden, wie man sich die ID's beschafft.

Hier meine Variante, die bei mir wunderbar auch mit der 5.40 Final läuft...

Wobei ich gerne die Variante mit der Ver-, und Entpackungsgeschichte (BriefLZ) auch sehen würde ;)

Code: Alles auswählen

;{==================================================================================
;: Name          : BinToData
;: Author        : Original by Stargate (modified by George Bisonte)
;: Date          : July 02, 2014
;: Compiler      : PureBasic 5.22 LTS (Windows - x86) - (c) 2014 Fantaisie Software
;: Subsystem     : none
;: TargetOS      : Windows
;: License       : ???
;: ---------------------------------------------------------------------------------
;: http://
;}==================================================================================
;{==================================================================================
;: Configure as
;: 
;: Commandline: "%FILE"
;: 
;: [x] Wait until tool quits
;: 
;}==================================================================================


Structure FindWindowParams
  hWnd.i
  Name.s
  child.i
EndStructure
Structure xIDE_PREFERENCES
  Map Key.s()
EndStructure

Global NewMap PB_Environment.s()
Global NewMap PBPrefs.xIDE_PREFERENCES()

Procedure   GetPBEnvironment()
  
  Protected Result = #False
  
  ClearMap(PB_Environment())
  
  If ExamineEnvironmentVariables()
    While NextEnvironmentVariable()
      If Left(UCase(EnvironmentVariableName()),Len("PB_TOOL_")) = "PB_TOOL_"
        PB_Environment(UCase(EnvironmentVariableName())) = EnvironmentVariableValue()
      EndIf
    Wend
    Result = #True
  EndIf
  
  ProcedureReturn Result
  
  ; ; Example
  ;   Define NewMap PBE.s()
  ;   If GetPBEnvironment(PBE.s())
  ;     Debug PB_Environment("PB_TOOL_Compiler")
  ;   EndIf
  
EndProcedure  
Procedure   ReadPBPreferences(PrefsFile.s = "")
  
  Protected Result = #False
  Protected *itemid.ITEMIDLIST
  Protected location.s = Space(#MAX_PATH)
  
  ClearMap(PBPrefs())
  
  If FileSize(PrefsFile) < 1
    
    If GetPBEnvironment()
      PrefsFile = PB_Environment("PB_TOOL_PREFERENCES")
    EndIf
    
    If PrefsFile = ""
      If SHGetSpecialFolderLocation_ (0, #CSIDL_APPDATA, @*itemid) = #NOERROR
        If SHGetPathFromIDList_(*itemid, @location)
          CoTaskMemFree_(*itemid)
          If Right(location, 1) <> "\" : location + "\" 
          EndIf
          PrefsFile = location
        EndIf
      EndIf      
    EndIf
  EndIf
  
  If FileSize(PrefsFile) > 0
    If OpenPreferences(PrefsFile)
      If ExaminePreferenceGroups()
        While NextPreferenceGroup()
          If ExaminePreferenceKeys()
            While NextPreferenceKey()
              PBPrefs(PreferenceGroupName())\Key(PreferenceKeyName()) = PreferenceKeyValue()
            Wend
          EndIf
        Wend
      EndIf
      ClosePreferences()
      Result = #True
    EndIf
  EndIf
  
  ProcedureReturn Result
  
EndProcedure
Procedure.s GetPBPrefsValue(Group.s, Key.s)
  
  Protected Value.s = ""
  
  If FindMapElement(PBPrefs(), Group)
    Value = PBPrefs(Group)\Key(Key)
  EndIf
  
  ProcedureReturn Value
  
EndProcedure
Procedure.s GetPBIndentString()
  
  If Not FindMapElement(PBPrefs(), "Global")
    ReadPBPreferences()
  EndIf
  If Val(GetPBPrefsValue("Global", "RealTab")) = 1
    ProcedureReturn #TAB$
  Else
    ProcedureReturn Space(Val(GetPBPrefsValue("Global", "TabLength")))
  EndIf
  
EndProcedure

Procedure   IDE_Enum(WindowHandle, *Param.FindWindowParams)
  Protected Class.s = Space(200)
  
  If *Param\child = #True
    EnumChildWindows_(WindowHandle, @IDE_Enum(), *Param)
  EndIf
  
  GetClassName_(WindowHandle, @Class, 200)
  
  If FindString(Class, *Param\Name, 1)
    If IsWindowVisible_(WindowHandle)
      *Param\hWnd = WindowHandle
      ProcedureReturn 0  ; stoppt die suche
    Else
      ProcedureReturn 1 ; lässt sie weiterlaufen
    EndIf 
  Else
    ProcedureReturn 1 ; lässt sie weiterlaufen
  EndIf
  
EndProcedure  
Procedure   IDE_MAINWINDOW()
  
  Protected Param.FindWindowParams
  Protected hWnd = 0, Title.s = Space(1000)
  
  Param\Name = "WindowClass_2"
  Param\hWnd = 0
  
  EnumWindows_(@IDE_Enum(),Param)
  hWnd = Param\hWnd
  
  GetWindowText_(hwnd, @Title, 1000)
  If Left(Title, 10) = "PureBasic "     
    ProcedureReturn hWnd       
  Else
    ProcedureReturn 0
  EndIf
  
EndProcedure
Procedure   IDE_SCINTILLA()
  
  Protected Param.FindWindowParams
  Protected WindowID = IDE_MAINWINDOW()
  
  If WindowID
    Param\Name  = "Scintilla"
    Param\hWnd  = 0
    Param\child = #True
    EnumChildWindows_(WindowID, @IDE_Enum(), Param)
    ProcedureReturn Param\hWnd
  EndIf
  ProcedureReturn #False
  
EndProcedure
Procedure   SendToIDE(Message.s)
  
  Protected ProcessID, PID, Length, Format, *Buffer, *MemoryID, hWnd
  Protected WindowID , ScintillaID, Title.s = Space(1000)
  Protected Param.FindWindowParams
  
  WindowID    = IDE_MAINWINDOW()
  ScintillaID = IDE_SCINTILLA()
  
  If ScintillaID
    If GetWindowThreadProcessId_(WindowID, @PID)
      
      ProcessID = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID)
      
      If ProcessID
        Select SendMessage_(ScintillaID, #SCI_GETCODEPAGE, #Null, #Null)
          Case 0     : Format = #PB_Ascii
          Case 65001 : Format = #PB_UTF8
        EndSelect
        
        Length  = StringByteLength(Message, Format)
        *Buffer = AllocateMemory(Length + SizeOf(Character))
        If *Buffer
          PokeS(*Buffer, Message, -1, Format)
          *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
          If *MemoryID
            WriteProcessMemory_(ProcessID, *MemoryID, *Buffer, Length, #Null)
            SendMessage_(ScintillaID, #SCI_REPLACESEL, 0, *MemoryID)
            VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
          EndIf
          
          FreeMemory(*Buffer)
        EndIf         
        CloseHandle_(ProcessID)
      EndIf
    EndIf 
  EndIf
  
EndProcedure  

EnableExplicit

Enumeration
  #File
  #RegularExpression
EndEnumeration
 
Structure QuadArray
  q.q[0]
EndStructure
 
Define.s IS, FileName, Label, Output
Define   *Buffer.QuadArray, Length, LastIndex, Index

If Not GetPBEnvironment()
  MessageRequester("Error", "Start this program from the PB-IDE !")
  End
EndIf

IS        = GetPBIndentString()
FileName  = ProgramParameter(0)
Label     = GetFilePart(FileName, #PB_FileSystem_NoExtension)


CreateRegularExpression(#RegularExpression, "\W")
Label = ReplaceRegularExpression(#RegularExpression, Label, "_")
FreeRegularExpression(#RegularExpression)
CreateRegularExpression(#RegularExpression, "^\d")
If MatchRegularExpression(#RegularExpression, Label)
   Label = "_" + Label
EndIf
FreeRegularExpression(#RegularExpression)

If ReadFile(#File, FileName)
   Length = Lof(#File)
   If Length % SizeOf(Quad)
      Length + (SizeOf(Quad) - Length % SizeOf(Quad))
   EndIf
   LastIndex = Length / SizeOf(Quad) - 1
   *Buffer = AllocateMemory(Length)
   If *Buffer
      ReadData(#File, *Buffer, Length)
      Output + "DataSection" + #CRLF$
      Output + IS + Label + "_" + GetExtensionPart(FileName) + "_start: ;{ Datas : Size = " + Str(Length) + " Bytes"
      For Index = 0 To LastIndex
         If Index % 5 = 0
            Output + #CRLF$ + IS + "Data.q $" + RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
         Else
            Output + ",$" + RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
         EndIf
      Next
      Output + #CRLF$ + IS + Label + "_" + GetExtensionPart(FileName) + "_eof: ;}"
      Output + #CRLF$ + "EndDataSection" + #CRLF$
      SendToIDE(OutPut)
      FreeMemory(*Buffer)
   EndIf
   CloseFile(#File)
EndIf
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
TheCube
Beiträge: 150
Registriert: 20.07.2010 23:59
Computerausstattung: Risen 3400G 16MB Win10-64Bit
Wohnort: NRW

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von TheCube »

Super, danke.
Man staunt .. nur um sich diese ID ab PB5.20 wieder zu beschaffen braucht man so viel Sourcecode extra ... :freak:

Na, dann werde ich mal BriefLZ reinbringen und wenn man es vorzeigen kann hier posten.
(Wird vielleicht nicht auf eurem coding-Niveau sein, oder zwischenzeitlich hats schon ein anderer gepostet. ;--)
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von GPI »

Moment, ihr wollt die Id des aktuellen Scintilla-Fensters?

das geht als Tool extrem einfach:

Code: Alles auswählen

handle=Val(GetEnvironmentVariable("PB_TOOL_Scintilla" ))
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 6996
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von STARGÅTE »

@GPI: Nöö
Als Tool habe ich nur
PB_TOOL_Compiler = C:\Program Files\PureBasic540\Compilers\pbcompiler.exe
PB_TOOL_FileList = ...
PB_TOOL_IDE = C:\Program Files\PureBasic540\PureBasic.exe
PB_TOOL_Language = Deutsch
PB_TOOL_MainWindow = 1116552
PB_TOOL_Preferences = C:\Users\Martin Guttmann\AppData\Roaming\PureBasic\PureBasic.prefs
PB_TOOL_Project = Q:\PureBasic\Projekte\PureCircuit\PureCircuit.pbp
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von GPI »

Da bist du aber nicht auf den aktuellen Stand:
http://www.purebasic.com/german/documen ... tools.html
Die IDE bietet zusätzliche Informationen für die Werkzeuge in der Form von Umgebungsvariablen. Diese können innerhalb des Werkzeugs einfach mit den Befehlen der Process Library gelesen werden.

Dies ist eine Liste der angebotenen Variablen. Bitte beachten Sie, dass die Variablen, welche Informationen über den aktiven Quellcode bieten, nicht für Werkzeuge zum Start oder Ende der IDE verfügbar sind.

PB_TOOL_IDE - Voller Pfad und Dateiname der IDE
PB_TOOL_Compiler - Voller Pfad und Dateiname des Compilers
PB_TOOL_Preferences - Voller Pfad und Dateiname der IDE-Einstellungsdatei (.prefs)
PB_TOOL_Project - Voller Pfad und Dateiname des aktuell offenen Projekts (falls es eines gibt)
PB_TOOL_Language - Sprache, welche gegenwärtig in der IDE verwendet wird
PB_TOOL_FileList - Eine Liste aller in der IDE geöffneten Dateien, getrennt durch Chr(10)

PB_TOOL_Debugger - Diese Variablen bieten Einstellungen aus dem Fenster Compiler Optionen
PB_TOOL_InlineASM des aktuellen Quellcodes. Sie sind auf "1" gesetzt, wenn die Option
PB_TOOL_Unicode eingeschaltet ist, andernfalls auf "0".
PB_TOOL_Thread
PB_TOOL_XPSkin
PB_TOOL_OnError

PB_TOOL_SubSystem - Inhalt des "Subsystem" Felds in den Compiler-Optionen
PB_TOOL_Executable - das gleiche wie das %COMPILEFILE Token für die Kommandozeile
PB_TOOL_Cursor - das gleiche wie das %CURSOR Token für die Kommandozeile
PB_TOOL_Selection - das gleiche wie das %SELECTION Token für die Kommandozeile
PB_TOOL_Word - das gleiche wie das %WORD Token für die Kommandozeile

PB_TOOL_MainWindow - OS Handle des IDE-Hauptfensters
PB_TOOL_Scintilla - OS Handle der Scintilla Editor-Komponente des aktuellen Quellcodes
Es gibt ein paar mehr :)


Die werden bei mir auch ausgegeben. Als Tool folgendes kleine Programm:

Code: Alles auswählen

OpenConsole()
  If ExamineEnvironmentVariables()
    While NextEnvironmentVariable()
      PrintN(EnvironmentVariableName() + " = " + EnvironmentVariableValue())
    Wend
  EndIf
  PrintN("")
  PrintN("Press Enter to quit.")
  Input()
liefert hier das:
PB_TOOL_IDE = C:\Program Files\PureBasic\PureBasic.exe
PB_TOOL_InlineASM = 0
PB_TOOL_Language = English
PB_TOOL_MainWindow = 720984
PB_TOOL_OnError = 0
PB_TOOL_Preferences = <zensiert>
PB_TOOL_Project = <zensiert>
PB_TOOL_Scintilla = 2754496
PB_TOOL_Selection = 10x1x10x1
PB_TOOL_SubSystem =
PB_TOOL_Thread = 0
PB_TOOL_Unicode = 1
PB_TOOL_Word =
PB_TOOL_XPSkin = 1
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von Bisonte »

GPI hat geschrieben:Moment, ihr wollt die Id des aktuellen Scintilla-Fensters?

das geht als Tool extrem einfach:

Code: Alles auswählen

handle=Val(GetEnvironmentVariable("PB_TOOL_Scintilla" ))
Das klappt leider nicht. Hatte ich am Anfang probiert. WindowID und ScintillaID über die EnvVars zu holen.
Ist kein Text im EditorFenster erschienen.... Klingt komisch, aber so ist es...
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von GPI »

Gerade mal ein bischen getestet. Wenn man ein Tool mittels Menüpunkt aufruft bekommt man mehr Einträge als wenn man "nur" mittels Fileviewer aufruft - warum auch immer. Wäre imo besser, wenn immer alle Daten drin wären.

Eventuell eine leichtere Methode. Das Hauptfenster bekommt ja zurückgeschickt. Simpler wäre es den gewünschten Text ins Clipboard zu schicken und dann ein strg+v an das Fenster zu schicken.

Code: Alles auswählen

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=7115&highlight=
; Author: ebs
; Date: 03. August 2003
; OS: Windows
; Demo: No


; Here is a Procedure similar to Visual Basic's SendKeys().
; It will send a specified string to the foreground application as if the keys
; had been pressed on the keyboard. It should work For all ASCII characters,
; including those that don't have a #VK_xxx constant value, like punctuation characters.

; To test the code, open any text editor. Start the program and quickly switch back
; to the text editor. You should see the 10 lines of text.


; send the specified key 
Procedure SendKey(vk.w) 
  ; get virtual key code and shift state 
  ;VK.w = VkKeyScan_(Asc(Key)) 
  If VK = -1 
    ProcedureReturn 
  EndIf 
  
  ; get scan code if an extended key 
  If MapVirtualKey_(VK, 2) = 0 
    Extended.l = #KEYEVENTF_EXTENDEDKEY 
    ; get scan code 
    Scan.l = MapVirtualKey_(VK, 0) 
  Else 
    Extended = 0 
    Scan = 0 
  EndIf 
  
  ; press shift/ctrl/alt if needed 
  Shift.l = VK & $100 
  Ctrl.l = VK & $200 
  Alt.l = VK & $400 
  If Shift 
    keybd_event_(#VK_SHIFT, 0, 0, 0) 
  EndIf 
  If Ctrl 
    keybd_event_(#VK_CONTROL, 0, 0, 0) 
  EndIf 
  If Alt 
    keybd_event_(#VK_MENU, 0, 0, 0) 
  EndIf 
  
  ; press and release key 
  VK & $ff 
  keybd_event_(VK, Scan, Extended, 0) 
  keybd_event_(VK, Scan, #KEYEVENTF_KEYUP | Extended, 0) 
  
  ; release shift/ctrl/alt if pressed 
  If Shift 
    keybd_event_(#VK_SHIFT, 0, #KEYEVENTF_KEYUP, 0) 
  EndIf 
  If Ctrl 
    keybd_event_(#VK_CONTROL, 0, #KEYEVENTF_KEYUP, 0) 
  EndIf 
  If Alt 
    keybd_event_(#VK_MENU, 0, #KEYEVENTF_KEYUP, 0) 
  EndIf 
EndProcedure 
;PB_TOOL_MainWindow = 720984
;handle=720984
handle=Val(GetEnvironmentVariable("PB_TOOL_MainWindow"))

OpenIcon_(handle) 
SetForegroundWindow_(handle) 
SetActiveWindow_(handle) 
SendKey(VkKeyScan_('v')|$200); steuerung v schicken
Das sollte auch in zukünftigen Versionen funktionieren.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von Bisonte »

Das hat aber den Nachteil, das das Clipboard gelöscht wird... dann könnte man gleich ein temporäres File erstellen das in die IDE geladen wird...
so rein theoretisch...

Naja viel Code hin oder her... ich habe das ganze aus meinem IDE "Werkzeugkasten" gerissen, wollt ja nicht gleich alles davon posten.... ;)

Deshalb mag es evt. etwas umständlich erscheinen ;)
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
TheCube
Beiträge: 150
Registriert: 20.07.2010 23:59
Computerausstattung: Risen 3400G 16MB Win10-64Bit
Wohnort: NRW

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von TheCube »

So, ich habe Bin2Data um eine Option für BriefLZ erweitert ....
Das meiste Neue ist im Gosub Programmteil, nötige sonstige Anpassungen im org. Code sind ### markiert.

Nach dem Drop eines Files wird man gefragt und kann die Datas unkomprimiert (wie bisher)
oder gepackt erhalten möchte. Wenn gepackt wird noch ein "How to use" Beispiel als Gedächtnisstütze
hinten angehängt. (Könnt ihr ja entfernen) Wenn packen nicht möglich ist wird einfach beendet.

Checkt auch bitte mal den Programmkopf: Configure as: Commandline: %File schien mir falsch, habs einfach
mal so geändert, wie ich es benutze.

Code: Alles auswählen

;{==================================================================================
;: Name          : BinToData
;: Author        : Original by Stargate
;:               : (modified for PB5.20+ by George Bisonte / for optional BriefLZ by unknown)
;: Date          : July 02, 2014  /  Nov. 08, 2015
;: Compiler      : PureBasic 5.22 LTS (Windows - x86) - (c) 2014 Fantaisie Software
;: Subsystem     : none
;: TargetOS      : Windows
;: License       : ???
;: ---------------------------------------------------------------------------------
;: http://
;}==================================================================================
;{==================================================================================
;: Configure as:
;:
;: Commandline: Path to your Bin2Data.exe
;: Arguments  : None
;: Work Dir   : None
;: Event trigger : Replace Fileviewer - All Files
;: [x] Wait until tool quits
;:
;}==================================================================================


Structure FindWindowParams
  hWnd.i
  Name.s
  child.i
EndStructure
Structure xIDE_PREFERENCES
  Map Key.s()
EndStructure

Global NewMap PB_Environment.s()
Global NewMap PBPrefs.xIDE_PREFERENCES()

Procedure   GetPBEnvironment()
 
  Protected Result = #False
 
  ClearMap(PB_Environment())
 
  If ExamineEnvironmentVariables()
    While NextEnvironmentVariable()
      If Left(UCase(EnvironmentVariableName()),Len("PB_TOOL_")) = "PB_TOOL_"
        PB_Environment(UCase(EnvironmentVariableName())) = EnvironmentVariableValue()
      EndIf
    Wend
    Result = #True
  EndIf
 
  ProcedureReturn Result
 
  ; ; Example
  ;   Define NewMap PBE.s()
  ;   If GetPBEnvironment(PBE.s())
  ;     Debug PB_Environment("PB_TOOL_Compiler")
  ;   EndIf
 
EndProcedure 
Procedure   ReadPBPreferences(PrefsFile.s = "")
 
  Protected Result = #False
  Protected *itemid.ITEMIDLIST
  Protected location.s = Space(#MAX_PATH)
 
  ClearMap(PBPrefs())
 
  If FileSize(PrefsFile) < 1
   
    If GetPBEnvironment()
      PrefsFile = PB_Environment("PB_TOOL_PREFERENCES")
    EndIf
   
    If PrefsFile = ""
      If SHGetSpecialFolderLocation_ (0, #CSIDL_APPDATA, @*itemid) = #NOERROR
        If SHGetPathFromIDList_(*itemid, @location)
          CoTaskMemFree_(*itemid)
          If Right(location, 1) <> "\" : location + "\"
          EndIf
          PrefsFile = location
        EndIf
      EndIf     
    EndIf
  EndIf
 
  If FileSize(PrefsFile) > 0
    If OpenPreferences(PrefsFile)
      If ExaminePreferenceGroups()
        While NextPreferenceGroup()
          If ExaminePreferenceKeys()
            While NextPreferenceKey()
              PBPrefs(PreferenceGroupName())\Key(PreferenceKeyName()) = PreferenceKeyValue()
            Wend
          EndIf
        Wend
      EndIf
      ClosePreferences()
      Result = #True
    EndIf
  EndIf
 
  ProcedureReturn Result
 
EndProcedure
Procedure.s GetPBPrefsValue(Group.s, Key.s)
 
  Protected Value.s = ""
 
  If FindMapElement(PBPrefs(), Group)
    Value = PBPrefs(Group)\Key(Key)
  EndIf
 
  ProcedureReturn Value
 
EndProcedure
Procedure.s GetPBIndentString()
 
  If Not FindMapElement(PBPrefs(), "Global")
    ReadPBPreferences()
  EndIf
  If Val(GetPBPrefsValue("Global", "RealTab")) = 1
    ProcedureReturn #TAB$
  Else
    ProcedureReturn Space(Val(GetPBPrefsValue("Global", "TabLength")))
  EndIf
 
EndProcedure

Procedure   IDE_Enum(WindowHandle, *Param.FindWindowParams)
  Protected Class.s = Space(200)
 
  If *Param\child = #True
    EnumChildWindows_(WindowHandle, @IDE_Enum(), *Param)
  EndIf
 
  GetClassName_(WindowHandle, @Class, 200)
 
  If FindString(Class, *Param\Name, 1)
    If IsWindowVisible_(WindowHandle)
      *Param\hWnd = WindowHandle
      ProcedureReturn 0  ; stoppt die suche
    Else
      ProcedureReturn 1 ; lässt sie weiterlaufen
    EndIf
  Else
    ProcedureReturn 1 ; lässt sie weiterlaufen
  EndIf
 
EndProcedure

Procedure   IDE_MAINWINDOW()
 
  Protected Param.FindWindowParams
  Protected hWnd = 0, Title.s = Space(1000)
 
  Param\Name = "WindowClass_2"
  Param\hWnd = 0
 
  EnumWindows_(@IDE_Enum(),Param)
  hWnd = Param\hWnd
 
  GetWindowText_(hwnd, @Title, 1000)
  If Left(Title, 10) = "PureBasic "     
    ProcedureReturn hWnd       
  Else
    ProcedureReturn 0
  EndIf
 
EndProcedure

Procedure   IDE_SCINTILLA()
 
  Protected Param.FindWindowParams
  Protected WindowID = IDE_MAINWINDOW()
 
  If WindowID
    Param\Name  = "Scintilla"
    Param\hWnd  = 0
    Param\child = #True
    EnumChildWindows_(WindowID, @IDE_Enum(), Param)
    ProcedureReturn Param\hWnd
  EndIf
  ProcedureReturn #False
 
EndProcedure

Procedure   SendToIDE(Message.s)
 
  Protected ProcessID, PID, Length, Format, *Buffer, *MemoryID, hWnd
  Protected WindowID , ScintillaID, Title.s = Space(1000)
  Protected Param.FindWindowParams
 
  WindowID    = IDE_MAINWINDOW()
  ScintillaID = IDE_SCINTILLA()
 
  If ScintillaID
    If GetWindowThreadProcessId_(WindowID, @PID)
     
      ProcessID = OpenProcess_(#PROCESS_ALL_ACCESS, #False, PID)
     
      If ProcessID
        Select SendMessage_(ScintillaID, #SCI_GETCODEPAGE, #Null, #Null)
          Case 0     : Format = #PB_Ascii
          Case 65001 : Format = #PB_UTF8
        EndSelect
       
        Length  = StringByteLength(Message, Format)
        *Buffer = AllocateMemory(Length + SizeOf(Character))
        If *Buffer
          PokeS(*Buffer, Message, -1, Format)
          *MemoryID = VirtualAllocEx_(ProcessID, #Null, Length, #MEM_RESERVE|#MEM_COMMIT, #PAGE_EXECUTE_READWRITE)
          If *MemoryID
            WriteProcessMemory_(ProcessID, *MemoryID, *Buffer, Length, #Null)
            SendMessage_(ScintillaID, #SCI_REPLACESEL, 0, *MemoryID)
            VirtualFreeEx_(ProcessID, *MemoryID, Length, #MEM_RELEASE)
          EndIf
         
          FreeMemory(*Buffer)
        EndIf         
        CloseHandle_(ProcessID)
      EndIf
    EndIf
  EndIf
 
EndProcedure 

; ==========================================================================================================================
EnableExplicit

Enumeration
  #File
  #RegularExpression
EndEnumeration
 
Structure QuadArray
  q.q[0]
EndStructure
 
Define.s IS, FileName, Label, Output
Define   *Buffer.QuadArray, Length, LastIndex, Index
Define   *pPackmem.QuadArray, LengthP.i, info$, info2$, Result                  ; ### added

If Not GetPBEnvironment()
  MessageRequester("Error", "Start this program from the PB-IDE !")
  End
EndIf

UseBriefLZPacker()                                                              ; ### added

IS        = GetPBIndentString()
FileName  = ProgramParameter(0)
Label     = GetFilePart(FileName, #PB_FileSystem_NoExtension)


CreateRegularExpression(#RegularExpression, "\W")
Label = ReplaceRegularExpression(#RegularExpression, Label, "_")
FreeRegularExpression(#RegularExpression)
CreateRegularExpression(#RegularExpression, "^\d")
If MatchRegularExpression(#RegularExpression, Label)
   Label = "_" + Label
EndIf
FreeRegularExpression(#RegularExpression)

If ReadFile(#File, FileName)
  Length = Lof(#File)
  *Buffer   = AllocateMemory(Length) : If *Buffer : ReadData(#File, *Buffer, Length) : EndIf    ; ### replaced/added
  *pPackmem = AllocateMemory(Length)                                                            ; ### added
  Gosub Packit                                                                                  ; ### Gosub added / Quad-Calc replaced
  LastIndex = Length / SizeOf(Quad) - 1
  ; *Buffer = AllocateMemory(Length)                                                            ; ### now see 3 lines up
  If *Buffer
    ; ReadData(#File, *Buffer, Length)                                                          ; ### now see 6 lines up
    Output + "DataSection" + #CRLF$
    Output + IS + Label + "_" + GetExtensionPart(FileName) + "_start: ;{ " + info$              ; ### changed
    For Index = 0 To LastIndex
      If Index % 5 = 0
        Output + #CRLF$ + IS + "Data.q $" + RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
      Else
        Output + ",$" + RSet(Hex(*Buffer\q[Index], #PB_Quad), 16, "0")
      EndIf
    Next
    Output + #CRLF$ + IS + Label + "_" + GetExtensionPart(FileName) + "_end: ;}"
    Output + #CRLF$ + "EndDataSection" + #CRLF$ + info2$ 
    SendToIDE(OutPut)
    FreeMemory(*Buffer)
  EndIf
  CloseFile(#File)
EndIf
End
 
 ; -----------------------------------------------------------------------------------------
Packit:
Result = MessageRequester(" Bin2Data   08.11.2015", " Generate BriefLZ-compressed datas ?", #MB_ICONQUESTION|#PB_MessageRequester_YesNoCancel)

If Result = #PB_MessageRequester_Yes       ; Ja-Schalter wurde gedrückt
  LengthP = CompressMemory(*Buffer, Length, *pPackmem, Length, #PB_PackerPlugin_BriefLZ)
  If LengthP = 0
    MessageRequester("Error", " Sorry, can't compress that file.", #MB_ICONSTOP)
    FreeMemory(*Buffer) : *Buffer=0 : FreeMemory(*pPackmem) : Return
  Else 
    CopyMemory(*pPackmem, *Buffer, LengthP) : FreeMemory(*pPackmem)
    If LengthP % SizeOf(Quad) : LengthP + (SizeOf(Quad) - LengthP % SizeOf(Quad)) : EndIf
    MessageRequester("Success"," Compressed " + Str(Length) + " bytes -> " + Str(LengthP) + " bytes  (" + StrF((LengthP / Length) * 100,1) + "%)", #MB_ICONINFORMATION)
    info$ = "Compressed with BriefLZ (Size of Datas: " + Str(LengthP) + " Bytes / Unpacked size: " + Str(Lof(#File)) +" bytes)"
    info2$= ";Example how to use it:" + #CRLF$                                                                                         ;  Optional
    info2$+ ";unpacksize = PeekL(?Label_start+8)   ; Get unpacked size" + #CRLF$                                                       ;  Optional
    info2$+ ";*memLabel=AllocateMemory(unpacksize) ; Get memory for unpacked data" + #CRLF$                                            ;  Optional
    info2$+ ";UncompressMemory(?Label_start, ?Label_end-?Label_start, *memLabel, unpacksize, #PB_PackerPlugin_BriefLZ)" + #CRLF$       ;  Optional
    info2$+ ";CatchImage(0, *memLabel)             ; Replaces CatchImage(0, ?Label_start) when using unpacked IncludeBinary." + #CRLF$ ;  Optional
    Length = LengthP
    Return
  EndIf  
  
ElseIf Result = #PB_MessageRequester_No    ; Nein-Schalter wurde gedrückt
  If Length % SizeOf(Quad) : Length + (SizeOf(Quad) - Length % SizeOf(Quad)) : EndIf
  info$ = "Uncompressed ( Size of Datas: " + Str(Length) + " Bytes)" : info2$ = ""
  Return
  
Else                                       ; Abbrechen-Schalter oder Esc wurde gedrückt
  FreeMemory(*Buffer) : *Buffer=0 : FreeMemory(*pPackmem) : Return
EndIf  

Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Tool - DataSection+Data einer Datei per Drop auf den Edi

Beitrag von Bisonte »

Ok. Nun ist mir aber auch wieder eingefallen, warum TS-Soft die zLib nutzt :
Egal ob man es auf Linux, Mac oder Windows packt, man kann es auf allen dreien auch wieder sinnvoll entpacken.
Das klappte mit dem BriefLZ nicht. Also auf Windows gepackt kann man auf Linux nicht entpacken (da kommt nicht das Original wieder raus.)
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Antworten