PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

packer_unpacker (zip ) Files and Folder and ProgressBar ;)

https://www.purebasic.fr/english/viewtopic.php?t=64784

Page 1 of 1

packer_unpacker (zip ) Files and Folder and ProgressBar ;)

Posted: Sat Feb 06, 2016 5:44 pm
by dobro
Here is a small example of packer unpacker
which can archive zip files alone
or a folder and all its included tree

code :

Code: Select all


;***********************************************
;Titre  :*pack-depack
;Auteur  : Dobro
;Date  :06/02/2016
;Heure  :17:33:16
;Version Purebasic :  PureBasic 5.41 LTS (Windows - x86)
;Version de l'editeur :EPB V2.62
; Libairies necessaire : Aucune 
;***********************************************


UseZipPacker()
enumeration
	#win
	#bouton_compress
	#progress
	#bouton_decompress
	#Auteur
	#Container_4
	#Option_by_Folder
	#Option_by_files
EndEnumeration
Enumeration
	#Arch
	#Arch2
	#t1
EndEnumeration
Declare  compress()
Declare  decompress()
Declare.s parsedirectory(folder.s, id.l = 0)
Global newlist liste.s() ,file_trouve.s,long_rep
Global taille_sur_disk,taille_dans_archive ,Chemin_decompress$,name$,Compteur ,File,pos_ass=0
OpenWindow(#win,10,10,350,150,"packer_Depacker (Zip)" ,#PB_Window_SystemMenu     )
ButtonGadget  (#bouton_compress, 10, 10, 150, 30, "compresse")
ButtonGadget  (#bouton_decompress, 10, 40, 150, 30, "Decompresse")
ContainerGadget(#Container_4, 190, 10, 105, 55, #PB_Container_Raised)
OptionGadget(#Option_by_Folder, 5, 5, 80, 15, "By Folder")
OptionGadget(#Option_by_files, 5, 25, 80, 15, "By Files")
CloseGadgetList()
SetGadgetState(#Option_by_Folder, 1)
ProgressBarGadget(#progress, 10, 90, 300, 15, 0, 100,#PB_ProgressBar_Smooth   )
TextGadget(#Auteur,280,130,150,25,"By Dobro")
Repeat
	Event = WaitWindowEvent(2)
	Select Event
		Case #PB_Event_Gadget
		Select EventGadget()
			Case #Option_by_Folder
			File=0
			Case #Option_by_files
			File=1
			Case #bouton_decompress
			File$=""
			SetGadgetState(#progress, 0):SetGadgetColor(#progress, #PB_Gadget_FrontColor, rgb(0,255,120))
			File$=OpenFileRequester("load file to Decompress",GetCurrentDirectory(),"*.*",0 )
				Chemin_decompress$=GetCurrentDirectory()
				If OpenPack(#Arch2, File$   ) <>0
					; Liste toutes les entrées du Zip pour les compter
					total_compteur=0
					If ExaminePack(#Arch2)
						While NextPackEntry(#Arch2)
							total_compteur=total_compteur+1
						Wend
					EndIf
					; on regle le Progress Bar
					SetGadgetAttribute(#progress, #PB_ProgressBar_Maximum , total_compteur)
					ClosePack(#Arch2)
				Endif
				;; maintenant on peut decompresser
				If OpenPack(#Arch2, File$   ) <>0
					; maintenant on peut decompresser
					If ExaminePack(#Arch2)
						Compteur=0
						deco_File$=GetFilePart( File$)
						While NextPackEntry(#Arch2)
							name$=PackEntryName(#Arch2) :;debug name$
							chemin_name$=GetPathPart(name$)
							;**** creation de l'arborescence de l'archive sur disque avant extraction (OBLIGATOIRE)********
							nb=CountString(chemin_name$,"/")
							For i=1 to nb
								extr$=StringField(chemin_name$,i,"/")
								CreateDirectory(extr$)
								SetCurrentDirectory(extr$)
							Next i
							; ***************************************
							SetCurrentDirectory(Chemin_decompress$)
							Decompress()
							Compteur=Compteur+1
							SetGadgetState(#progress,Compteur) :UpdateWindow_(GadgetID(#progress))
							;WaitWindowEvent(2)
						Wend
					EndIf
					ClosePack(#Arch2)
					SetGadgetState(#progress, 0) :UpdateWindow_(GadgetID(#progress))
					MessageRequester("Fin" ,"tout a été Décompressé" )
				EndIf
				Case #bouton_compress
				If File=0
					;-compression d'un Dossier ET de son arborescence
					File$=""
					SetGadgetState(#progress, 0) :SetGadgetColor(#progress, #PB_Gadget_FrontColor, rgb(255,0,120))
					rep$= PathRequester("load repertory to compress", "c:\")
					temp$= ReverseString(rep$)
					temp$=trim(temp$,"\")
					num_ret=FindString(temp$,"\",1)-1
					long_rep=len(rep$)-num_ret
					ClearList( liste.s()) 
					ParseDirectory(rep$)
					If FileSize( GetCurrentDirectory()+"mon_archive.zip") <> -1 ; le fichier existe, on l'efface d'abord ! 
						DeleteFile( GetCurrentDirectory()+"mon_archive.zip",#PB_FileSystem_Force)
					Endif
					if CreatePack(#Arch, GetCurrentDirectory()+ "mon_archive.zip",#PB_PackerPlugin_Zip  )
						SetGadgetState(#progress, 0) :UpdateWindow_(GadgetID(#progress))
						compress()
					Else
						MessageRequester("Fin" ,"erreur de compression" )
						End
					Endif
					SetGadgetState(#progress, 0)
					pos_ass=0
				Endif
				;- Compression par Fichiers
				if File=1
					File$=""
					SetGadgetState(#progress, 0) :SetGadgetColor(#progress, #PB_Gadget_FrontColor, rgb(255,0,120))
					File$=OpenFileRequester("load file to compress","c:\","*.*",0,#PB_Requester_MultiSelection )
						temp$= ReverseString(File$)
						temp$=Ltrim(temp$,"\")
						num_ret=FindString(temp$,"\",1)-2
						long_rep=len(File$)-num_ret
						copy_file$=File$
						taille_sur_disk=0
						ClearList( liste.s()) 
						If FileSize( GetCurrentDirectory()+"mon_archive.zip") <> -1 ; le fichier existe, on l'efface d'abord ! 
							DeleteFile( GetCurrentDirectory()+"mon_archive.zip",#PB_FileSystem_Force)
						Endif
						if CreatePack(#Arch, GetCurrentDirectory()+ "mon_archive.zip",#PB_PackerPlugin_Zip  )
							; calcul de la taille du progress bar
							Global newlist liste.s()
							While copy_file$<>""
								AddElement(liste.s())
								liste.s()=copy_file$
								if FileSize( copy_file$ )<>-1 and FileSize( copy_file$ )<>-2
									taille_sur_disk=taille_sur_disk+(FileSize( copy_file$ ))
									taille_f=FileSize( copy_file$ )
									SetGadgetAttribute(#progress, #PB_ProgressBar_Maximum , taille_sur_disk)
									SetGadgetState(#progress, taille_sur_disk-taille_f) :UpdateWindow_(GadgetID(#progress))
									;debug File$ + " " +str(taille_sur_disk)
								Else
									Break
								Endif
								copy_file$= NextSelectedFileName()
							Wend
							SetGadgetState(#progress, 0) :UpdateWindow_(GadgetID(#progress))
							ResetList(Liste()) 
							compress()
						Else
							MessageRequester("Fin" ,"erreur de compression" )
							End
						Endif
						SetGadgetState(#progress, 0)
					Endif
					;}
				EndSelect
			EndSelect
		Until Event = #PB_Event_CloseWindow
		
		;- zone procedures
		Procedure compress()
			;By Dobro
			ForEach Liste()
				taille_sur_disk=FileSize(Liste.s() )
				if taille_sur_disk<>-1
					pos_ass=pos_ass+taille_sur_disk
					;AddPackFile(#Arch, Liste.s(),Liste.s()) ; ajout des fichiers avec les repertoires racine
					AddPackFile(#Arch, Liste.s(),Mid(Liste.s(),long_rep)) ; ajout seulement des fichiers pointés (sans les dossiers parents )
					SetGadgetState(#progress, pos_ass):UpdateWindow_(GadgetID(#progress))
					WaitWindowEvent(2)
					delay (190)
				Else
					Break
				Endif
			Next
			Resultat = ClosePack(#Arch)
			pos_ass=0
			MessageRequester("Fin" ,"tout a été compressé" )
			SetGadgetState(#progress, 0) :UpdateWindow_(GadgetID(#progress))
		Endprocedure
		;
		Procedure Decompress() 
			; By Dobro
			UncompressPackFile(#Arch2,Chemin_decompress$+name$ ) ; on decompresse au meme endroit que le Zip
		Endprocedure
		
		Procedure.s ParseDirectory(folder.s, id.l = 0)
			; By Dobro
			; recurcif Power
			If Right(folder, 1) <> "\"
				folder + "\"
			EndIf
			If ExamineDirectory(id, folder, "*.*")
				While NextDirectoryEntry(id)
					If DirectoryEntryName(id) <> "." And DirectoryEntryName(id) <> ".."
						;##########################################
						file_trouve.s= folder + DirectoryEntryName(id)
						if filesize (file_trouve.s) >0
							taille_sur_disk=taille_sur_disk+(FileSize( file_trouve.s))
							taille_f=FileSize( file_trouve.s )
							SetGadgetAttribute(#progress, #PB_ProgressBar_Maximum , taille_sur_disk)
						Endif
						AddElement(liste.s())
						liste.s()=file_trouve.s
						;##########################################
						If DirectoryEntryType(id) = #PB_DirectoryEntry_Directory
							ParseDirectory(folder + DirectoryEntryName(id), id + 1)
						EndIf
					EndIf
				Wend
				FinishDirectory(id)
			EndIf
		EndProcedure
		; 
		
; Epb

Re: packer_unpacker (zip ) Files and Folder and ProgressBar

Posted: Tue Jul 04, 2017 4:19 pm
by SeregaZ
it is cant unpack folder-case pack archive? 1 files is unpack, but when it was a folder with files - nothing happen. it shows message tout a été Décompressé, but folders not appear.

and as i can understand it is unpack from file - but can it work with memory? by idea programm is download pack arhive in a memory, then unpack and save as files.

Re: packer_unpacker (zip ) Files and Folder and ProgressBar

Posted: Tue Jul 04, 2017 4:28 pm
by SeregaZ

Code: Select all

nb = CountString(chemin_name$,"/") 
                For i=1 To nb
                  extr$ = StringField(chemin_name$, i, "/")
this one probably uncorrect. for my case Windows XP x86 must be another slash.

Code: Select all

nb = CountString(chemin_name$,"\") 
                For i=1 To nb
                  extr$ = StringField(chemin_name$, i, "\")
anyway it have some CatchPack() as CatchImage and CatchSound command?
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited