Discussion :

[Coin]

Bonjour à tous,

J'ai créé un exécutable qui me permet de zipper plusieurs fichiers. L'exécutable fonctionne bien, mais refuse de zipper des fichiers supérieurs à 2 Go...

J'ai vérifié mon programme en pas à pas, et le programme fonctionne très bien jusqu'au moment où j'utilise la fonction ZpArchive de la librairie zip32.dll, alors là j'ai un code retour 18...

J'ai recherché et je n'ai rien trouvé comme renseignement sur ce code.

Est-ce que quelqu'un aurai une précision sur cette dll où une idée pour compresser un fichier de plus de 2 Go ?

Merci d'avance.

Coin.

[Delphi-ne]

J'avais acheté une DLL qui permettait de faire cela.
Elle a l'avantage d'être gratuite pour une période d'essai

[Coin]

Bonjour,

C'étais quoi cette dll, tu as une précision à me donner.

Merci d'avance.

Coin.

[Phifi]

Salut,

Je ne suis pas sûr que cela te convienne mais j'utilise 7-zip que j'intègre dans mon déploiement et que je pilote ensuite en mode de commande. Il est bien documenté et très puissant. Je peux te mettre un petit exemple si tu te lances sur cette solution.

[Coin]

Salut Phifi,

Je veux bien un exemple, pour voir ce que c'est, ainsi que les différences avec le zip traditionnel.

Tu crois qu'il peut s'attaquer à des fichiers de plus de 2 Go ?

Merci d'avance.

Coin.

[Phifi]

Fonctions de compression et de décompression, l'utilitaire 7-Zip doit être préalablement installé mais il existe un .msi à intégrer à ton package. J'ai testé avec un fichier > 2Go, ça fonctionne.

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Private Function CompressZIP(ByVal Source As String, Destination As String) As Boolean
    Dim rslt As Boolean, destzip As String, cmd7Zip As String, noerr As Long
    '
    '/ si l'exécutable 7zip existe bien
    ' cf 7-zip.chm pour détails des lignes de commande
    ' cldir est une classe me servant à répertorier tous les chemins que j'utilise dans mon appli, lus depuis un fichier .ini
    If Dir(Trim$(cldir.Dir7zip) & "7z.exe", vbNormal) <> "" Then
        cmd7Zip = Trim$(cldir.Dir7zip) & "7z.exe a -tzip " & Chr(34) & Trim$(Destination) & Chr(34) & " " & Chr(34) & Trim$(Source) & Chr(34)
        ' la fonction GetExitCode interprète ta ligne de commande et te renvoie 
        ' le code erreur éventuel une fois le traitement terminé
        noerr = GetExitCode(cmd7Zip, vbMinimizedFocus)
        '
        If noerr > 0 Then
            LogEvents "Impossible de compresser le fichier " & Chr(34) & Trim$(Source) & Chr(34)  & " : " & GetValueError(noerr)
            CompressZIP = False
        Else
            CompressZIP = True
        End If
    Else
        LogEvents "ERREUR : Compresseur 7zip non installé"
        CompressZIP = False
    End If
    '
    Exit Function
    '
ErrorHandler:
    CompressZIP = False
    MsgBox Err. Number & " " & Err.Description
    'LogEvents "ERREUR : " & Err.Number & " " & Err.Description
    '
End Function
 
Private Function DeCompressZIP(ByVal Source As String, Destination As String) As Boolean
    Dim rslt As Boolean, cmd7Zip As String, noerr As Long
    '
    '/ si l'exécutable 7zip existe bien
    ' cf 7-zip.chm pour détails des lignes de commande
    If Dir(Trim$(cldir.Dir7zip) & "7z.exe", vbNormal) <> "" Then
        '/ 7z x "archive.zip" -o"c:\soft" *.* -r -y
        cmd7Zip = Trim$(cldir.Dir7zip) & "7z.exe x " & Chr(34) & Trim$(Source) & Chr(34) & " -o" & Chr(34) & Trim$(Destination) & Chr(34) & " *.* -r -y"
        noerr = GetExitCode(cmd7Zip , vbMinimizedFocus)
        '
        If noerr > 0 Then '/ erreur de décompression
            LogEvents "Impossible de décompresser le fichier " & Chr(34) & Trim$(Source) & Chr(34) & " : " & GetValueError(noerr)
            DeCompressZIP = False
        Else
            DeCompressZIP = True
        End If
    Else
        LogEvents "ERREUR : Compresseur 7zip non installé"
        DeCompressZIP = False
    End If
    '
    Exit Function
    '
ErrorHandler:
    DeCompressZIP = False
    MsgBox Err. Number & " " & Err.Description
    'LogEvents "ERREUR : " & Err.Description
 
End Function
 
Private Function GetValueError(ByVal noerr As Long) As String
    ' Erreurs répertoriés dans la doc 7-Zip
    Select Case noerr
        Case 1
            GetValueError = "Warning (Non fatal error(s))"
        Case 2
            GetValueError = "Fatal error"
        Case 7
            GetValueError = "Command line error"
        Case 8
            GetValueError = "Not enough memory for operation"
        Case 255
            GetValueError = "User stopped the process"
        Case Else
            GetValueError = "Erreur inconnue"
    End Select
    '
End Function

Et la fonction GetExitCode dans un module (très pratique, toute mes commandes dos passent par là, dump MySQL par exemple et autres utilitaires DOS). Désolé pour le copyright, je ne devrais pas publier ce code. Si un modérateur estime qu'il doit être enlevé, je le ferai.

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
49
50
51
52
53
54
55
Option Explicit
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Private Declare Function OpenProcess Lib "kernel32" _
  (ByVal dwDesiredAccess As Long, _
   ByVal bInheritHandle As Long, _
   ByVal dwProcessId As Long) As Long
 
Private Declare Function GetExitCodeProcess Lib "kernel32" _
  (ByVal hProcess As Long, lpExitCode As Long) As Long
 
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long
 
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STATUS_PENDING = &H103&
 
Public Function GetExitCode(cmdline As String, WindowStyle As VbAppWinStyle) As Long
 
    Dim hProcess As Long
    Dim ProcessId As Long
    Dim exitCode As Long
    '
    On Error GoTo Errshell
    '
    ProcessId = Shell(cmdline, WindowStyle)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId)
    '
    Do
        Call GetExitCodeProcess(hProcess, exitCode)
        DoEvents
 
    Loop While exitCode = STATUS_PENDING
    '
    GetExitCode = exitCode
    '
    CloseHandle hProcess
    '
    Exit Function
    '
Errshell:
    MsgBox Error(Err), 16, "Erreur"
    Exit Function
    '
End Function