image/son/mémoire/chaine de caractère/long etc...
l’intérêt est surtout qu'une fois l'archive ouverte vous n'êtes pas obligé de tout charger d'un coup et vous n'êtes pas obligé de charger les fichiers dans l'ordre.
je n'avais pas ajouté de compression car il y a des problèmes de compatibilité entre x64 et X86 dans le packer de PB, et aussi car la plus part des fichiers que je mettais dans l'archive était déjà compressé (jpg/mp3)
Bref il est loin d'être parfait mais peut être que ça sera utilise a quelqu'un et il ne doit pas être trop difficile a modifier pour rajouter ce que vous voulez dans l'archive.
L'idée est d'avoir un Quad en début de fichier qui contient l'adresse du catalogue
on ajoute tout ce qu'on veut a l'archive et au moment de clôturer ça écrit le catalogue. A l'ouverture de l'archive ça ne lit que le catalogue (ça prend pas de place) ensuite vous pouvez charger ce que vous voulez et quand vous voulez ...
tout cela peut nettement être améliorer ... je ferais peut être des mise à jour ...
Code : Tout sélectionner
; Data types
Enumeration
#ResFile
#ResLong
#ResString
EndEnumeration
; - Structure Ressource
Structure Ressource
type.l ; See Data types
file.s ; nom du fichier ou nom tout court
size.q ;Taille des données
pack.l ;0 pas compressé
filepointer.q
EndStructure
Structure pack
file.s ;Nom du pack
id.i ;PB handle of the file
List ressource.Ressource() ;list des données
EndStructure
;Create an empty archive
Procedure CreateArchive(*pack.pack,file.s)
*pack\file=file.s
*pack\id=CreateFile(#PB_Any, *pack\file)
If *pack\id
WriteQuad(*pack\id,0); je reserve la place pour l'adresse du catalogue
EndIf
EndProcedure
;ajoute un fichier a l'archive
Procedure AddFileToArchive(*pack.pack,file.s)
Define size.q,*mem,tmpId.i
size.q=FileSize(file)
If size>0
*mem=AllocateMemory(size)
tmpId.i=ReadFile(#PB_Any,file)
If tmpId
ReadData(tmpId,*mem,size)
CloseFile(tmpId)
;Si on veut crypter ou compresser il faut faire ici
If WriteData(*pack\id,*mem,size)>0
AddElement(*pack\ressource())
*pack\ressource()\type=#ResFile
*pack\ressource()\file=file
*pack\ressource()\size=size
*pack\ressource()\pack=0
FreeMemory(*mem)
ProcedureReturn #True
EndIf
EndIf
EndIf
ProcedureReturn #False
EndProcedure
;ajoute une chaine a l'archive
Procedure AddStringToArchive(*pack.pack,name.s,value.s)
Define size.q
size.q=StringByteLength(value,#PB_Unicode);+2
;Si on veut crypter ou compresser il faut faire ici
If WriteString(*pack\id,value,#PB_Unicode)>0
AddElement(*pack\ressource())
*pack\ressource()\type=#ResString
*pack\ressource()\file=name
*pack\ressource()\size=size
*pack\ressource()\pack=0
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;ajoute un long a l'archive
Procedure AddLongToArchive(*pack.pack,name.s,value.l)
Define size.q
size.q=4
;Si on veut crypter ou compresser il faut faire ici
If WriteLong(*pack\id,value)<>0
AddElement(*pack\ressource())
*pack\ressource()\type=#ResLong
*pack\ressource()\file=name
*pack\ressource()\size=size
*pack\ressource()\pack=0
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;ferme l'archive et ecrit le catalogue
Procedure CloseCreateArchive(*pack.pack)
adrStartCatalog.q=Loc(*pack\id) ; Je note l'adresse
FileSeek(*pack\id, 0) ; je retourne au debut du fichier
WriteQuad(*pack\id,adrStartCatalog) ; j'écrit l'adresse note avant (qui sera l'adresse du catalogue)
Debug "debut de fichier "+Str(Loc(*pack\id)) ; Je note l'adresse debut de fichier
FileSeek(*pack\id, adrStartCatalog) ; je retourne a l'adresse
; j'écris le catalogue
WriteLong(*pack\id,ListSize(*pack\ressource()));d'abord le nombre de fichier
ForEach *pack\ressource() ;puis pour chaque écriture
WriteLong(*pack\id,*pack\ressource()\type) ; le type de l'ecriture
WriteQuad(*pack\id,*pack\ressource()\size) ; la taille de ce qui est ecrit
fileName.s=GetFilePart(*pack\ressource()\file) ; l
WriteStringN(*pack\id,fileName,#PB_Unicode) ; le nom
Next
CloseFile(*pack\id) ; et enfin je ferme le packacge
EndProcedure
;ouvre l'archive et lit le catalogue
Procedure ReadArchives(*pack.pack,file.s)
*pack\file=file.s
*pack\id=ReadFile(#PB_Any, file)
If *pack\id
;Lit ou se trouve le catalogue
adrStartCatalog.q=ReadQuad(*pack\id)
adrStartFile.q=Loc(*pack\id) ;adresse du debut des fichiers
FileSeek(*pack\id, adrStartCatalog) ; on se deplace pour trouver le catalogue
;je lis le catalogue
n=ReadLong(*pack\id)
For z=0 To n-1
AddElement(*pack\ressource())
*pack\ressource()\type=ReadLong(*pack\id)
*pack\ressource()\size=ReadQuad(*pack\id)
;lenght.l=ReadLong(id)
;*pack\ressource()\file=ReadString(id)
;WriteLong(id,StringByteLength(fileName,#PB_Unicode))
*pack\ressource()\file=ReadString(*pack\id,#PB_Unicode)
Debug *pack\ressource()\file
Next
ForEach *pack\ressource()
*pack\ressource()\filepointer=adrStartFile
adrStartFile=adrStartFile+*pack\ressource()\size
Next
EndIf
ProcedureReturn *pack\id
EndProcedure
;pour lire des données et les stocker en mémoire quelques soit le type
Procedure ReadMemFromArchives(*pack.pack,adrStartFile.q,size.q)
*mem=AllocateMemory(size)
FileSeek(*pack\id, adrStartFile)
ReadData(*pack\id,*mem,size)
ProcedureReturn *mem
EndProcedure
;pour capturer une image a partir de l'archive
Procedure CatchImageFromArchives(*pack.pack,imageId.i,file.s)
Protected result.i
fileclose=#False ; part défaut on ne ferme pas le fichier apres la lecture
If IsFile(*pack\id)=#False ; mais si le fichier est déjà fermé alors on l'ouvre et on le refermera apres
*pack\id=ReadFile(#PB_Any,*pack\file)
fileclose=#True
EndIf
ForEach *pack\ressource()
If *pack\ressource()\file=file
Debug"trouvé la"
*mem=ReadMemFromArchives(*pack,*pack\ressource()\filepointer,*pack\ressource()\size)
result.i=CatchImage(imageId,*mem,*pack\ressource()\size)
FreeMemory(*mem) ;plus besoin de la mémoire on la libère
EndIf
Next
If fileclose=#True
CloseFile(*pack\id)
EndIf
Debug result
EndProcedure
Procedure.S CatchStringFromArchives(*pack.pack,name.s)
fileclose=#False ; part défaut on ne ferme pas le fichier apres la lecture
If IsFile(*pack\id)=#False ; mais si le fichier est déjà fermé alors on l'ouvre et on le refermera apres
*pack\id=ReadFile(#PB_Any,*pack\file)
fileclose=#True
EndIf
ForEach *pack\ressource()
If *pack\ressource()\file=name
Debug"trouvé"
*mem=ReadMemFromArchives(*pack,*pack\ressource()\filepointer,*pack\ressource()\size)
value.s=PeekS(*mem,-1,#PB_Unicode)
FreeMemory(*mem)
EndIf
Next
If fileclose=#True
CloseFile(*pack\id)
EndIf
ProcedureReturn value
EndProcedure
Procedure.l CatchLongFromArchives(*pack.pack,name.s)
fileclose=#False ; part défaut on ne ferme pas le fichier apres la lecture
If IsFile(*pack\id)=#False ; mais si le fichier est déjà fermé alors on l'ouvre et on le refermera apres
*pack\id=ReadFile(#PB_Any,*pack\file)
fileclose=#True
EndIf
ForEach *pack\ressource()
If *pack\ressource()\file=name
Debug"trouvé"
FileSeek(*pack\id, *pack\ressource()\filepointer)
value.l=ReadLong(*pack\id)
EndIf
Next
If fileclose=#True
CloseFile(*pack\id)
EndIf
ProcedureReturn value
EndProcedure
Procedure CloseReadArchive(*pack.pack)
CloseFile(*pack\id)
EndProcedure
;-TEST
UsePNGImageDecoder()
pack.pack
CreateArchive(@pack,"test.pk")
AddStringToArchive(@pack,"clavier","azerty")
AddFileToArchive(@pack,"04-00.png")
AddLongToArchive(@pack,"chiffre",123456)
AddFileToArchive(@pack,"05-00.png")
AddStringToArchive(@pack,"script","blablablablablabla"+#LFCR$+"coucou")
AddFileToArchive(@pack,"06-00.png")
CloseCreateArchive(@pack)
test.pack
Debug "____"
ReadArchives(test,"test.pk")
CatchImageFromArchives(test,1,"05-00.png")
Debug SaveImage(1,"testimage.bmp") ;juste pour tester si l'image a bien fonctionné
CloseReadArchive(test.pack)
Debug CatchLongFromArchives(test,"chiffre")
Debug CatchStringFromArchives(test,"script")
Debug CatchStringFromArchives(test,"clavier")
j'avais pris le même type d'architecture pour une archive de mon projet SCMangwa (mais que avec des images)
)
Et comme je traite des fichiers archives en moyenne de 2Go, c'est pas super pour reconstruire le fichier sans fragmentations !
mon rêve !! 
)