Discussion :

[soulryo]

Bonjour,

Après plusieurs recherches je n'ai pas trouver comment faire du zip en vb6 à partir des librairies natives de windows XP et windows server 2003.

Je ne veux pas utiliser winzip ou une librairie payante mais me servir du zip natif windows.

Aurriez vous des pistes?

Merci par avance.

[Najdar]

Bonjour Soulryo,

Si jamais tu change d'avis , moi j'utilise la librairie de Xceed Soft.
http://www.xceedsoft.com/products/ZipCompL/index.aspx

Elle fonctionne parfaitement : rapide robuste et pratique. Je l'utilise même, de façon intensive, pour zipper des chaines en mémoire et les stocker dans ma base de données.

[soulryo]

c'est cher!

merci quand même, si je trouve vraiment rien avec les dll de windows je me rabattrai sur une solution payante

[SilkyRoad]

bonjour

ce lien pourra peut etre t'aider

http://www.developpez.net/forums/sho...d.php?t=206318


michel

[soulryo]

J'ai testé ton code mais j'obtient l'erreur suivante lorsque je tente de compresser un fichier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
La méthode 'NameSpace' de l'objet 'IShellDispatch4' a échoué

correspondant à la ligne du code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(Source)

voici un rappel du code initial :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Public Sub ZipCreation(FilePath As String)
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim Source, Destination, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys
Source = FilePath
Destination = "E:\save.zip"
MyHex = _
Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
For i = 0 To UBound(MyHex)
    MyBinary = MyBinary & Chr(MyHex(i))
Next
 
Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
'Creation de la base du fichier zip.
Set oCTF = oFileSys.CreateTextFile(Destination, True)
oCTF.Write MyBinary
oCTF.Close
 
Set oCTF = Nothing
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(Source)
 
If Not oFolder Is Nothing Then _
    oApp.NameSpace(Destination).CopyHere
oFolder.Items
'pour l'utilisation en VBS 'wScript.Sleep 5000
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
    'Attention: provoque une erreur 70 si un des fichiers à zipper
    'est toujours ouvert.
    Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
    If Err.Number <> 0 Then
        Err.Clear
        'pour l'utilisation en VBS
        'wScript.Sleep 3000
    End If
Loop
Set oFile = Nothing
Set oFileSys = Nothing
 
End Sub

je ne vois pas dutout la raison de cette erreur

[SfJ5Rpw8]

tu est sur du contenu de ta variable source..? (affiche le ..)

[soulryo]

Oui je suis bien sur de ma source, j'arrive à afficher le path du fichier

[SfJ5Rpw8]

le code fonctionne "chez moi" juste un probléme de retour chariot en trop ici aprés le copyHEre..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If Not oFolder Is Nothing Then _
    oApp.NameSpace(Destination).CopyHere oFolder.Items

[soulryo]

tu peux donner le script que tu as générer stp?
pour comparer par rapport à mon programme.

merci par avance.

ps : j'avais modifier le pb de retour chariot

[SfJ5Rpw8]

tu peux donner le script que tu as générer stp?
pour comparer par rapport à mon programme.

merci par avance.

ps : j'avais modifier le pb de retour chariot

ben c'est le code que tu as posté tel quel ... excuse moi d'insisiter mais montre nous ce que tu as mis dans ta variable source..

[soulryo]

pas de problème

voici ma source : "E:\test.xls"

et voici le rappel de l'erreur obtenu :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
La méthode 'NameSpace' de l'objet 'IShellDispatch4' a échoué

[SfJ5Rpw8]

il faut surement modifier le code pour un fichier ...seul.? celui-ci "fonctionne" pour l'archivage d'un répertoire..

[soulryo]

d'accord...je vois mieux pourquoi ça ne fonctionne pas dans l'état...

faut peut être que je fasse un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set oFile = oApp.NameSpace(Source)

à la place de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set oFolder = oApp.NameSpace(Source)

[SfJ5Rpw8]

eu... c'est pas juste en changeant le nom de la variable que tu change le comportement du code...

[soulryo]

oui en effet

j'ai tenté de modifier le code par ci par là pour qu'il prenne en compte le zippage d'un fichier et non d'un repertoire mais rien y fait...faut dire que je ne comprends pas gdr chose au code initial

[SilkyRoad]

bonsoir

tu peux tester cette adaptation pour zipper un fichier seul

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub ZipFichier()
    Dim oShell As Object, Fso As Object
    Dim i As Long
    Dim Fichier As String, MyBinary As String
    Dim LeZip As Variant
    Dim MyHex As Variant
 
    Fichier = "C:\le classeur.xls"
    LeZip = "C:\Ma sauvegarde.zip"
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    MyHex = _
        Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
 
    With Fso.CreateTextFile(LeZip, True)
        .Write MyBinary
        .Close
    End With
 
    Set oShell = CreateObject("Shell.Application")
    oShell.NameSpace(LeZip).CopyHere (Fichier)
 
    Set oShell = Nothing
End Sub

bonne soiree
michel

[soulryo]

Merci grandement pour votre aide ce code fonctionne bien

par contre je ne comprends pas très bien comment le zip est fait...?
Le tableau binaire MyHex permet de construire le socle du zip?

Merci en tout cas!