1) La fonction AddPackFile() échoue systématiquement lorsque le fichier a une taille de 0 (je sais on va me dire que ce fichier ne sert à rien puisqu'il est vide, mais je m'en suis aperçu car j'en avais et j'ai testé avec WinRar, ça marche pour ce type de fichiers).
2) Je stocke dans l'archive des chaines de caractères comme ceci :
Code : Tout sélectionner
Resultat = AddPackMemory(@Nom_Fichiers.s, Len(Nom_Fichiers) + 1, 9)le +1 étant pour stocker le 0 de terminaison.
Cette fonction d'après la doc Ajoute et compresse la zone mémoire spécifiée dans le Pack préalablement créé avec la commande CreatePack().
Lors de la décompression, j'utilise ceci pour récupérer la chaîne :
Code : Tout sélectionner
NomFichier.s = Space(256) ; 256 étant largement dimensionné
NomFichier = PeekS(AdresseMemoire)
JCJ
JCn
etc.
J'ai donc voulu décompresser systématiquement ces chaines avec UnpackMemory(AdresseMemoire, @NomFichier) mais ça plante méchant lorsque la chaîne retournée correspond à la chaîne d'origine c'est-à-dire lorsque cette chaîne a été ajouté à l'archive mais sans avoir pu être compressée.
Voici le code que j'utilise pour faire mes essais; Openfilerequester() ne retourne pas les bonnes chaines lorsque les fichiers sont des .lnk ou des .pif
J'ai corrigé dans ce code (procedures compresse et decompresse) le problème du fichier de taille 0.
J'ai corrigé mais uniquement dans la procedure LectureFichiers(FichierCompresser$) le problème n° 2, car en fait je stocke la taille réelle du fichier dans l'archive et je compare avec celle renvoyé par PackFileSize() et j'utilise UnpackMemory() lorsque ça ne correspond pas et dans ce cas UnpackMemory() retourne effectivement la bonne chaine décompressée. Le code est pas optimisé, c'est un code d'essais et avec des copier/coller qui font que peut-être certains commentaires sont faux.
Code : Tout sélectionner
;
; Le code permet de compresser et de décompresser un fichier avec la sauvegarde du nom
; du fichier dans l'archive
; ;======================================================================
; ; constantes
; ;======================================================================
Enumeration
#Fenetre_Principale
#Fenetre_Secondaire
#Text_Nb_Fichiers
#ListIconGadget
#Bouton_Creer_Archive
#Bouton_Decompresser
#Bouton_Liste_Fichiers
#Fichier
#ProgressBarGadget
#ExplorerTreeGadget
EndEnumeration
#MB_ICONERROR = 16
#FicherCourant = 1
#PBM_SETRANGE32 = 1030
Declare PackerProgress(SourcePosition, DestinationPosition)
Structure Ecran_Disponible ; pour retourne la position x, y et laes tailles de l'écran dispo maxi
Pos_X.l ; position en X
Pos_Y.l ; position en Y
LargeurPrincipale.l ; Taille max X
HauteurPrincipale.l ; Taille max Y
EndStructure
Global Taille_Ecran.Ecran_Disponible
Structure Fichiers_A_Compresser
nom.s ; nom du fichier
Position.l ; position du fichier dans l'archive
EndStructure
NewList Fichiers_Selectionner.Fichiers_A_Compresser() ; récupère les infos des fichiers
; sélectionnés pour la compression
; ;==================================================================================================================
; ;==================================================================================================================
Procedure.l Compresse(NomFichier$)
Shared Taille_non_Compres
If CreatePack(NomFichier$) ; crée le le fichier qui va être compressé
packers$ = OpenFileRequester("Choisissez le(s) fichiers a compresser", "tout", "*.*", 0, #PB_Requester_MultiSelection)
If packers$ ; teste si la chaine existe
Repeat
; dans cette boucle je compte le nombre de fichier pour pouvoir afficher la progressbar correctement
; le comptage va très vite
Nb_FichiersACompresser + 1
AddElement(Fichiers_Selectionner())
Fichiers_Selectionner()\nom = packers$
Fichiers_Selectionner()\Position = Nb_FichiersACompresser
packers$ = NextSelectedFileName()
Until packers$ =""
Debug CountList(Fichiers_Selectionner())
Debug ""
; ici on redimensionne le maxi de la progressbar
SendMessage_(GadgetID(#ProgressBarGadget), #PBM_SETRANGE32, 0, CountList(Fichiers_Selectionner()))
Fichiers_Compresser = 0
ForEach Fichiers_Selectionner()
Hwnd = ReadFile(#Fichier, Fichiers_Selectionner()\nom)
If Hwnd
; ajoute le nom du fichier à l'archive
; on ajoute 1 à len(packers$) pour écrire le 0 qui est le caractète de fin de chaîne
Resultat = AddPackMemory(@Fichiers_Selectionner()\nom, Len(Fichiers_Selectionner()\nom) + 1, 9)
If Resultat = 0
Debug Fichiers_Selectionner()\nom
Debug "AddPackMemory(@Fichiers_Selectionner\nom = " + Str(Resultat)
EndIf
; récupère la taille du fichier non compressé et la met sous la forme d'une
; chaîne de caractères
Taille_non_Compres = FileSize(Fichiers_Selectionner()\nom)
Taille_non_Compresser$ = Str(Taille_non_Compres)
; ajoute la taille du fichier non compressé à l'archive
; on ajoute 1 à len(Taille_non_Compresser$) pour écrire le 0 qui est le caractète
; de fin de chaîne
Resultat = AddPackMemory(@Taille_non_Compresser$, Len(Taille_non_Compresser$) + 1, 0)
If Resultat = 0
Debug "AddPackMemory(Taille_non_Compresser$ = " + Str(Resultat)
EndIf
; récupère la date de la dernière écriture du fichier
If GetFileTime_(Hwnd, 0, 0, lpLastWriteTime.FILETIME)
FileTimeToLocalFileTime_(@lpLastWriteTime, @lpLocalFileTime.FILETIME)
FileTimeToSystemTime_(@lpLocalFileTime, @st.SYSTEMTIME)
DateFichier.s = Space(256)
HeureFichier.s = DateFichier
GetDateFormat_(2048, 0, @st, "dd'/'MM'/'yyyy", DateFichier, 255)
GetTimeFormat_(2048, #TIME_FORCE24HOURFORMAT, @st, 0, HeureFichier, 255)
DateFichier + " " + HeureFichier
CloseFile(#Fichier)
Else
DateFichier = " ?"
EndIf
; ajoute la date et l'heure du fichier à l'archive sous la forme d'une chaîne
; on ajoute 1 à len(DateFichier) pour écrire le 0 qui est le caractète
; de fin de chaîne
Resultat = AddPackMemory(@DateFichier, Len(DateFichier) + 1, 0)
If Resultat = 0
Debug "AddPackMemory(DateFichier = " + Str(Resultat)
EndIf
If Taille_non_Compres ; on ajoute le fichier uniquement s'il n'est pas vide
; Compresse le fichier et l'ajoute à l'archiveavec une compression maxi (9)
Resultat = AddPackFile(Fichiers_Selectionner()\nom, 9)
If Resultat = 0
Debug "Résultat de la compression du fichier :" + Fichiers_Selectionner()\nom
EndIf
EndIf
Fichiers_Compresser + 1
SetGadgetState(#ProgressBarGadget, Fichiers_Compresser)
EndIf
Next ; on reboucle tant qu'il y a des fichiers à compresser dans la liste
ClosePack() ; ferme le pack
ProcedureReturn 1 ; c'est Ok alors on retourne 1
Else
MessageRequester("Information", "Aucun fichier n'a été sélectionné", #MB_ICONERROR)
EndIf
EndIf
ProcedureReturn 0 ; c'est pas Ok alors on retourne 0
EndProcedure
; ;==================================================================================================================
; ;==================================================================================================================
Procedure.l Decompresse(FichierCompresser$)
If OpenPack(FichierCompresser$)
NomChemin$ = PathRequester("Décompresser vers", "C:\Program Files\PureBasic\Projets\")
NomFichier.s = Space(256) ; crée la variable chaine qui récupèrera le nom de fichier courant
AdresseMemoire = NextPackFile() ; On récupère le premier élément compressé, c'est-à-dire le nom du fichier
Fichiers_DeCompresser = 0
While AdresseMemoire ; on débute la boucle
NomFichier = PeekS(AdresseMemoire) ; récupère le nom de fichier en situé en mémoire
AdresseMemoire = NextPackFile() ; récupère la taille du fichier à décompresser
Taille_Reelle.s = PeekS(AdresseMemoire)
AdresseMemoire = NextPackFile() ; récupère la date et l'heure du fichier à décompresser
DateFichier.s = PeekS(AdresseMemoire)
If Val(Taille_Reelle) ; on extrait uniquement si la taille > 0
AdresseMemoire = NextPackFile() ; récupère l'adresse du fichier à décompresser
Taille = PackFileSize() ; récupère la taille du fichier à décompresser
If NomChemin$ <> "" And AdresseMemoire
NomFichier = NomChemin$ + GetFilePart(NomFichier)
CreateFile(#FicherCourant, NomFichier) ; on crée le fichier sur le disque
WriteData(AdresseMemoire, Taille ) ; on écrit le contenu du fichier
CloseFile(#FicherCourant) ; on ferme le fichier
Fichiers_DeCompresser + 1
Debug NomFichier
EndIf
Else ; le fichier est vide donc à créer puisqu'il n'est pas dans l'archive
If NomChemin$ <> ""
NomFichier = NomChemin$ + GetFilePart(NomFichier)
CreateFile(#FicherCourant, NomFichier) ; on crée le fichier vide sur le disque
CloseFile(#FicherCourant) ; on ferme le fichier
Fichiers_DeCompresser + 1
EndIf
EndIf
AdresseMemoire = NextPackFile() ; on continue l'opération tant que adresseMemoire est différent de 0
Wend
ClosePack() ; ferme le pack
ProcedureReturn 1
Else
MessageRequester("Erreur", "OpenPack a échoué", 16)
EndIf
ProcedureReturn 0
EndProcedure
; ;==================================================================================================================
; ;==================================================================================================================
Procedure.l LectureFichiers(FichierCompresser$)
If OpenPack(FichierCompresser$)
AdresseMemoire = NextPackFile() ; On récupère le premier élément compressé, c'est-à-dire le nom du fichier
While AdresseMemoire ; on débute la boucle
TailleDecompress = PackFileSize()
NomFichier.s = Space(TailleDecompress) ; crée la variable chaine qui récupèrera le nom de fichier courant
NomFichier = PeekS(AdresseMemoire) ; récupère le nom du fichier
Debug NomFichier
Debug Len(NomFichier)
Debug TailleDecompress
If Len(NomFichier) <> TailleDecompress -1
NomFichier.s = Space(TailleDecompress) ; crée la variable chaine qui récupèrera le nom de fichier courant
Debug UnpackMemory(AdresseMemoire, @NomFichier)
Debug NomFichier
Debug ""
EndIf
AdresseMemoire = NextPackFile() ; récupère l'adresse du fichier à décompresser
Taille_Reelle.s = PeekS(AdresseMemoire)
AdresseMemoire = NextPackFile() ; récupère l'adresse de la chaîne De la date et heure du fichier
DateFichier.s = PeekS(AdresseMemoire)
If NomChemin$ <> ""
NomFichier = NomChemin$ + GetFilePart(NomFichier)
EndIf
If Val(Taille_Reelle)
AdresseMemoire = NextPackFile() ; récupère l'adresse du fichier à décompresser si la taille <> 0
; on passe le fichier et on continue
EndIf
AddGadgetItem(#ListIconGadget, -1, GetFilePart(NomFichier) + Chr(10)+ Taille_Reelle + Chr(10) + " ?" + Chr(10)+DateFichier)
AdresseMemoire = NextPackFile() ; on continue l'opération tant que adresseMemoire est différent de 0
Wend
TextGadget(#Text_Nb_Fichiers, 10, 320, 100, 20, "Nombre fichiers : " + Str(CountGadgetItems(#ListIconGadget)))
ClosePack() ; ferme le pack
ProcedureReturn 1
Else
MessageRequester("Erreur", "La lecture du pack a échouée", 16)
EndIf
ProcedureReturn 0
EndProcedure
; ;==================================================================================================================
; ;==================================================================================================================
Procedure AfficheListe(List$)
; rempli la listicongadget avec les renseignements de l'archive
If OpenWindow(#Fenetre_Secondaire, 0, 0, 700, 340, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Visualisations des fichiers de l'archive")
HideWindow(#Fenetre_Principale, 1)
If CreateGadgetList(WindowID()) And ListIconGadget(#ListIconGadget, 10, 20, 680, 280, "Noms", 300, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(#ListIconGadget, 1, "Taille Non compressé", 100)
AddGadgetColumn(#ListIconGadget, 2, "Taille compressé", 100)
AddGadgetColumn(#ListIconGadget, 3, "Date ", 150)
LectureFichiers(List$)
Repeat
Select WaitWindowEvent()
Case #PB_EventGadget
Select EventGadgetID()
;
EndSelect
Case #PB_EventCloseWindow
If EventWindowID() = #Fenetre_Secondaire
CloseWindow(#Fenetre_Secondaire)
quit + 1
EndIf
EndSelect
Until quit
EndIf
HideWindow(#Fenetre_Principale, 0)
EndIf
EndProcedure
; ;==================================================================================================================
; ;==================================================================================================================
Procedure.l TailleEcran()
; retourne 0 en cas d'échec sinon retourne 1
Global Taille.Rect
Taille_Ecran\Pos_X = 0
Taille_Ecran\Pos_Y = Taille_Ecran\Pos_X
Taille_Ecran\LargeurPrincipale = Taille_Ecran\Pos_X ; initialise tout à 0
Taille_Ecran\HauteurPrincipale = Taille_Ecran\Pos_X
;
Result.l = SystemParametersInfo_(#SPI_GETWORKAREA, 0, @Taille, 0)
Taille_Ecran\Pos_X = Taille\left
Taille_Ecran\Pos_Y = Taille\Top
Taille_Ecran\LargeurPrincipale = GetSystemMetrics_(#SM_CXFULLSCREEN) - (GetSystemMetrics_(#SM_CYSIZEFRAME))
Taille_Ecran\HauteurPrincipale = GetSystemMetrics_(#SM_CYFULLSCREEN) - (GetSystemMetrics_(#SM_CXSIZEFRAME))
If Result
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
; ;==================================================================================================================
; ;==================================================================================================================
; récupère la hauteur et la largeur dispo de l'écran (zone utilisateur)
If TailleEcran() And OpenWindow(#Fenetre_Principale, Taille_Ecran\Pos_X, Taille_Ecran\Pos_y, Taille_Ecran\LargeurPrincipale , Taille_Ecran\HauteurPrincipale , #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_Invisible, "Compresser/Décompresser des fichiers")
; affiche la fenêtre en la maximisant
ShowWindow_(WindowID(), #SW_MAXIMIZE)
If CreateGadgetList(WindowID())
ButtonGadget(#Bouton_Creer_Archive, 50, 30, 100, 25, "Créer une archive")
ButtonGadget(#Bouton_Decompresser, 35, 70, 140, 25, "Decompresser une archive")
ButtonGadget(#Bouton_Liste_Fichiers, 35, 110, 170, 25, "Lister les fichiers de l'archive")
ProgressBarGadget(#ProgressBarGadget, 10, 150, 230, 10, 0, 100, #PB_ProgressBar_Smooth)
Repeat
Select WaitWindowEvent()
Case #PB_EventGadget
Select EventGadgetID()
Case #Bouton_Creer_Archive
Texte$ = SaveFileRequester("Enregistrer sous:", FichierParDefaut$, "tout|*.*", 0)
If Texte$ <> "" And Compresse(Texte$)
MessageRequester("Compression", "La compression a réussie", 16)
Else
MessageRequester("Information", "L'opération a été annulée", #MB_ICONERROR)
EndIf
Case #Bouton_Decompresser
Texte$ = OpenFileRequester("Décompression d'une archive:", "C:\Program Files\PureBasic\Projets\", "tout|*.*", 0)
If Texte$ <> "" And Decompresse(Texte$)
Else
MessageRequester("Information", "L'opération a échouée", #MB_ICONERROR)
EndIf
Case #Bouton_Liste_Fichiers
Texte$ = OpenFileRequester("Lister les fichiers d'une archive:", "C:\Program Files\PureBasic\Projets\", "tout|*.*", 0)
If Texte$ <> ""
AfficheListe(Texte$)
EndIf
EndSelect
Case #PB_EventCloseWindow
quit + 1
EndSelect
Until quit
EndIf
EndIf
End
