PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

petit dezzipeur rapide

http://forums.purebasic.com/french/viewtopic.php?t=6909

Page 1 sur 1

petit dezzipeur rapide

Publié : dim. 22/juil./2007 10:57
par supercdfr
je debute en purebasic et j'ai creer ce petit programme pour dezipper rapidement plusieurs fichiers dans un repertoire.

http://supercdfr.free.fr/zippage.exe

Publié : dim. 22/juil./2007 11:09
par Backup
attention au Exe balancé par des inconnus du Forum, (sauf le Soldat :lol:)

je vous invite a la prudence !!! :?


je ne doute pas des bonnes intentions de supercdfr, mais il y a deja eu des précédents !!

si vous testez un code venu d'un nouvel inscrit c'est a vos risque et périls !!


quand aux nouveaux ,
commencez par poster quelque codes sources,
participez au forum, que nous puissions avoir confiance en vous !!

ne cherchez pas a balancer des exécutables, directement,
car je pense que personne de sensé
n'osera les essayer vos programmes ! :)

Publié : dim. 22/juil./2007 15:27
par Anonyme
(sauf le Soldat )
lsi , sa fait un bail qu'on ne le voit plus... :?

Publié : dim. 22/juil./2007 15:39
par Backup
Cpl.Bator a écrit :
(sauf le Soldat )
lsi , sa fait un bail qu'on ne le voit plus... :?
il bosse, maintenant, a mon avis il a d'autres chats a fouetter !
peut etre passe t'il de temps en temps pour nous lire !?

d'apres ce que j'en ai compris, il passe du temps en pologne au dernieres news

et la bas , l'internet n'est peut etre pas a sa porté ! ?

ou bien il en a eu marre de nous ...(de moi ? :lol: )

Publié : dim. 22/juil./2007 15:41
par supercdfr
ok, sympa la reaction. Si vous avez un anti virus, vous pouvez le tester, ce programme n'a rien d'un virus.

Publié : dim. 22/juil./2007 15:56
par Anonyme
ok, sympa la reaction. Si vous avez un anti virus, vous pouvez le tester, ce programme n'a rien d'un virus.
Bah je trouve qu'il a une bonne réaction, car j'ai déjà été victime de cela ici même ! Et puis un virus "maison" ne sera pas détecté par un AV...
Qu'est ce qui t'empêche de posté une source ?

Publié : dim. 22/juil./2007 16:27
par Backup
supercdfr a écrit :ok, sympa la reaction. Si vous avez un anti virus, vous pouvez le tester, ce programme n'a rien d'un virus.
surtout sur un soft gérant les fichiers !!

je te fais un prg en quelques lignes qui vas effacer quelques fichiers utile a
XP, et te voila dans la galère au prochain redémarrage !!

ici on forme une petite communauté, on se connais tous assez bien, depuis plusieurs années pour certains et souvent on se fait confiance
mais comme je l'ai dit, participe au forum, poste des sources, montre nous qui tu es, tu sera le bienvenue !! :D

ensuite on te fera confiance, bref, comme lorsque tu arrive dans un nouvel endroits, ma réaction est normal, je pense !!
surtout sur l'internet, ou l'on trouve de tout ! :?

Publié : dim. 22/juil./2007 19:52
par supercdfr

Code : Tout sélectionner

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #Button_0
  #ExplorerTree_0
  #Listview_0
  #Button_1
  #String_0
  #Text_0
  #Text_1
  #String_1
  #ProgressBar_0
  #CheckBox_0
  #ProgressBar_1
  #Button_3
  #String_3
  #Frame3D_0
  #lExplorerTree_0
  #lText_0
  #lString_0
  #lButton_0
  #CheckBox_2
 EndEnumeration


Declare initialisationini()

Global listviewcompte.l
Global extention.s = "*.*"
Global extentionarchive.s = "*.*"
Global kk.l=0
Global repertoiredestination.s = "c:\", repertoiredestinationcocher.l = 0
Global unrepertoireparfichier.l = 0
Global comptecliquer.l=0
Global valeurprogression.l=0 , valeurprogressiondepart.l=0
Global nomfichier.s
Global repertoire.s = "c:\"

Global Dim hlm.l(48)

Global idimagehlm.l=0

Procedure hlm02()
hlm(0  ) = 0
hlm(1  ) = 0
hlm(2  ) = 2
hlm(3  ) = 0
hlm(4  ) = 0
hlm(5  ) = 17
hlm(6  ) = 2
hlm(7  ) = 17
hlm(8  ) = 2
hlm(9  ) = 0
hlm(10 ) = 2
hlm(11 ) = 17
hlm(12 ) = 3
hlm(13 ) = 8
hlm(14 ) = 35
hlm(15 ) = 8
hlm(16 ) = 14
hlm(17 ) = 0
hlm(18 ) = 14
hlm(19 ) = 18
hlm(20 ) = 6
hlm(21 ) = 0
hlm(22 ) = 7
hlm(23 ) = 0
hlm(24 ) = 7
hlm(25 ) = 0
hlm(26 ) = 7
hlm(27 ) = 6
hlm(28 ) = 6
hlm(29 ) = 6
hlm(30 ) = 11
hlm(31 ) = 6
hlm(32 ) = 5
hlm(33 ) = 10
hlm(34 ) = 5
hlm(35 ) = 17
hlm(36 ) = 5
hlm(37 ) = 10
hlm(38 ) = 8
hlm(39 ) = 13
hlm(40 ) = 8
hlm(41 ) = 13
hlm(42 ) = 11
hlm(43 ) = 10
hlm(44 ) = 11
hlm(45 ) = 10
hlm(46 ) = 11
hlm(47 ) = 17
EndProcedure

Procedure CallbackForTest(file.s, PerCent.f)
  d1.l=PerCent
  SetGadgetState(#ProgressBar_1,d1)
EndProcedure 

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 0, 0, 625, 512, "H.L.M.",  #PB_Window_SystemMenu | #PB_Window_TitleBar )
     If CreateGadgetList(WindowID(#Window_0))
      ExplorerTreeGadget(#ExplorerTree_0, 0, 50, 230, 360, repertoire, #PB_Explorer_NoDriveRequester | #PB_Explorer_NoFiles | #PB_Explorer_NoMyDocuments)
      ListViewGadget(#Listview_0, 240, 50, 370, 360,#PB_ListView_Multiselect)
      StringGadget(#String_0, 430, 30, 40, 20, "*.*", #PB_String_LowerCase)
      TextGadget(#Text_0, 340, 30, 90, 20, "Fichiers a afficher :", #PB_Text_Center)
      TextGadget(#Text_1, 340, 410, 90, 20, "fichiers a extraire :")
      StringGadget(#String_1, 430, 410, 40, 20, "*.*")
      ProgressBarGadget(#ProgressBar_0, 300, 480, 220, 20, 0, 100)
      CheckBoxGadget(#CheckBox_0, 0, 430, 210, 20, "rajouter nom du fichier comme repertoire")
      ProgressBarGadget(#ProgressBar_1, 300, 460, 220, 20, 0, 100, #PB_ProgressBar_Smooth)
      ButtonGadget(#Button_3, 260, 470, 20, 20, "...")
      StringGadget(#String_3, 10, 470, 250, 20, "")
      Frame3DGadget(#Frame3D_0, 0, 450, 290, 50, "Chemin d'extraction")
      CheckBoxGadget(#CheckBox_2, 0, 410, 270, 20, "Creer 1 repertoire pour chaque fichier dans l'archive")
      ButtonGadget(#Button_1, 520, 410, 100, 70, "Extraire")         
    EndIf
  EndIf



EndProcedure

Procedure infozip(fichier.s)
  rajoutdestination.s=""

  If (repertoiredestinationcocher=1)
    rajoutdestination=nomfichier
  EndIf

  myFileinfo.PureZIP_FileInfo
  PureZIP_SetProgressionCallback(@CallbackForTest())
  MyZIP.s = fichier
  For i = 0 To PureZIP_GetFileCount(MyZIP) - 1          ; tourne jusqu'a fin fichier zip  
    plusrajoutrepertoire.s = ""
    PureZIP_GetFileInfo(MyZIP,i , @myFileinfo)
    nomfichier.s = LCase(myFileinfo\FileName)

    longueurchaine.l = Len(extentionarchive)
    resultatchaine.s = Right(extentionarchive,longueurchaine-1)

    If (extentionarchive="*.*") Or (FindString(nomfichier,resultatchaine,1) >0)
      If (unrepertoireparfichier=1)
        plusrajoutrepertoire="\"+nomfichier 
      EndIf   
      PureZIP_ExtractFiles(fichier,extentionarchive,repertoiredestination+rajoutdestination+plusrajoutrepertoire,#True)
    EndIf

    SetGadgetState(#ProgressBar_0,valeurprogression + valeurprogressiondepart)
  Next
  valeurprogressiondepart=valeurprogressiondepart+ valeurprogression
  
EndProcedure

Procedure listrepertoire(nomrep.s)
  kk=kk+1
  If kk>1 
    ProcedureReturn 
  EndIf

  Directory$ = nomrep
  ClearGadgetItemList(#Listview_0)
  If ExamineDirectory(0, Directory$, extention)  
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        AddGadgetItem(#Listview_0,-1,DirectoryEntryName(0))
        listviewcompte=listviewcompte+1

      
    Wend
    FinishDirectory(0)
  EndIf
EndProcedure

Procedure extraction()
  kk=kk+1
  If kk>1 
    ProcedureReturn 
  EndIf
  cheminrepertoire.s = GetGadgetText(#ExplorerTree_0)

  For i.l = 0 To listviewcompte  
    If GetGadgetItemState(#Listview_0, i) = 1
      nomfichier = GetGadgetItemText(#Listview_0,i,0)
      infozip(cheminrepertoire + nomfichier) 
    EndIf
  Next

EndProcedure

Procedure initialisationini()
  CreateFile(0,"zippage.ini")
  WriteStringN(0,extention )
  WriteStringN(0,extentionarchive )
  WriteStringN(0,repertoiredestination )
  WriteStringN(0,repertoire )
EndProcedure

Procedure lectureini()
  extention=ReadString(0)
  extentionarchive=ReadString(0)
  repertoiredestination=ReadString(0)
  repertoire=ReadString(0)
  
EndProcedure

Procedure painturehlm()
  If CreateImage(0, 37, 20)
    If StartDrawing(ImageOutput(0))
      Box (0,0,37,20,GetSysColor_(#COLOR_MENU))      
      For i=0 To 11
        LineXY(hlm((i*4))+1,hlm((i*4)+1)+1,hlm((i*4)+2)+1,hlm((i*4)+3)+1,RGB(255,255,255))
        LineXY(hlm((i*4)),hlm((i*4)+1),hlm((i*4)+2),hlm((i*4)+3),RGB(0,0,0))
      Next 
      StopDrawing()
    EndIf
  EndIf
  CreateGadgetList(WindowID(0))
  idimagehlm=ImageGadget(0, WindowWidth(#Window_0)-39, WindowHeight(#Window_0)-22, 0, 0, ImageID(0))
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
hlm02()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; lecture fichier ini ;;;;;;;;;;;;;;;;;;;;;
If ReadFile(0, "zippage.ini")
  lectureini()
Else
  initialisationini()
EndIf
CloseFile(0)

Open_Window_0()

painturehlm()

SetGadgetText(#String_0,extention)
SetGadgetText(#String_1,extentionarchive)
SetGadgetText(#String_3,repertoiredestination)  
 
  
Repeat
  event = WaitWindowEvent()
  kk=0

    If Event = #PB_Event_Gadget
      Select EventGadget()
      
        Case idimagehlm & #PB_EventType_LeftClick
          RunProgram ("http://hlm02.com")
        
        Case #ExplorerTree_0
          repertoire = GetGadgetText(#ExplorerTree_0)
          listviewcompte=0
          listrepertoire(repertoire)
          initialisationini()
          ;Debug repertoire
          
        Case #String_0
          extention=GetGadgetText(#String_0)
          listrepertoire(repertoire)
          initialisationini()
          
        Case #String_1
          extentionarchive=GetGadgetText(#String_1)
          initialisationini()
          

        Case #CheckBox_0
          repertoiredestinationcocher=GetGadgetState(#CheckBox_0)
        
        Case #CheckBox_2
          unrepertoireparfichier=GetGadgetState(#CheckBox_2)
        
        Case #Button_1   
          comptecliquer=0
          valeurprogressiondepart=0
          For i.l = 0 To listviewcompte  
            If GetGadgetItemState(#Listview_0, i)= #PB_ListIcon_Selected
              comptecliquer=comptecliquer+1
            EndIf
          Next
          If (comptecliquer>0)
            valeurprogression = 100 / comptecliquer
          EndIf
          
          For i.l = 0 To listviewcompte  
            If GetGadgetItemState(#Listview_0, i)= #PB_ListIcon_Selected
              extraction()
              SetGadgetItemState(#Listview_0,i,0)
            EndIf
          Next
          SetGadgetState(#ProgressBar_0,0)  ;;;;; remets bar de progression a 0
          SetGadgetState(#ProgressBar_1,0)
          
        
        Case #Button_3
          chemin.s = PathRequester("Choisissez un répertoire", repertoiredestination)
          If chemin
            repertoiredestination=chemin
            SetGadgetText(#String_3,repertoiredestination)
            initialisationini()
          EndIf         
      EndSelect
    EndIf
    

Until event=#PB_Event_CloseWindow
End


; IDE Options = PureBasic v4.02 (Windows - x86)
; CursorPosition = 225
; FirstLine = 47
; Folding = A9
; UseIcon = ..\..\..\bc5\titou\Hlm.ico
; Executable = zippage2.exe
integrer purezip pour que ca fonctionne.

Publié : dim. 22/juil./2007 22:37
par Anonyme
Dobro a écrit :
supercdfr a écrit :ok, sympa la reaction. Si vous avez un anti virus, vous pouvez le tester, ce programme n'a rien d'un virus.
surtout sur un soft gérant les fichiers !!

je te fais un prg en quelques lignes qui vas effacer quelques fichiers utile a
XP, et te voila dans la galère au prochain redémarrage !!

ici on forme une petite communauté, on se connais tous assez bien, depuis plusieurs années pour certains et souvent on se fait confiance
mais comme je l'ai dit, participe au forum, poste des sources, montre nous qui tu es, tu sera le bienvenue !! :D

ensuite on te fera confiance, bref, comme lorsque tu arrive dans un nouvel endroits, ma réaction est normal, je pense !!
surtout sur l'internet, ou l'on trouve de tout ! :?
C'est vrai qu'ici l'ambience est bonne , on est une grande famille virtuelle :D
Sinon, pour en revenir au code, je ne peut pas testé, je suis sur un os qui à pour mascotte une bestiole du nord :D

Publié : dim. 22/juil./2007 23:25
par Backup
il y aura bien quelqu'un pour tester :)
perso , je n'utilise pas Purezip :)

mais ton code est une bonne idée ! :D

ps : j'espere que tu m'en veux pas trop, pour la mefiance, du debut du topic
:wink:

Publié : lun. 23/juil./2007 14:28
par Good07
Bonjour supercdfr.

Bon de toute manière le programme ne fonctionne pas:
Erreur ligne 132: "Structure not found: PureZIP_FileInfo

le listing n'est surement pas complet. :(

Publié : lun. 23/juil./2007 16:10
par gnozal
Good07 a écrit :Bonjour supercdfr.

Bon de toute manière le programme ne fonctionne pas:
Erreur ligne 132: "Structure not found: PureZIP_FileInfo

le listing n'est surement pas complet. :(
Cette structure est déclarée dans PureZIP.res (installé avec PureZIP).
Pour info :

Code : Tout sélectionner

Structure PureZIP_FileInfo
  Version.l           ; version made by
  VersionNeeded.l     ; version needed to extract
  flag.l              ; general purpose bit Flag
  CompressionMethod.l ; compression method     
  dosDate.l           ; last mod file date in Dos format
  Crc32.l             ; crc-32
  CompressedSize.l    ; compressed size
  unCompressedSize.l  ; uncompressed size
  SizeFilename.l      ; filename length
  SizeFileExtra.l     ; extra field length
  SizeFileComment.l   ; file comment length
  DiskNumStart.l      ; disk number start
  internal_fa.l       ; internal file attributes
  external_fa.l       ; external file attributes
  tmu_date.tm_date    ; file date (see tm_date structure)
  FileName.s          ; filename
EndStructure

Publié : lun. 23/juil./2007 18:12
par Good07
:oops: Ca m'apprendra à lire la prochaine fois. J'avais pas vu la dernière ligne de son post.
Merci gnozal.

Publié : ven. 19/oct./2007 17:12
par Ar-S

Code : Tout sélectionner

Procedure listrepertoire(nomrep.s)
  kk=kk+1
  If kk>1
    ProcedureReturn
  EndIf

  Directory$ = nomrep
  ClearGadgetItemList(#Listview_0)
  If ExamineDirectory(0, Directory$, extention) 
    While NextDirectoryEntry(0)
      If DirectoryEntryType(0) = #PB_DirectoryEntry_File
        AddGadgetItem(#Listview_0,-1,DirectoryEntryName(0))
        listviewcompte=listviewcompte+1

     
    Wend
    FinishDirectory(0)
  EndIf
EndProcedure
Faudrait ti pas un endif avant le wend ?

Publié : ven. 19/oct./2007 18:22
par Dr. Dri
Pour les fichiers ini tu peux regarder du côté de la lib Preference dans l'aide

Dri
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru