MicroPack.pbi - pack files and dirs, with filenames

Rook Zimbabwe · Post by **Rook Zimbabwe** » Thu Mar 27, 2008 11:38 pm

Inf0byt3, How would I go about adding a procedure to PAK and unPAK a file instead of a folder?

Inf0Byt3 · Post by **Inf0Byt3** » Sun Mar 30, 2008 5:42 pm

I'll make you an example in a few minutes... Hang on.

Inf0Byt3 · Post by **Inf0Byt3** » Sun Mar 30, 2008 6:12 pm

There you go

:

Code: Select all

;With greetz to Rook from Inf0

Procedure PackFile(FilePath.s,PackPath.s,Level.l,*Callback = 0)
 ;
 If *Callback <> 0
  PackerCallback(*Callback)
 EndIf
 ;
 If FilePath = "" Or PackPath = ""
  ;
  ProcedureReturn 0
  ;
 ElseIf FileSize(FilePath) <= 0
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  FName.s = GetFilePart(FilePath)
  ;
  If CreatePack(PackPath) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = AllocateMemory(512) ;enough for the filename (i guess)
   If *FileName = 0
    ProcedureReturn 0
   Else
    PokeS(*FileName,FName,Len(FName))
    AddPackMemory(*FileName,Len(FName),0)
    If AddPackFile(FilePath,Level) = 0
     ClosePack()
     ProcedureReturn 0
    Else
     ClosePack()
     ProcedureReturn 1
    EndIf
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

Procedure UnPackFile(PackFile.s,OutPath.s)
 ;
 If PackFile = "" Or OutPath = ""
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  If Right(OutPath,1) <> "\"
   OutPath + "\"
  EndIf
  If FileSize(OutPath) <> -2
   CreateDirectory(OutPath)
  EndIf 
  ;
  If OpenPack(PackFile) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = NextPackFile()
   FileNameSize.l = PackFileSize() 
   File.s = OutPath + PeekS(*FileName)
   ;
   *FileMem = NextPackFile()
   FileMemSize.l = PackFileSize()
   ;
   FH = CreateFile(#PB_Any,File)
   If IsFile(FH) = 0
    ClosePack()
    ProcedureReturn 0
   Else
    WriteData(FH,*FileMem,FileMemSize)
    CloseFile(FH)
    ClosePack()
    ProcedureReturn 1
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

MyFile.s = "C:\ASUSP5K34.jpg"
MyPack.s = "C:\Temp.pck"
MyPath.s = "C:\Out\"

If PackFile(MyFile,MyPack,9)
 Debug "packed"
 If UnPackFile(MyPack,MyPath)
  Debug "unpacked"
 Else
  Debug "failed to unpack"
 EndIf
Else
 Debug "failed to pack"
EndIf

[Edit]
Some error checking would be vital....

Rook Zimbabwe · Post by **Rook Zimbabwe** » Mon Mar 31, 2008 4:03 am

Inf0, you are wonderful!

I am going to see if I can add this to your password routines... There is a method to my maddness here!

Inf0Byt3 · Post by **Inf0Byt3** » Mon Mar 31, 2008 2:48 pm

Glad I can help

. If you want, I can make it be affected by the password (use encryption) just like the others.

Rook Zimbabwe · Post by **Rook Zimbabwe** » Mon Mar 31, 2008 3:17 pm

Good I keep hanging on that... then your .pbi file would make armadillo absolutely useless and save me 600k per program.

Inf0Byt3 · Post by **Inf0Byt3** » Mon Mar 31, 2008 3:43 pm

Roger that... I'm on it

.

Inf0Byt3 · Post by **Inf0Byt3** » Mon Mar 31, 2008 4:20 pm

Ok, done, but:

1. The encryption changes the damned entropy

. The original data has "gaps" and sequences of bytes that, after they're packed using an algorithm (like PB's one) they 'shrink' in smaller sequences. BUT in this case the encryption changes those sequences and the data can't be shrinked anymore. This is BAD. Even if you pack at the 9-th level, the data will be almost as big as the uncompressed one. If you don't use a password (thus no encryption), the data is much more tight after compression.

2. There's almost no error checking... That ought to be fixed, and CRC32 over the data would be cool too.

If you need something better, I think I might have an idea how to make this code work, e.g i won't use the 'pack' functions, just normal memory packing. That should fix the size after compression problem.

Code: Select all


Procedure RC4Mem(Mem.l, memLen.l, Key.s)

 ;RC4Mem For PB by Pille, 15.07.2003
 ;Special Thanks to Rings
 ;Modded by Inf0Byte

 Dim S.w(255)
 Dim K.w(255)
 
 ;A little hack to strenghten it up a bit
 KeySha1.s = SHA1Fingerprint(@Key,Len(Key))
 For EnhanceKey = 1 To Len(Key)
  NewKey.s + Mid(Key,EnhanceKey,1) + KeySha1
 Next
 Key = NewKey

 For i = 0 To 255
  S(i) = i
 Next
 j = 1
 For i = 0 To 255
  If j > Len(key)
   j = 1
  EndIf
  K(i) = Asc(Mid(key, j, 1))
  j = j + 1
 Next i
 j = 0
 For i = 0 To 255
  j = (j + S(i) + K(i)) & 255
  temp = S(i)
  S(i) = S(j)
  S(j) = temp
 Next i
 i = 0
 j = 0
 For x = 0 To memLen-1
  i = (i + 1) & 255
  j = (j + S(i)) & 255
  temp = S(i)
  S(i) = S(j)
  S(j) = temp
  t = (S(i) + (S(j) & 255)) & 255
  Y = S(t)
  PokeB(Mem+x, PeekB(Mem+x)!Y)
 Next
 Key = ""
 
 ProcedureReturn Mem
 
EndProcedure 

Procedure PackFile(FilePath.s,PackPath.s,Level.l,Password.s="")
 ;
 If FilePath = "" Or PackPath = ""
  ;
  ProcedureReturn 0
  ;
 ElseIf FileSize(FilePath) <= 0
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  FName.s = GetFilePart(FilePath)
  ;
  If CreatePack(PackPath) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = AllocateMemory(512) ;enough for the filename (i guess)
   If *FileName = 0
    ClosePack()
    ProcedureReturn 0
   Else
    PokeS(*FileName,FName,Len(FName))
    AddPackMemory(*FileName,Len(FName),Level)
    FileToPack = ReadFile(#PB_Any,FilePath)
    If IsFile(FileToPack)
     FileLen = Lof(FileToPack)
     *FileData = AllocateMemory(FileToPack)
     ReadData(FileToPack,*FileData,FileLen)
     If Password <> ""
      RC4Mem(*FileData,FileLen,Password) ;Encrypt the file data
     EndIf
     AddPackMemory(*FileData,FileLen,Level)
     If *FileData
      FreeMemory(*FileData)
     EndIf
     If *FileName
      FreeMemory(*FileName)
     EndIf
     CloseFile(FileToPack)
     ClosePack()
     ProcedureReturn 1
    Else
     If *FileName
      FreeMemory(*FileName)
     EndIf
     ClosePack()
     ProcedureReturn 0
    EndIf
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

Procedure UnPackFile(PackFile.s,OutPath.s,Password.s="")
 ;
 If PackFile = "" Or OutPath = ""
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  If Right(OutPath,1) <> "\"
   OutPath + "\"
  EndIf
  If FileSize(OutPath) <> -2
   CreateDirectory(OutPath)
  EndIf
  ;
  If OpenPack(PackFile) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = NextPackFile()
   FileNameSize.l = PackFileSize()
   File.s = OutPath + PeekS(*FileName)
   ;
   *FileMem = NextPackFile()
   FileMemSize.l = PackFileSize()
   ;
   FH = CreateFile(#PB_Any,File)
   If IsFile(FH) = 0
    ClosePack()
    ProcedureReturn 0
   Else
    If Password <> "" ;we need to decrypt the actual data
     RC4Mem(*FileMem,FileMemSize,Password)
    EndIf
    WriteData(FH,*FileMem,FileMemSize)
    CloseFile(FH)
    ClosePack()
    ProcedureReturn 1
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

MyFile.s = "C:\Windows\NOTEPAD.EXE"
MyPack.s = "C:\Temp.pck"
MyPath.s = "C:\Out\"
Password.s = "mypassword" ; use and empty string for no password

If PackFile(MyFile,MyPack,9,Password)
 Debug "packed"
 If UnPackFile(MyPack,MyPath,Password)
  Debug "unpacked"
 Else
  Debug "failed to unpack"
 EndIf
Else
 Debug "failed to pack"
EndIf

[Edit]
But isn't there a better option for what you're trying to do? Can't you just pack the data and use includebinary for the packed file then read it from the label, just like an image, then unpack it?

techjunkie · Post by **techjunkie** » Mon Mar 31, 2008 5:25 pm

Inf0Byt3 wrote:Hmmm that's strange. It works here :/. 843 files and 12 folders, all out. But I think I know why. Notice that some files that are in use/hidden cannot be accessed and also, my code doesn't include empty folders and files. I'm sure that's why it failed to include all the stuff in the folder.

As I said it can be extended and improved, i just needed something quick.

Very usefull code!

Thanks!

Yeah - I also saw that it miss some files and directories. I did a test of my document folder.

Will make a diff and see what files and folders that are missing.

Inf0Byt3 · Post by **Inf0Byt3** » Mon Mar 31, 2008 5:46 pm

That would be great! I suspect that the algorithm also finds some files uncompressable

. No idea why it sometimes fails.

Rook Zimbabwe · Post by **Rook Zimbabwe** » Tue Apr 01, 2008 5:00 am

My scheme involves an old TRIAL VERSION maker I used to do in Blitz3D. I used the PKPAK to unpack a pref file... subtract 1 from the run count and pck it back up when the program starts.

The program checks to see if the number is 0 or -1 forst and only shows a NAG screen to register in that instance.

If the program is registered it just prints the email of the regstered person and REGISTERED VERSION.

So using a binary image, cannot be modified.

Wolf · Post by **Wolf** » Fri Oct 10, 2008 6:58 pm

Hi Inf0Byt3

I try this source:

Code: Select all

;With greetz to Rook from Inf0

Procedure PackFile(FilePath.s,PackPath.s,Level.l,*Callback = 0)
 ;
 If *Callback <> 0
  PackerCallback(*Callback)
 EndIf
 ;
 If FilePath = "" Or PackPath = ""
  ;
  ProcedureReturn 0
  ;
 ElseIf FileSize(FilePath) <= 0
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  FName.s = GetFilePart(FilePath)
  ;
  If CreatePack(PackPath) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = AllocateMemory(512) ;enough for the filename (i guess)
   If *FileName = 0
    ProcedureReturn 0
   Else
    PokeS(*FileName,FName,Len(FName))
    AddPackMemory(*FileName,Len(FName),0)
    If AddPackFile(FilePath,Level) = 0
     ClosePack()
     ProcedureReturn 0
    Else
     ClosePack()
     ProcedureReturn 1
    EndIf
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

Procedure UnPackFile(PackFile.s,OutPath.s)
 ;
 If PackFile = "" Or OutPath = ""
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  If Right(OutPath,1) <> "\"
   OutPath + "\"
  EndIf
  If FileSize(OutPath) <> -2
   CreateDirectory(OutPath)
  EndIf
  ;
  If OpenPack(PackFile) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = NextPackFile()
   FileNameSize.l = PackFileSize()
   File.s = OutPath + PeekS(*FileName)
   ;
   *FileMem = NextPackFile()
   FileMemSize.l = PackFileSize()
   ;
   FH = CreateFile(#PB_Any,File)
   If IsFile(FH) = 0
    ClosePack()
    ProcedureReturn 0
   Else
    WriteData(FH,*FileMem,FileMemSize)
    CloseFile(FH)
    ClosePack()
    ProcedureReturn 1
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

MyFile.s = "C:\ASUSP5K34.jpg"
MyPack.s = "C:\Temp.pck"
MyPath.s = "C:\Out\"

If PackFile(MyFile,MyPack,9)
 Debug "packed"
 If UnPackFile(MyPack,MyPath)
  Debug "unpacked"
 Else
  Debug "failed to unpack"
 EndIf
Else
 Debug "failed to pack"
EndIf

But not working here with unicode file name....

Inf0Byt3 · Post by **Inf0Byt3** » Fri Oct 10, 2008 7:43 pm

Could you please try this code?

Code: Select all

;With greetz to Rook from Inf0

Procedure PackFile(FilePath.s,PackPath.s,Level.l,*Callback = 0)
 ;
 If *Callback <> 0
  PackerCallback(*Callback)
 EndIf
 ;
 If FilePath = "" Or PackPath = ""
  ;
  ProcedureReturn 0
  ;
 ElseIf FileSize(FilePath) <= 0
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  FName.s = GetFilePart(FilePath)
  ;
  If CreatePack(PackPath) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = AllocateMemory(1024) ;enough for the filename (i guess)
   If *FileName = 0
    ProcedureReturn 0
   Else
    CompilerIf #PB_Compiler_Unicode
     PokeS(*FileName,FName,StringByteLength(FName,#PB_UTF8),#PB_UTF8)
     AddPackMemory(*FileName,StringByteLength(FName,#PB_UTF8)+1,0) ;+1 null
    CompilerElse
     PokeS(*FileName,FName)
     AddPackMemory(*FileName,Len(FName)+1,0) ;+1 null
    CompilerEndIf
    If AddPackFile(FilePath,Level) = 0
     ClosePack()
     ProcedureReturn 0
    Else
     ClosePack()
     ProcedureReturn 1
    EndIf
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

Procedure UnPackFile(PackFile.s,OutPath.s)
 ;
 If PackFile = "" Or OutPath = ""
  ;
  ProcedureReturn 0
  ;
 Else
  ;
  If Right(OutPath,1) <> "\"
   OutPath + "\"
  EndIf
  If FileSize(OutPath) <> -2
   CreateDirectory(OutPath)
  EndIf
  ;
  If OpenPack(PackFile) = 0
   ProcedureReturn 0
  Else
   ;
   *FileName = NextPackFile()
   FileNameSize.l = PackFileSize()
   CompilerIf #PB_Compiler_Unicode
    File.s = OutPath + PeekS(*FileName,-1,#PB_UTF8)
   CompilerElse
    File.s = OutPath + PeekS(*FileName)
   CompilerEndIf
   Debug file
   ;
   *FileMem = NextPackFile()
   FileMemSize.l = PackFileSize()
   ;
   FH = CreateFile(#PB_Any,File)
   If IsFile(FH) = 0
    ClosePack()
    ProcedureReturn 0
   Else
    WriteData(FH,*FileMem,FileMemSize)
    CloseFile(FH)
    ClosePack()
    ProcedureReturn 1
   EndIf
   ;
  EndIf
  ;
 EndIf
 ;
 ProcedureReturn 0
 ;
EndProcedure

MyFile.s = "C:\texture.bmp"
MyPack.s = "C:\Temp.pck"
MyPath.s = "C:\Out\"

If PackFile(MyFile,MyPack,9)
 Debug "packed"
 If UnPackFile(MyPack,MyPath)
  Debug "unpacked"
 Else
  Debug "failed to unpack"
 EndIf
Else
 Debug "failed to pack"
EndIf

Rook Zimbabwe · Post by **Rook Zimbabwe** » Fri Oct 10, 2008 9:32 pm

Well it allegedly packs and unpacks the OGG file. There is a -1k difference in the OGG file when it is upacked.

I am going to pay it now to see if it plays!

no difference I suspect that the -1k size discrepency is due to XP Pro and not your code!

Now if only I could just pack the entire directory...

I am trying an idea now!

Rook Zimbabwe · Post by **Rook Zimbabwe** » Fri Oct 10, 2008 9:48 pm

OK this works and it doesn't work.

It looks like it will add all the OGG files to the PAK file, but only shows one?

Code: Select all

;With greetz to Rook from Inf0

Procedure PackFile(FilePath.s,PackPath.s,Level.l,*Callback = 0)
    ;
    If *Callback <> 0
        PackerCallback(*Callback)
    EndIf
    ;
    If FilePath = "" Or PackPath = ""
        ;
        ProcedureReturn 0
        ;
    ElseIf FileSize(FilePath) <= 0
        ;
        ProcedureReturn 0
        ;
    Else
        ;
        FName.s = GetFilePart(FilePath)
        ;
        If CreatePack(PackPath) = 0
            ProcedureReturn 0
        Else
            ;
            *FileName = AllocateMemory(1024) ;enough for the filename (i guess)
            If *FileName = 0
                ProcedureReturn 0
            Else
                CompilerIf #PB_Compiler_Unicode
                    PokeS(*FileName,FName,StringByteLength(FName,#PB_UTF8),#PB_UTF8)
                    AddPackMemory(*FileName,StringByteLength(FName,#PB_UTF8)+1,0) ;+1 null
                CompilerElse
                    PokeS(*FileName,FName)
                    AddPackMemory(*FileName,Len(FName)+1,0) ;+1 null
                CompilerEndIf
                If AddPackFile(FilePath,Level) = 0
                    ClosePack()
                    ProcedureReturn 0
                Else
                    ClosePack()
                    ProcedureReturn 1
                EndIf
            EndIf
            ;
        EndIf
        ;
    EndIf
    ;
    ProcedureReturn 0
    ;
EndProcedure

Procedure UnPackFile(PackFile.s,OutPath.s)
    ;
    If PackFile = "" Or OutPath = ""
        ;
        ProcedureReturn 0
        ;
    Else
        ;
        If Right(OutPath,1) <> "\"
            OutPath + "\"
        EndIf
        If FileSize(OutPath) <> -2
            CreateDirectory(OutPath)
        EndIf
        ;
        If OpenPack(PackFile) = 0
            ProcedureReturn 0
        Else
            ;
            *FileName = NextPackFile()
            FileNameSize.l = PackFileSize()
            CompilerIf #PB_Compiler_Unicode
                File.s = OutPath + PeekS(*FileName,-1,#PB_UTF8)
            CompilerElse
                File.s = OutPath + PeekS(*FileName)
            CompilerEndIf
            Debug file
            ;
            *FileMem = NextPackFile()
            FileMemSize.l = PackFileSize()
            ;
            FH = CreateFile(#PB_Any,File)
            If IsFile(FH) = 0
                ClosePack()
                ProcedureReturn 0
            Else
                WriteData(FH,*FileMem,FileMemSize)
                CloseFile(FH)
                ClosePack()
                ProcedureReturn 1
            EndIf
            ;
        EndIf
        ;
    EndIf
    ;
    ProcedureReturn 0
    ;
EndProcedure

;MyFile.s = "C:\texture.bmp"
MyFile.s = "C:\Program Files\PureBasic\DEVEL\WaHOO\MUSIC\anoy1.ogg"
MyFile2.s = "C:\Program Files\PureBasic\DEVEL\WaHOO\MUSIC\anoy2.ogg"
MyFile3.s = "C:\Program Files\PureBasic\DEVEL\WaHOO\MUSIC\anoy3.ogg"
MyPack.s = "C:\Program Files\PureBasic\DEVEL\WaHOO\Temp.pak"
MyPath.s = "C:\Program Files\PureBasic\DEVEL\WaHOO\SONGS\"

OpenConsole()

If PackFile(MyFile,MyPack,0)
    Debug "packed"
    PackFile(MyFile2,MyPack,0)
    Debug "2nd packed"
    PackFile(MyFile3,MyPack,0)
    Debug "3rd packed up!"
    If UnPackFile(MyPack,MyPath)
        Debug "unpacked"
    Else
        Debug "failed to unpack"
    EndIf
Else
    Debug "failed to pack"
EndIf

Input()

End

If I read the code right, and since I have not yet been to sleep in 26 hours I am probaly not!) I just add pack files with your basic command.

I am using this PAK

http://www.bluemesapc.com/Downloads/Temp.pak

PureBasic Forums - English

MicroPack.pbi - pack files and dirs, with filenames

Add an space to selected line