PureBasic

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

Packer v3.94 OK v4.0 KO

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

Page 1 sur 1

Packer v3.94 OK v4.0 KO

Publié : jeu. 28/sept./2006 17:57
par Kwai chang caine
Bonjour a tous,

Voila j'ai trouvé un super code de ASZID v3.94 pour un packer de repertoire sur le forum anglais :

Code : Tout sélectionner

; Aszid's Packer v 0.9 
; 
;- Constants 
; 
#Main = 0 
#Status = 0 
#Pack = 1 
#Quit = 2 
#UnPack = 3 
#Progressbar = 4 
#Packfn = 5 
#Gadget_6 = 6 
#Pfname = 7 
#gadget_8 = 8 
#Comp = 9 

;- Arrays 
; 
Dim Dirlist$(10000) 
Dim Filelist$(10000) 
Dim Filecnt(10000) 

;- Global Variables 
; 
Global curfile$ 
Global prog.f 
Global Filelist$ 
Global Dirlist$ 
Global FileCnt 
Global Stepnum 
Global filenum 
Global dirnum 
Global fsz.f 
Global comp 
Global runone 
Global rootlen 

Procedure Open_Main() 
  If OpenWindow(#Main, 216, 0, 270, 225, #PB_Window_TitleBar , "Packer") 
    If CreateGadgetList(WindowID()) 
      ListViewGadget(#Status, 10, 10, 230, 110) 
      ButtonGadget(#Pack, 10, 150, 70, 20, "Pack") 
      ButtonGadget(#Quit, 180, 150, 60, 20, "Quit") 
      ButtonGadget(#UnPack, 90, 150, 80, 20, "UnPack") 
      ProgressBarGadget(#Progressbar, 10, 125, 230, 15, 0, 100, #PB_ProgressBar_Smooth) 
      StringGadget(#Packfn, 100, 175, 140, 20, "") 
      TextGadget(#Gadget_6, 10, 175, 85, 15, "Pack Filename:") 
      StringGadget(#Pfname, 100, 200, 140, 20, "") 
      TextGadget(#gadget_8, 10, 200, 80, 15, "Pack Folder:") 
      TrackBarGadget(#Comp, 245, 10, 20, 210, 0, 9, #PB_TrackBar_Ticks | #PB_TrackBar_Vertical) 
    EndIf 
  EndIf 
EndProcedure 

Procedure AddStep(StepText$) 
  AddGadgetItem(#Status, -1, StepText$) 
  SetGadgetState(#Status, Stepnum) 
  Stepnum = Stepnum + 1 
EndProcedure 

Procedure GetList(root$, Start) 
If runone = 0 
  filenum = 0 
  dirnum = 0 
  rootlen = Len(root$) 
  runone = 1 
EndIf 
  If ExamineDirectory(Start, root$, "") 
    Repeat 
      Type = NextDirectoryEntry() 
        If Type = 2 
          If DirectoryEntryName() <> "." And DirectoryEntryName() <> ".." 
            dirnum = dirnum + 1 
            If root$ = "" 
              Dirlist$(dirnum) = DirectoryEntryName() + "\" 
              GetList(Dirlist$(dirnum), Start+1) 
            Else 
              Dirlist$(dirnum) = root$ + DirectoryEntryName() + "\" 
              GetList(Dirlist$(dirnum), Start+1) 
            EndIf 
            UseDirectory(Start) 
          EndIf 
        Else 
          If Type = 1 
            filecnt(Start) = filecnt(Start) + 1 
            filenum = filenum + 1 
            Filelist$(filenum) = root$ + DirectoryEntryName() 
          EndIf 
        EndIf 
    Until Type = 0 
  EndIf 
EndProcedure 

Procedure stbar(spos, dpos) 
  prog = spos*100/fsz 
  SetGadgetState(#Progressbar, prog) 
  EventID=WindowEvent() 
  If EventID = #PB_EventGadget 
    Select EventGadgetID() 
    Case #Quit 
      a = ClosePack() 
      addstep("Cancelling: " + curfile$) 
      a = DeleteFile(curfile$) 
      End 
    EndSelect 
  EndIf 
    ProcedureReturn 1 
EndProcedure 

Procedure makepack(packname$, folder$) 
  Compl = GetGadgetState(#Comp) 
  curfile$ = packname$ 

  If Right(folder$, 1) <> "\" 
    folder$ = folder$ + "\" 
  EndIf 

  GetList(folder$, 1) 
  b = CreateFile(1,"index.dir") 
  WriteStringN(Str(dirnum)) 

  For a = 1 To dirnum 
    WriteStringN(Right(dirlist$(a),Len(dirlist$(a)) - rootlen)) 
    WriteStringN(Str(filecnt(a))) 
  Next a 

  CloseFile(1) 

  b = CreateFile(1,"index.fil") 
  WriteStringN(Str(filenum)) 

  For a = 1 To filenum 
    WriteStringN(Right(Filelist$(a),Len(Filelist$(a)) - rootlen)) 
  Next a 

  CloseFile(1) 
  
  ;PackerCallback(@stbar()) 

  b = CreatePack(packname$) 
  AddStep("adding: index.dir") 
  b = AddPackFile("index.dir", Compl) 
  AddStep("adding: index.fil") 
  b = AddPackFile("index.fil", Compl) 

  b = DeleteFile("index.dir") 
  b = DeleteFile("index.fil") 

  For a = 1 To filenum 
    fsz = FileSize(Filelist$(a)) 
    AddStep("adding: " + Filelist$(a)) 
    b = AddPackFile(Filelist$(a),Compl) 
  Next a 
  
  AddStep("Done!") 
  b = ClosePack() 
EndProcedure 

Procedure UnPack(PackName$, dest$) 
  If Right(dest$,1) <> "\" 
    dest$ = dest$ + "\" 
  EndIf 
  If dest$ = "\" 
    dest$ = "" 
  EndIf 

  c = OpenPack(PackName$) 

  memloca = NextPackFile() 
  FileLength = PackFileSize() 
  b = CreateFile(1,"index.dir") 
  WriteData(memloca,FileLength) 
  CloseFile(1) 

  memloca = NextPackFile() 
  FileLength = PackFileSize() 
  b = CreateFile(1,"index.fil") 
  WriteData(memloca,FileLength) 
  CloseFile(1) 

  b = OpenFile(1,"index.dir") 
  dirnum = Val(ReadString()) 

  For a = 1 To dirnum 
    dirlist$(a) = ReadString() 
    filecnt(a) = Val(ReadString()) 
  Next a 

  CloseFile(1) 
  b = DeleteFile("index.dir") 

  b = OpenFile(1,"index.fil") 
  filenum = Val(ReadString()) 

  For a = 1 To filenum 
    filelist$(a) = ReadString() 
  Next a 

  CloseFile(1) 
  b = DeleteFile("index.fil") 

; make dirs 

  b = CreateDirectory(dest$) 
  For a = 1 To dirnum 
    b = CreateDirectory(dest$ + Dirlist$(a)) 
  Next a 
  
; decompress files to the proper dirs 

  For a = 1 To filenum 
    Addstep("Decompressing: " + Filelist$(a)) 
    memloca = NextPackFile() 
    FileLength = PackFileSize() 
    b = CreateFile(1,dest$ + Filelist$(a)) 
    WriteData(memloca,FileLength) 
    CloseFile(1) 
  Next a 
  b = ClosePack() 

EndProcedure 

;- Main Program 
; 

Open_Main() 

SetGadgetState(#Comp,9) 

Repeat 
  Event = WaitWindowEvent() 
  If Event = #PB_EventMenu 
    Select EventMenuID() 
    EndSelect 
  EndIf 
  If Event = #PB_EventGadget 
    Select EventGadgetID() 
      Case #Pack 
        packfil$ = "c:\Eric.pack" ;GetGadgetText(#Packfn) 
        If UCase(Left(packfil$,5)) <> ".PACK" 
          packfil$ = packfil$ + ".pack" 
        EndIf 
        pfolder$ = "E:\DONNEES\ksa8d4\MES DOCUMENTS\#  PROGRAM FILES #\tgclic" ;GetGadgetText(#Pfname) 
        makepack(packfil$,pfolder$) 
        runone = 0 
      Case #UnPack 
        packfil$ = GetGadgetText(#Packfn) 
        If UCase(Left(packfil$,5)) <> ".PACK" 
          packfil$ = packfil$ + ".pack" 
        EndIf 
        pfolder$ = GetGadgetText(#Pfname) 
        Unpack(packfil$,pfolder$) 
        AddStep("Done!") 
      Case #Quit 
        CloseWindow(#Main) 
        End 
    EndSelect 
  EndIf 
Until Event = #PB_EventCloseWindow 
End
D'habitude en le passant dans le mixer de PbSourceConverter y'en ressort un code tout neuf V4.0 et qui marche a peu pres, mais là ......ça marche pas.

J'ai le message invalid memory acces sur le endprocedure de makepack(packname$, folder$). J'ai cherché, et evidement pas trouvé puisque je vous derange à nouveau.

Voici la V4.0

Code : Tout sélectionner

; Converted by PBSourceConverter on 28.09.2006 / 17:40
; Aszid's Packer v 0.9 
; 
;- Constants 
; 
#Main = 0 
#Status = 0 
#Pack = 1 
#Quit = 2 
#UnPack = 3 
#Progressbar = 4 
#Packfn = 5 
#Gadget_6 = 6 
#Pfname = 7 
#gadget_8 = 8 
#Comp = 9 

;- Arrays 
; 
Global Dim Dirlist$(10000) 
Global Dim Filelist$(10000) 
Global Dim Filecnt(10000) 

;- Global Variables 
; 
Global curfile$ 
Global prog.f 
Global Filelist$ 
Global Dirlist$ 
Global FileCnt 
Global Stepnum 
Global filenum 
Global dirnum 
Global fsz.f 
Global comp 
Global runone 
Global rootlen 

Procedure Open_Main() 
  If OpenWindow(#Main, 216, 0, 270, 225, "Packer", #PB_Window_TitleBar ) 
    If CreateGadgetList(WindowID(#Main)) 
      ListViewGadget(#Status, 10, 10, 230, 110) 
      ButtonGadget(#Pack, 10, 150, 70, 20, "Pack") 
      ButtonGadget(#Quit, 180, 150, 60, 20, "Quit") 
      ButtonGadget(#UnPack, 90, 150, 80, 20, "UnPack") 
      ProgressBarGadget(#Progressbar, 10, 125, 230, 15, 0, 100, #PB_ProgressBar_Smooth) 
      StringGadget(#Packfn, 100, 175, 140, 20, "") 
      TextGadget(#Gadget_6, 10, 175, 85, 15, "Pack Filename:") 
      StringGadget(#Pfname, 100, 200, 140, 20, "") 
      TextGadget(#gadget_8, 10, 200, 80, 15, "Pack Folder:") 
      TrackBarGadget(#Comp, 245, 10, 20, 210, 0, 9, #PB_TrackBar_Ticks | #PB_TrackBar_Vertical) 
    EndIf 
  EndIf 
EndProcedure 

Procedure AddStep(StepText$) 
  AddGadgetItem(#Status, -1, StepText$) 
  SetGadgetState(#Status, Stepnum) 
  Stepnum = Stepnum + 1 
EndProcedure 

Procedure GetList(root$, Start) 
If runone = 0 
  filenum = 0 
  dirnum = 0 
  rootlen = Len(root$) 
  runone = 1 
EndIf 
  If ExamineDirectory(Start, root$, "") 
    Repeat 
      Type = NextDirectoryEntry(Start) 
        If Type = 2 
          If DirectoryEntryName(Start) <> "." And DirectoryEntryName(Start) <> ".." 
            dirnum = dirnum + 1 
            If root$ = "" 
              Dirlist$(dirnum) = DirectoryEntryName(Start) + "\" 
              GetList(Dirlist$(dirnum), Start+1) 
            Else 
              Dirlist$(dirnum) = root$ + DirectoryEntryName(Start) + "\" 
              GetList(Dirlist$(dirnum), Start+1) 
            EndIf 
          EndIf 
        Else 
          If Type = 1 
            filecnt(Start) = filecnt(Start) + 1 
            filenum = filenum + 1 
            Filelist$(filenum) = root$ + DirectoryEntryName(Start) 
          EndIf 
        EndIf 
    Until Type = 0 
  EndIf 
EndProcedure 

Procedure stbar(spos, dpos) 
  prog = spos*100/fsz 
  SetGadgetState(#Progressbar, prog) 
  EventID=WindowEvent() 
  If EventID = #PB_Event_Gadget 
    Select EventGadget() 
    Case #Quit 
      a = ClosePack() 
      addstep("Cancelling: " + curfile$) 
      a = DeleteFile(curfile$) 
      End 
    EndSelect 
  EndIf 
    ProcedureReturn 1 
EndProcedure 

Procedure makepack(packname$, folder$) 
  Compl = GetGadgetState(#Comp) 
  curfile$ = packname$ 

  If Right(folder$, 1) <> "\" 
    folder$ = folder$ + "\" 
  EndIf 

  GetList(folder$, 1) 
  b = CreateFile(1,"index.dir") 
  WriteStringN(1,Str(dirnum)) 

  For a = 1 To dirnum 
    WriteStringN(1,Right(dirlist$(a),Len(dirlist$(a)) - rootlen)) 
    WriteStringN(1,Str(filecnt(a))) 
  Next a 

  CloseFile(1) 

  b = CreateFile(1,"index.fil") 
  WriteStringN(1,Str(filenum)) 

  For a = 1 To filenum 
    WriteStringN(1,Right(Filelist$(a),Len(Filelist$(a)) - rootlen)) 
  Next a 

  CloseFile(1) 
  
  PackerCallback(@stbar()) 

  b = CreatePack(packname$) 
  AddStep("adding: index.dir") 
  b = AddPackFile("index.dir", Compl) 
  AddStep("adding: index.fil") 
  b = AddPackFile("index.fil", Compl) 

  b = DeleteFile("index.dir") 
  b = DeleteFile("index.fil") 

  For a = 1 To filenum 
    fsz = FileSize(Filelist$(a)) 
    AddStep("adding: " + Filelist$(a)) 
    b = AddPackFile(Filelist$(a),Compl) 
  Next a 
  
  AddStep("Done!") 
  b = ClosePack() 
EndProcedure 

Procedure UnPack(PackName$, dest$) 
  If Right(dest$,1) <> "\" 
    dest$ = dest$ + "\" 
  EndIf 
  If dest$ = "\" 
    dest$ = "" 
  EndIf 

  c = OpenPack(PackName$) 

  memloca = NextPackFile() 
  FileLength = PackFileSize() 
  b = CreateFile(1,"index.dir") 
  WriteData(1,memloca,FileLength) 
  CloseFile(1) 

  memloca = NextPackFile() 
  FileLength = PackFileSize() 
  b = CreateFile(1,"index.fil") 
  WriteData(1,memloca,FileLength) 
  CloseFile(1) 

  b = OpenFile(1,"index.dir") 
  dirnum = Val(ReadString(1)) 

  For a = 1 To dirnum 
    dirlist$(a) = ReadString(1) 
    filecnt(a) = Val(ReadString(1)) 
  Next a 

  CloseFile(1) 
  b = DeleteFile("index.dir") 

  b = OpenFile(1,"index.fil") 
  filenum = Val(ReadString(1)) 

  For a = 1 To filenum 
    filelist$(a) = ReadString(1) 
  Next a 

  CloseFile(1) 
  b = DeleteFile("index.fil") 

; make dirs 

  b = CreateDirectory(dest$) 
  For a = 1 To dirnum 
    b = CreateDirectory(dest$ + Dirlist$(a)) 
  Next a 
  
; decompress files to the proper dirs 

  For a = 1 To filenum 
    Addstep("Decompressing: " + Filelist$(a)) 
    memloca = NextPackFile() 
    FileLength = PackFileSize() 
    b = CreateFile(1,dest$ + Filelist$(a)) 
    WriteData(1,memloca,FileLength) 
    CloseFile(1) 
  Next a 
  b = ClosePack() 

EndProcedure 

;- Main Program 
; 

Open_Main() 

SetGadgetState(#Comp,9) 

Repeat 
  Event = WaitWindowEvent() 
  If Event = #PB_Event_Menu 
    Select EventMenu() 
    EndSelect 
  EndIf 
  If Event = #PB_Event_Gadget 
    Select EventGadget() 
      Case #Pack 
        packfil$ = GetGadgetText(#Packfn) 
        If UCase(Left(packfil$,5)) <> ".PACK" 
          packfil$ = packfil$ + ".pack" 
        EndIf 
        pfolder$ = GetGadgetText(#Pfname) 
        makepack(packfil$,pfolder$) 
        runone = 0 
      Case #UnPack 
        packfil$ = GetGadgetText(#Packfn) 
        If UCase(Left(packfil$,5)) <> ".PACK" 
          packfil$ = packfil$ + ".pack" 
        EndIf 
        pfolder$ = GetGadgetText(#Pfname) 
        Unpack(packfil$,pfolder$) 
        AddStep("Done!") 
      Case #Quit 
        CloseWindow(#Main) 
        End 
    EndSelect 
  EndIf 
Until Event = #PB_Event_CloseWindow 
End
Y aurait il une ame charitable pour corriger ce que le bon logiciel PbSourceConverter n'a pas vu.
Normal l'homme sera toujours meilleur que la machine.....

Bonne journée

Publié : jeu. 28/sept./2006 18:43
par Droopy
quelqu'un l'à déjà convertit en v4 sur le forum US
http://www.thorsten-hoeppner.de/download/PackerExV4.zip

Publié : ven. 29/sept./2006 22:48
par Kwai chang caine
Je te remercie droopy

Je ne sais pas si c'est exactement le meme code, mais il doit y avoir de quoi creuser dedant.

Je l'avais trouvé; mais n'avais pas pensé a essayer seulement un de ses modules.

Le code que j'ai posté me paraissait assez simple, si seulement il avait marché en v4 .....

Bon, je te remercie, faute de plus simple, je vais essayé de trouver avec cet exemple.

Bonne soiree
Fuseau horaire sur UTC+01:00
Page 1 sur 1

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

Traduction française officielle © Qiaeru