Petit problème avec la fonction packer

[Gillou]

je suis en train de me faire un installeur de programme et je veux intégrer une fonction de compression voila le code de compression. Il est indépendant du programme mère.

Le code

Code : Tout sélectionner

Procedure PackerProgress(SourcePosition, DestinationPosition)
  Shared FileLength 
  
  Result.f = (SourcePosition/FileLength)*100
  SetGadgetState(0, Round(Result,0))
  
  While (WindowEvent()) : Wend
  
  ProcedureReturn 1
EndProcedure

If OpenWindow(0, 100, 200, 300, 40, #PB_Window_SystemMenu, "Packer - Progress Window")

  CreateGadgetList(WindowID())
    ProgressBarGadget(0, 10, 10, 280, 20, 0, 100,#PB_ProgressBar_Smooth)
    fich$=OpenFileRequester("Choisisser un fichier à compresser", "", "*.*", 0)
  If ReadFile(0,fich$ )
    FileLength = Lof()

    *Source = AllocateMemory(FileLength)
    *Target = AllocateMemory(FileLength+8)
    If FileLength And *Source And *Target
      ReadData(*Source, FileLength)
      
      
      PackerCallback(@PackerProgress())
      
      CompressedLength = PackMemory(*Source, *Target, FileLength, 9)
      If CompressedLength
      adress$=PathRequester("Choisi le repertoire de sauvegarde",GetPathPart(fich$)+"\")
      If adress$
      CreateFile(1,adress$+Str(FileLength)+".JCG1")
      WriteData(*Target,CompressedLength)
      If CompressedLength
        
          MessageRequester("Information", "Compression terminée avec succès : "+Chr(10)+Chr(10)+"Taille à l'origine : "+Str(FileLength)+Chr(10)+"Taille actuelle : "+Str(CompressedLength), #MB_ICONINFORMATION)
        EndIf  
        Else
        MessageRequester("Erreur","Le fichier n'a pas pu être créé",#MB_ICONERROR)
        EndIf
        Else
          MessageRequester("Erreur", "Impossible de compresser le fichier", #MB_ICONERROR)
      EndIf    
      Else
        MessageRequester("Erreur", "Impossible de compresser le fichier", #MB_ICONERROR)
      EndIf 
    
    
    FreeMemory(*Source)
    FreeMemory(*Target)
    CloseFile(0)
  EndIf
  
  
EndIf
MessageRequester("Merci d'avoir essayer!","Si il marche, tu peux en faire ce que tu veux :-)")

Merci de me dire si ce code fonctionne sur votre ordinateur. Et si vous savez pourquoi il plante sur certains fichiers.

[nico]

Je pense que cette ligne "While (WindowEvent()) : Wend" dans ta procedure PackerProgress n'a rien à faire ici, tu devrait la mettre juste avant le dernier endif, ça devrait résoudre le problème.