PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

packer

https://www.purebasic.fr/english/viewtopic.php?t=6465

Page 1 of 1

packer

Posted: Tue Jun 10, 2003 12:22 pm
by iancrt
hi,

Ive been trying to use the packer library to create a single compressed file from multiple files. this part was easy enough.
Now I need to unpack the files were I'm now stuck. 3 questions to start with...
1. Is the original filename stored in the pack file? (if not can it be added)
2. If so how can i return this?
3. The following code compiles but just does not work, what am I missing?

Code: Select all

; unpack test
; iant 2003
OpenConsole()
    If OpenPack("MYPACKEDFILE")
       memloc.l = NextPackFile
       UnpackedFileSize.l = PackFileSize()
       OpenFile(#1,"MYUNPACKEDFILE")
          WriteData(*memloc,UnpackedFileSize)
       CloseFile(#1)
    Else
      PrintN("CRAP, CANT FIND FILE")
    EndIf
CloseConsole()
End
(actually I have just had to re-type this into notepad cos I'm at work and forgot to put the file onto my CVS - so I have no idea if it does compile in this state)
I just seen an old post about RAR examples on RMP - gonna have a look into that as a possible alternative....
..and If filenames are not included I guess I could create my own TOC section prefixed onto the packed file......damn, going to have to stop solving my own questions while writing these posts...

Anyhow, my code problem is still there
Any other comments suggestions very welcome.

Posted: Tue Jun 10, 2003 1:30 pm
by Fred
1) it lacks the () at the end of NextPackFile
2) *memloc and memloc isn't the same in PB (one is pointer, the other not). Just use memloc, it will work.

I hope it helps..

Packer - Update (with working solution)

Posted: Wed Jun 11, 2003 1:41 am
by iancrt
Thanks Fred,

It took a while but I think I have finally got my head around this * and @ lark. Decided to put the filename before the file as a seperate packed entity.

I have now a working test modules for both packing multiple files (with filenames) and Unpacking again.

Only limitations is they will only work on full dos (8.3) filenames (cos this all what I need it to do - but should be quite easy to make win95 compliant) and I dont advise trying to run it across directories. Some strange things with the way pb console apps handle paths (they keep changing, so you have to set them all at runtime-start-up) for this test I only set WORKINGFOLDER which tells me where the command prompt is.

Code is here, if of use to anyone

Code: Select all

;Packing Multiple Files Test Code
;Ian Thewlis 2k3
;example use
;PACK MYPACKFILE *.pb 9
;PACK PACKED_FILE FILES_TO_PACK [COMPRESSION_LEVEL]

OpenConsole()
    Declare.s CurrentPath()

    ;set working folder or it will be lost
    Global WORKINGFOLDER.s 
    WORKINGFOLDER = CurrentPath()
    
    ;get and verify parameters
    outfile.s = ProgramParameter()
    If outfile=""
        PrintN("Usage is PACK OUTFILE INFILE [COMPRESSION_LEVEL]")
        CloseConsole()
        End
    EndIf
    infiles.s = ProgramParameter()
    If outfile=""
        PrintN("Usage is PACK OUTFILE INFILE [COMPRESSION_LEVEL]")
        CloseConsole()
        End
    EndIf
    complev.w = Val(ProgramParameter())
    If outfile=""
        PrintN("No Compression Specified, using 0")
        complev=0
    EndIf
    
    ;Create PAckfile
    If CreatePack(WORKINGFOLDER + OutFile)
        ExamineDirectory(#1,WORKINGFOLDER,infiles)
        isvalidfile.w=NextDirectoryEntry()
        While isvalidfile <> 0
            Select isvalidfile
                Case 1
                    CurrentFile.s=DirectoryEntryName()
                    *pointer = @CurrentFile
                    flnm.s=PeekS(*pointer,12)
                    AddPackMemory(*pointer,12,9)                        
                    If AddPackFile(WORKINGFOLDER + CurrentFile,complev)
                        PrintN("Added " + CurrentFile)
                    Else
                        PrintN("Cannot Include " + CurrentFile)
                        PrintN("")
                        PrintN("Press any key To Exit")
                        Inkey()
                        CloseConsole()
                        End
                    EndIf
                Case 2
                    ;do nothing
                Default
                    PrintN("Unexpected result; aborting")
                    CloseConsole()
                    End
             EndSelect
             isvalidfile=NextDirectoryEntry()
        Wend
    Else
        PrintN("Cannot Create " + OutFile)
        CloseConsole()
        End        
    EndIf
    ClosePack()
    PrintN("Completed Successfully")

CloseConsole()

Procedure.s CurrentPath()  ; returns current directory
  curdir.s=Space(1000) 
  GetCurrentDirectory_(1000,@curdir) 
  If Right(curdir,1)<>"\" 
    curdir+"\" 
  EndIf
  ProcedureReturn Curdir
EndProcedure
; ExecutableFormat=Console
; FirstLine=1
; EnableAsm
; EnableNT4
; EnableXP
; Executable=C:\WORKING\PUREBASIC_includes\PACK.exe
; EOF

Code: Select all

;UnPacking Multiple files test code
;Ian Thewlis 2K3
;Example Usage
;UNPACK MYPACKEDFILE
;UNPACK PACKED_FILE

OpenConsole()
    Declare.s CurrentPath()

    ;set working folder or it will be lost
    Global WORKINGFOLDER.s 
    WORKINGFOLDER = CurrentPath()
    
    outfile.s = ProgramParameter()
    OpenPack(WORKINGFOLDER + OutFile)
    Repeat
        *memloc=NextPackFile()
        size=PackFileSize()
        newfile.s=PeekS(*memloc,12)
        PrintN("Extracting " + newfile)
        OpenFile(#1,WORKINGFOLDER + newfile)
        memloc.l=NextPackFile()
        size=PackFileSize()
        WriteData(memloc,size)
        CloseFile(#1)
    Until memloc=0  ;probably not the cleanest exit
CloseConsole()
End

Procedure.s CurrentPath()  ; returns current directory
  curdir.s=Space(1000) 
  GetCurrentDirectory_(1000,@curdir) 
  If Right(curdir,1)<>"\" 
    curdir+"\" 
  EndIf
  ProcedureReturn Curdir
EndProcedure
; ExecutableFormat=Console
; FirstLine=1
; EnableAsm
; EnableNT4
; EnableXP
; Executable=C:\WORKING\PUREBASIC_includes\UnPack.exe
; EOF

Posted: Thu Jun 12, 2003 6:11 pm
by aszid
or you could tear apart my code.. i simply added a few small text files to my archeves that add the directory structure, as well as filenames.

check it out:
viewtopic.php?t=6042&highlight=packer

Posted: Thu Jun 12, 2003 9:14 pm
by Denis
Hi iancrt,

here are 2 procedures to pack and unpack files with their filenames without Path.

It's an example i was sending on french forum last month, so it's french commented.

The pack will be like this

1st file name, file1, 2nd file name, file2 and so one.

Thanks to Danilo wich show us the way i don't remeber when.

Code: Select all

#MB_ICONERROR  = 16 
#FicherCourant = 1 


;;================================================================================================================== 
;;================================================================================================================== 

Procedure.l Compresse(NomFichier$) 

Resultat = 1 
If CreatePack(NomFichier$);crée le le fichier qui va être compressé 

   ;tu peux choisir un ou plusieur fichiers à compresser 
   packers$ = OpenFileRequester("Choisissez le(s) fichiers a compresser","tout","*.*",0, #PB_Requester_MultiSelection) 

   If packers$                                      ; teste si la chaine existe 
      Repeat 
         Fichier$ = GetFilePart(packers$)           ; récupère seulement le nom de fichier 
         AddPackMemory(@Fichier$,Len(Fichier$)+1)   ; ajoute le nom de fichier, la zone mémoire étant la chaine Fichier$ 
                                                    ; on ajoute 1 à len(Fichier$) pour écrire le 0 qui est le caractète de fin 
                                                    ; de chaine 
         AddPackFile(packers$ ,9)                   ; rajoute la selection et niveau de compression 9 
         packers$ = NextSelectedFileName()          ; ajoute le fichier compressé 
      Until packers$ = ""                          ; on reboucle tant qu'il y a des fichiers compressés 
      ClosePack()                                   ;ferme le pack 
   Else 
    MessageRequester("Information", "Aucun fichier n'a été sélectionné", #MB_ICONERROR) 
    Resultat = 0 
   EndIf 
Else 
    Resultat = 0 
EndIf 

ProcedureReturn Resultat 

EndProcedure 


;;================================================================================================================== 
;;================================================================================================================== 

Procedure Decompresse(FichierCompresser$) 

If OpenPack(FichierCompresser$) 

;   MessageRequester("Ok","OpenPack a réussi",16)  ; on affiche que l'ouverture du fichier compressé a réussie 
   Repertoire.s = PathRequester("Ou décompresser les fichiers ?","") 
   NomFichier.s = Space(256)  ; crée la variable chaine qui récupèrera le nom de fichier courant 

   AdresseMemoire = NextPackFile()                ; On récupère le premier élément compressé, c'est-à-dire le nom du fichier 

   While AdresseMemoire                          ; on débute la boucle 
;       Debug("AdresseMemoire")                   ; la variable utilisée AdresseMemoire est partagé, tu doit utiliser 
;       Debug(AdresseMemoire )                    ; la même pour récupérer le nom de fichier et le fichier lui-même 
;       Debug("") 
      
      NomFichier = PeekS(AdresseMemoire)          ; récupère le nom de fichier en situé en mémoire 
;      Debug(NomFichier) 
  
      AdresseMemoire = NextPackFile()             ; récupère l'adresse du fichier à décompresser 

      Taille = PackFileSize()                     ; récupère la taille du fichier à décompresser 

      CreateFile(#FicherCourant,Repertoire + NomFichier)        ; on crée le fichier sur le disque avec le répertoire sélectionné 
      WriteData(AdresseMemoire ,Taille )           ; on écrit le contenu du fichier 
      CloseFile(#FicherCourant)                    ; on ferme le fichier 

      AdresseMemoire = NextPackFile()              ; on continue l'opération tant que adresseMemoire est différent de 0 
   Wend 
   ClosePack()                                     ;ferme le pack 

Else 
   MessageRequester("Erreur","OpenPack a échoué",16) 
EndIf 

EndProcedure 


;;================================================================================================================== 
;;==================================================================================================================

Denis
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited