PureBasic

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 :-)")