PureBasic Forum

CompilerIf Defined(uncompress, #PB_Procedure) = #False
ImportC "zlib.lib"
  uncompress(*dest, *destLen, *source, sourceLen)
EndImport
CompilerEndIf

Enumeration
  #UDRes_Packer_None
  #UDRes_Packer_jCalg1
  #UDRes_Packer_zip
EndEnumeration

CompilerIf Defined(UDResPack, #PB_Structure) = #False
Structure UDResPack
  Size.q
  CRC.q
  Packer.b
  Magic.b[6]
EndStructure
CompilerEndIf

CompilerIf Defined(_UnpackMemory, #PB_Procedure) = #False
Procedure _UnpackMemory(*SourceMemoryID, SourceLength, *DestionationMemoryID, DestLength, Packer = #UDRes_Packer_jCalg1)
  Select Packer
    Case #UDRes_Packer_jCalg1
      ProcedureReturn UnpackMemory(*SourceMemoryID, *DestionationMemoryID)
    Case #UDRes_Packer_zip
      If Not uncompress(*DestionationMemoryID, @DestLength, *SourceMemoryID, SourceLength)
        ProcedureReturn #True
      EndIf
  EndSelect
EndProcedure
CompilerEndIf

Procedure UDRes_Get(ResNumber, hModule = 0)
  Protected ResName.s, ResType.s = "PBDATA"
  Protected hFind, hLoad, hLock, hSize, Size, CRC, Packer
  Protected *Mem.UDResPack, *DestMem

  If ResNumber < 1 : ProcedureReturn #False : EndIf
 
  ResName = "#" + Str(ResNumber)

  If Not hModule : hModule = GetModuleHandle_(#Null) : EndIf

  hFind = FindResource_(hModule, ResName, @ResType)
  If hFind
    hLoad = LoadResource_(hModule, hFind)
    hSize = SizeofResource_(hModule, hFind)
    hLock = LockResource_(hLoad)

    *Mem = AllocateMemory(hSize)

    If *Mem
      CopyMemory(hLock, *Mem, hSize)
      FreeResource_(hLock)

      If PeekS(@*Mem\Magic[0], 6, #PB_Ascii) <> "PBDATA"
     
        ProcedureReturn *Mem
      EndIf
     
      Size    = *Mem\Size
      CRC     = *Mem\CRC
      Packer  = *Mem\Packer
     
      If Size > 0
        *DestMEM = AllocateMemory(Size)
        If *DestMEM
          If _UnpackMemory(*Mem + SizeOf(UDResPack), MemorySize(*Mem), *DestMEM, Size, Packer) > 0
            FreeMemory(*Mem)
            If CRC32Fingerprint(*DestMEM, Size) = CRC
           
              ProcedureReturn *DestMEM
            Else
              FreeMemory(*DestMEM)
            EndIf
          Else
            FreeMemory(*DestMEM)
          EndIf
        EndIf
      Else
        FreeMemory(*Mem)
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure UDRes_Save(FileName.s, ResNumber, hModule = 0)
  Protected FileID
  Protected *Mem

  FileID = CreateFile(#PB_Any, FileName)

  If FileID
    *Mem = UDRes_Get(ResNumber, hModule)

    If *Mem
      WriteData(FileID, *Mem, MemorySize(*Mem))
      CloseFile(FileID)
      FreeMemory(*Mem)
     
      ProcedureReturn #True
    EndIf

    CloseFile(FileID)
    DeleteFile(FileName)
  EndIf
EndProcedure

Procedure UDRes_CatchSound(Sound, ResNumber, hModule = 0)
  Protected *Mem = UDRes_Get(ResNumber, hModule)
  Protected Result

  If *Mem
    Result = CatchSound(Sound, *Mem, MemorySize(*Mem))
    FreeMemory(*Mem)

    ProcedureReturn Result
  EndIf

EndProcedure

Procedure UDRes_CatchImage(Image, ResNumber, Flag = 0, hModule = 0)
  Protected *Mem = UDRes_Get(ResNumber, hModule)
  Protected Result

  If *Mem
    Result = CatchImage(Image, *Mem, MemorySize(*Mem), Flag)
    FreeMemory(*Mem)

    ProcedureReturn Result
  EndIf

EndProcedure

Procedure UDRes_CatchSprite(Sprite, ResNumber, Modus = 0, hModule = 0)
  Protected *Mem = UDRes_Get(ResNumber, hModule)
  Protected Result

  If *Mem
    Result = CatchSprite(Sprite, *Mem, Modus)
    FreeMemory(*Mem)

    ProcedureReturn Result
  EndIf

EndProcedure

Procedure UDRes_CatchModule(Module, ResNumber, hModule = 0)
  Protected *Mem = UDRes_Get(ResNumber, hModule)
  Protected Result

  If *Mem
    Result = CatchModule(Module, *Mem, MemorySize(*Mem))
    FreeMemory(*Mem)

    ProcedureReturn Result
  EndIf

EndProcedure

XIncludeFile "UDRes_Create_Res_Inc.pbi"
Define File
File = UDRes_Create("DLLSample.res")
UDRes_AddFile(File, "DLLSample.dll", 1,1)
UDRes_Close(File)