After I didn't really find something, I made it myself.
Maybe someone else will use it.
Here is a simple GUI, which can be used as an application example at the same time:
Download: ResourceModule.zip
Code: Select all
;/ ===================================
;/ = ResourceModule [PB 5.6x] =
;/ ===================================
;/
;/ All OS
;/
;/ Module by Thorsten1867 (11/2017)
;/
#PackResource = #True
CompilerIf #PackResource
DeclareModule PackResource
Declare Open(File$, Name$)
Declare Close(Name$)
Declare Add(Name$, File$)
Declare Create(Name$)
EndDeclareModule
Module PackResource
EnableExplicit
UseLZMAPacker()
#Pack = 1
#Json = 1
Structure File_Structure
File.s
Size.i
EndStructure
Structure ResPack_Structure
Open.i
File.s
Map Files.File_Structure()
EndStructure
Global NewMap ResPack.ResPack_Structure()
Procedure Open(File$, Name$)
If AddMapElement(ResPack(), Name$)
ResPack()\Open = #True
ResPack()\File = File$
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure Create(Name$)
Define Size.i, *Buffer
Define File$, PackFile$
If FindMapElement(ResPack(), Name$)
PackFile$ = ResPack()\File
If CreatePack(#Pack, PackFile$, #PB_PackerPlugin_Lzma, 9)
ForEach ResPack()\Files()
File$ = ResPack()\Files()\File
AddPackFile(#Pack, File$, GetFilePart(File$))
Next
If CreateJSON(#Json)
InsertJSONMap(JSONValue(#Json), ResPack()\Files())
Size = ExportJSONSize(#JSON)
*Buffer = AllocateMemory(Size)
If *Buffer
If ExportJSON(#JSON, *Buffer, Size)
AddPackMemory(#Pack, *Buffer, Size, "Content.json")
EndIf
FreeMemory(*Buffer)
EndIf
FreeJSON(#Json)
EndIf
ClosePack(#Pack)
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure Add(Name$, File$)
Define FileName$, Size.i
If FindMapElement(ResPack(), Name$)
Size = FileSize(File$)
If Size > 0
FileName$ = GetFilePart(File$)
ResPack()\Files(FileName$)\File = File$
ResPack()\Files(FileName$)\Size = Size
ProcedureReturn #True
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure Close(Name$)
If FindMapElement(ResPack(), Name$)
DeleteMapElement(ResPack())
EndIf
EndProcedure
EndModule
CompilerEndIf
DeclareModule Resource
Declare Open(Pack.i, File$)
Declare.i GetImage(Pack.i, Image.i, FileName$)
Declare.i GetXML(Pack.i, XML.i, FileName$)
Declare.i GetJSON(Pack.i, JSON.i, FileName$)
Declare.i GetSound(Pack.i, Sound.i, FileName$)
Declare.i GetFileSize(Pack.i, FileName$)
Declare.i GetFileMemory(Pack.i, *Buffer, FileName$)
Declare Close(Pack.i)
EndDeclareModule
Module Resource
EnableExplicit
UseLZMAPacker()
#Pack = 1
#JSON = 1
Structure File_Structure
Name.s
Size.i
EndStructure
Structure Content_Structure
PackFile.s
Map Content.File_Structure()
EndStructure
Global NewMap ResEx.Content_Structure()
Procedure Open(Pack.i, File$)
Define.i Result, Size
Define *Buffer
Result = OpenPack(Pack, File$ , #PB_PackerPlugin_Lzma)
If Result
If Pack = #PB_Any : Pack = Result : EndIf
ResEx(Str(Pack))\PackFile = File$
If ExaminePack(Pack)
While NextPackEntry(Pack)
If PackEntryName(Pack) = "Content.json"
Size = PackEntrySize(Pack)
*Buffer = AllocateMemory(Size)
If *Buffer
If UncompressPackMemory(Pack, *Buffer, Size)
If CatchJSON(#JSON, *Buffer, Size)
ExtractJSONMap(JSONValue(#JSON), ResEx()\Content())
FreeJSON(#JSON)
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
Break
EndIf
Wend
EndIf
ProcedureReturn Pack
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i GetImage(Pack.i, Image.i, FileName$)
Define.i Result.i, *Buffer
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
*Buffer = AllocateMemory(ResEx()\Content()\Size)
If *Buffer
If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
Result = CatchImage(Image, *Buffer, ResEx()\Content()\Size)
If Result
If Image = #PB_Any : Image = Result : EndIf
Else
Image = #False
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
ProcedureReturn Image
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i GetSound(Pack.i, Sound.i, FileName$)
Define.i Result.i, *Buffer
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
*Buffer = AllocateMemory(ResEx()\Content()\Size)
If *Buffer
If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
Result = CatchSound(Sound, *Buffer, ResEx()\Content()\Size)
If Result
If Sound = #PB_Any : Sound = Result : EndIf
Else
Sound = #False
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
ProcedureReturn Sound
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i GetXML(Pack.i, XML.i, FileName$)
Define.i Result.i, *Buffer
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
*Buffer = AllocateMemory(ResEx()\Content()\Size)
If *Buffer
If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
Result = CatchXML(XML, *Buffer, ResEx()\Content()\Size)
If Result
If XML = #PB_Any : XML = Result : EndIf
Else
XML = #False
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
EndIf
ProcedureReturn XML
EndIf
ProcedureReturn #False
EndProcedure
Procedure.i GetJSON(Pack.i, JSON.i, FileName$)
Define Result.i, *Buffer
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
*Buffer = AllocateMemory(ResEx()\Content()\Size)
If *Buffer
If UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
Result = CatchJSON(JSON, *Buffer, ResEx()\Content()\Size)
If Result
If JSON = #PB_Any : JSON = Result : EndIf
Else
JSON = #False
EndIf
EndIf
FreeMemory(*Buffer)
EndIf
EndIf
ProcedureReturn JSON
EndIf
EndProcedure
Procedure.i GetFileSize(Pack.i, FileName$)
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
ProcedureReturn ResEx()\Content()\Size
EndIf
EndIf
EndProcedure
Procedure.i GetFileMemory(Pack.i, *Buffer, FileName$)
Define Result.i
If FindMapElement(ResEx(), Str(Pack))
FileName$ = GetFilePart(FileName$)
If FindMapElement(ResEx()\Content(), FileName$)
Result = UncompressPackMemory(Pack, *Buffer, ResEx()\Content()\Size, FileName$)
ProcedureReturn Result
EndIf
EndIf
ProcedureReturn #False
EndProcedure
Procedure Close(Pack.i)
If FindMapElement(ResEx(), Str(Pack))
DeleteMapElement(ResEx())
ClosePack(Pack)
EndIf
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
UsePNGImageDecoder()
CompilerIf #PackResource
If PackResource::Open("Test.res", "Test")
PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\PureBasic.bmp")
PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\CdPlayer.ico")
PackResource::Add("Test", #PB_Compiler_Home + "examples\sources\Data\world.png")
PackResource::Create("Test")
PackResource::Close("Test")
EndIf
CompilerEndIf
#Win = 0
#Pack = 1
#ImageGadget = 1
#Image = 1
If Resource::Open(#Pack, "Test.res")
Resource::GetImage(#Pack, #Image, "PureBasic.bmp")
Resource::Close(#Pack)
EndIf
If OpenWindow(#Win, 100, 100, 300, 200, "Resource - Image")
If IsImage(#Image)
ImageGadget(#ImageGadget, 10, 10, 100, 100, ImageID(#Image), #PB_Image_Border)
EndIf
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow ; If the user has pressed on the close button
CloseWindow(#Win)
EndIf
CompilerEndIf