Remarque:
-Il faut que les fichiers à zipper soit dans un dossier mais le dossier lui même ne sera pas zipper
donc si vous voulez zipper des fichiers avec le dossier, il faut mettre ce dossier dans un autre dossier
-Le dossier qui a été choisi pour zipper le contenu, ne peut pas être utiliser pour placer le nouveau fichier zip
Par exemple si je choisis de compresser le dossier purebasic dans le chemin ci dessous:
C:\sauvegarde\programme\purebasic
Le dossier source sera C:\sauvegarde\programme\
et le dossier de destination sera, si on souhaite utiliser le même chemin: C:\sauvegarde\
je ne pourrais donc pas utiliser le chemin: C:\sauvegarde\programme\ même si celui-ci (le dossier programme) ne sera pas compresser.
Lorsqu'on dézippe un fichier, la fonction est bloquante mais pas quand on zip, c'est pour cela qu'un second thread est lancé pour vérifier quand est ce que le processus a terminé; de plus il y a une tempo que vous pourrez modifier qui détermine combien de temps on laisse à window pour compresser les fichiers, car il n'y a aucun moyen de savoir si l'opération à été un succès ou pas au niveau de l'objet com.
Le code de la procédure:
Code : Tout sélectionner
#FOF_SILENT = $4
; #FOF_RENAMEONCOLLISION = $8
#FOF_NOCONFIRMATION = $10
; #FOF_ALLOWUNDO = $40
; #FOF_FILESONLY = $80
; #FOF_SIMPLEPROGRESS = $100
; #FOF_NOCONFIRMMKDIR = $200
#FOF_NOERRORUI = $400
; #FOF_NOCOPYSECURITYATTRIBS = $800
; #FOF_NORECURSION = $1000
; #FOF_NO_CONNECTED_ELEMENTS = $2000
Structure param
Id.i
Dest.s
EndStructure
Structure param2
Src.s
Dest.s
hWindow.i
EndStructure
Procedure Newzip(file.s)
Protected id.i
id.i= CreateFile(#PB_Any,file)
If id<>0
WriteByte(id, 80)
WriteByte(id, 75)
WriteByte(id, 5)
WriteByte(id, 6)
For a=1 To 20
WriteByte(id, 0)
Next
Debug "ok"
CloseFile(id)
Else
ProcedureReturn 0
EndIf
ProcedureReturn 1
EndProcedure
Procedure Set_Variant(*Variant.Variant, Type.w, *Valeur.integer)
Select type
Case #VT_I4
*Variant\vt=Type
*Variant\lval=*Valeur\i
Case #VT_BSTR
*Bstr=SysAllocString_(*Valeur)
*Variant\vt=Type
*Variant\pbstrVal=*Bstr
Case #VT_DISPATCH
*Variant\vt=Type
*Variant\pdispVal=*Valeur\i
EndSelect
EndProcedure
Procedure Clean_BSTR(*Variant.Variant)
If *Variant\pbstrVal <> 0
SysFreeString_(*Variant\pbstrVal)
*Variant\pbstrVal = 0
EndIf
EndProcedure
Procedure Wait(*lParam.param)
Protected File.s, size.l, Id.i
File = *lParam\Dest
size = FileSize(File)
Repeat
Delay(150)
a=a+1
Debug "a="+Str(a)
Until FileSize(File) <> size
Repeat
Delay(50)
a=a+1
Debug "b="+Str(a)
Id = OpenFile(0, File)
*lParam\Id=Id
Until Id <> 0
CloseFile(0)
EndProcedure
Procedure Zip_Unzip(*lParam.param2)
Protected Ret.l = 0, Zip.l = 0, hThread.i, param.param, cFlags.l
Protected Dest.s, Src.s
CoInitialize_(0)
Dest = *lParam\Dest
Debug Dest
Src = *lParam\Src
Debug Src
If CoCreateInstance_(?CLSID_Shell, 0, 1, ?IID_IShellDispatch, @IShell.IShellDispatch) <> #S_OK
Goto Clean
EndIf
; Si le dossier destinataire un un zip, il faut créer un zip vierge
If LCase(GetExtensionPart(Dest))="zip"
If Newzip(Dest)=0
Goto Clean
Else
Zip = 1
EndIf
EndIf
Set_Variant(@vt.variant, #VT_BSTR, @Src)
If IShell\Namespace(vt, @FolderScr.Folder ) <> 0
Goto Clean
EndIf
Clean_BSTR(@vt)
Debug FolderScr
Set_Variant(@vt.variant, #VT_BSTR, @Dest)
If IShell\Namespace(vt, @FolderDest.Folder ) <> 0
Goto Clean
EndIf
Clean_BSTR(@vt)
Debug FolderDest
If FolderScr\Items(@fdItems.FolderItems) <> 0
Goto Clean
EndIf
Debug fdItems
cFlags.l = #FOF_SILENT + #FOF_NOCONFIRMATION + #FOF_NOERRORUI
Set_Variant(@vt.variant, #VT_DISPATCH , @fdItems)
Set_Variant(@vt2.variant, #VT_I4, @cFlags)
If FolderDest\CopyHere(@vt, @vt2) <> 0
Goto Clean
EndIf
Ret=1
; Si le dossier de destination est un zip alors on crée un thread
; car la fonction de zippage est asynchrone
If Zip
;hThread = CreateThread(@Wait(), @Dest)
param\Dest=Dest
hThread = CreateThread_(#Null, 0, @Wait(), @param, #THREAD_TERMINATE | #THREAD_QUERY_INFORMATION, @idThread)
Select WaitForSingleObject_(hThread, 30000)
Case #WAIT_OBJECT_0
Ret = 1
Debug "Fin attendue"
Default
Retval = TerminateThread_(hThread, 0)
CloseHandle_(hThread)
If param\Id <> 0
CloseFile(Id)
Ret = 1
Else
Ret = 0
DeleteFile(Dest)
EndIf
Debug "Erreur, Temps alloué au thread dépassé!"
EndSelect
EndIf
Clean:
If FolderScr <> 0
FolderScr\release()
EndIf
If FolderDest <> 0
FolderDest\release()
EndIf
If fdItems <> 0
fdItems\release()
EndIf
If IShell <> 0
IShell\release()
EndIf
CoUninitialize_()
PostMessage_(*lParam\hWindow, #WM_USER + 1000, 0 , Ret)
DataSection
CLSID_Shell:
Data.l $13709620
Data.w $C279,$11CE
Data.b $A4,$9E,$44,$45,$53,$54,$00,$00
IID_IShellDispatch:
Data.l $D8F015C0
Data.w $C278,$11CE
Data.b $A4,$9E,$44,$45,$53,$54,$00,$00
IID_IDispatch:
Data.l $00020400
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_NULL:
Data.l $00000000
Data.w $0000,$0000
Data.b $00,$00,$00,$00,$00,$00,$00,$00
EndDataSection
EndProcedure
Procedure Thread_Zip_Unzip(Dest.s, Src.s, hWindow.i)
Static Folder.param2
Folder\Dest = Dest
Folder\Src = Src
Folder\hWindow = hWindow
CreateThread(@Zip_Unzip(), @Folder)
EndProcedureCode : Tout sélectionner
;{- Enumerations / DataSections
;{ Windows
Enumeration
#Window_0
EndEnumeration
;}
;{ Gadgets
Enumeration
#Button_Valider
#String
#Text
#Button_Dossier
#Button_Fichier
EndEnumeration
;}
;}
Procedure OpenWindow_Window_0()
If OpenWindow(#Window_0, 651, 400, 710, 161, "Zip / Unzip", #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(#Window_0))
ButtonGadget(#Button_Valider, 278, 115, 160, 35, "Valider")
StringGadget(#String, 10, 50, 490, 25, "", #PB_String_ReadOnly )
TextGadget(#Text, 10, 10, 490, 25, "Choisir un Dossier à Zipper ou fichier Zip à Dézipper")
ButtonGadget(#Button_Dossier, 510, 35, 190, 25, "Dossier (Zipper)")
ButtonGadget(#Button_Fichier, 510, 65, 190, 25, "Fichier Zip (Dézipper)")
EndIf
EndIf
EndProcedure
OpenWindow_Window_0()
;{- Event loop
Repeat
Select WaitWindowEvent()
; ///////////////////
Case #PB_Event_Gadget
Select EventGadget()
Case #Button_Valider
Chaine.s = GetGadgetText(#String)
Debug GetFilePart(Chaine)
If GetFilePart(Chaine) = ""
; c'est un dossier, donc on zip
count.l = CountString(Chaine, "\")
Field.s = StringField(Chaine, count, "\")
Dest.s = Left(Chaine, Len(Chaine) - Len(Field) - 1)
Thread_Zip_Unzip(Dest + "New_zip.zip", Chaine, WindowID(#Window_0))
Else
; c'est un zip donc on dézippe
Fichier$ = GetFilePart(Chaine)
Dossier$ = RemoveString(Chaine, Fichier$)
Thread_Zip_Unzip(Dossier$, Chaine, WindowID(#Window_0))
EndIf
DisableGadget(#Button_Valider, 1)
Case #Button_Dossier
Chemin$ = PathRequester("Choisissez un Dossier", "C:\")
SetGadgetText(#String, Chemin$)
Case #Button_Fichier
NomFichier$ = OpenFileRequester("Choisissez un fichier Zip", "C:\", "*.zip", 0)
SetGadgetText(#String, NomFichier$)
EndSelect
Case #WM_USER + 1000
DisableGadget(#Button_Valider, 0)
If EventlParam() = 1
MessageRequester("Info", "Opération réussie")
Else
MessageRequester("Erreur", "Echec, le temps alloué à été dépassé ou une erreur s'est produite")
EndIf
; ////////////////////////
Case #PB_Event_CloseWindow
Select EventWindow()
Case #Window_0
CloseWindow(#Window_0)
Break
EndSelect
EndSelect
ForEver
;
;}