PureBasic Forums - English

Posted: **Sat Apr 01, 2006 9:31 pm**

I needed this for SpeedSetup 1.4 and maybe it will be usefull for somebody

. If anybody makes a better version, please post it here if you want to share it.

[Edit]
Optimized it a little bit and fixed some bugs.

It has these 2 functions:PackDir,UnPackDir

The Packer

Code: Select all


Global Dim List.s(100000)
Global Dim Limp.s(100000)
Global Dim Bizkit.s(100000)

Global index1:index1=0
Global index2:index2=0
Global index3:index3=0

Procedure FillArray(EntryPath.s,oldpath.s)

  If Right(EntryPath.s,1)<>"\":EntryPath + "\":EndIf
  UsedDirectory = ExamineDirectory(#PB_Any, EntryPath, "*.*")
  While NextDirectoryEntry(UsedDirectory)
    EntryType.l = DirectoryEntryType(UsedDirectory)
    EntryName.s = DirectoryEntryName(UsedDirectory)
    If EntryName = "." Or EntryName = ".."
     Continue
    EndIf
    If EntryType = #PB_DirectoryEntry_File
     TheFile.s = RemoveString(EntryPath + EntryName,oldpath.s)
     Limp(index1)=Thefile.s
     index1=index1+1
     List.s(index3)=EntryPath+EntryName
     index3=index3+1
    EndIf
    If EntryType = #PB_DirectoryEntry_Directory
     FillArray(EntryPath + EntryName,oldpath.s)
     Bizkit.s(index2)=RemoveString(EntryPath+EntryName,oldpath.s)
     index2=index2+1
    EndIf
  Wend: FinishDirectory(UsedDirectory)
  ProcedureReturn 1
EndProcedure

Procedure PackFolder(folder.s,pack.s,level)

 If Right(folder.s,1)<>"\":folder.s+"\":EndIf
 If FillArray(folder.s,folder.s)=1
 
 CreateFile(0,GetTemporaryDirectory()+"filelist.tmp")
 WriteStringN(0,Str(index1))
 For packn = 1 To index1
  If Limp(packn-1) <> ""
   WriteStringN(0,Limp(packn-1))
  EndIf
 Next packn
 CloseFile(0)
 
 CreateFile(0,GetTemporaryDirectory()+"dirlist.tmp")
 For packn = 1 To index2
  If Bizkit(packn-1) <> ""
   WriteStringN(0,Bizkit(packn-1))
  EndIf
 Next packn
 CloseFile(0)
 
 CreatePack(pack.s)
  AddPackFile(GetTemporaryDirectory()+"filelist.tmp",9)
  AddPackFile(GetTemporaryDirectory()+"dirlist.tmp",9)
  For add = 1 To index1
   If List(add-1) <> ""
    AddPackFile(List(add-1),level)
   EndIf
  Next add
 ClosePack()
 DeleteFile(GetTemporaryDirectory()+"filelist.tmp")
 DeleteFile(GetTemporaryDirectory()+"dirlist.tmp")
 EndIf
 
EndProcedure

The dePacker

Code: Select all


Global Dim Limp.s(100000)
Global Dim Bizkit.s(100000)

Global index1:index1=0
Global index2:index2=0

Procedure.s MakeDirectory(filestring.s)
  filename.s  = GetFilePart(filestring)
  directory.s = GetPathPart(filestring)
  drivename.s = Left(directory, 3)
  directory.s = Mid(directory, 4, Len(directory) - 3)
  make.s      = drivename
  While FindString(directory,"\", 1) <> 0
    position = FindString(directory,"\", 1)
    temp.s = Left(directory, position -1)
    directory = Mid(directory, position + 1, Len(directory) - position)
    make + temp + "\"
    CreateDirectory(make)
  Wend
  ProcedureReturn make
EndProcedure

Procedure dePackFolder(pack.s,folder.s)

 If Right(folder.s,1)<>"\":folder.s+"\":EndIf
 
 CreateDirectory(folder)
 
 OpenPack(pack.s)
   If CreateFile(0,GetTemporaryDirectory()+"filelist.tmp")
    *File=NextPackFile()
    Size=PackFileSize()
    WriteData(0,*File,Size)
    CloseFile(0) 
   EndIf
   If CreateFile(0,GetTemporaryDirectory()+"dirlist.tmp")
    *File=NextPackFile()
    Size=PackFileSize()
    WriteData(0,*File,Size)
    CloseFile(0) 
   EndIf
   If ReadFile(0,GetTemporaryDirectory()+"dirlist.tmp")
    While Not Eof(0)
     CreateDirectory(folder+ReadString(0))
    Wend
    CloseFile(0)
   EndIf
   If ReadFile(0,GetTemporaryDirectory()+"filelist.tmp")
    nr = Val(ReadString(0))
    For index1 = 1 To nr
     file.s = folder+ReadString(0)
     Debug "Extracting: "+file
     If CreateFile(1,file)
      *File=NextPackFile()
      Size=PackFileSize()
      WriteData(1,*File,Size)
      CloseFile(1) 
     EndIf
    Next index1
    CloseFile(0)
   EndIf
   
EndProcedure

Posted: **Thu Oct 09, 2008 3:12 pm**

Inf0: I thought there was a sample of how to use this code already...

Posted: **Thu Oct 09, 2008 7:59 pm**

I think this is the old (first) code. There is a newer post here that has a small demo at the end

.

http://www.purebasic.fr/english/viewtopic.php?t=30353

Before using the code though you should add some small error checking to see if anything fails, it seems that some files can't be compressed by JCalg1 (PB's algo).

Lemme know if you need any help with it.

Posted: **Fri Oct 10, 2008 1:37 am**

You said it... I can't even use the PB Zip library with my program... somewhere there is a conflict... It won't load the images if I use it no matter where the instruction to unzip is located...

I had hopes about PAK... but my OGG files just dissappear!

Posted: **Fri Oct 10, 2008 2:05 am**

You said it... I can't even use the PB Zip library with my program... somewhere there is a conflict... It won't load the images if I use it no matter where the instruction to unzip is located...

Ah I know about that one. Since PNG is based on ZLib, if you use the decoder and Zlib for compression you can't compile. I have no idea if there is a way around that...

I had hopes about PAK... but my OGG files just dissappear!

That code i pointed you to deletes your files? If it does that is really strange :/.

PureBasic Forums - English

[PB4.0] (de)Compressing full folders

[PB4.0] (de)Compressing full folders