Posted: 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? 
PureBasic Forums - English
http://www.purebasic.com
https://www.purebasic.fr/english/
MicroPack.pbi - pack files and dirs, with filenames
Page 2 of 3
Posted: Sun Mar 30, 2008 5:42 pm
I'll make you an example in a few minutes... Hang on.
Posted: Sun Mar 30, 2008 6:12 pm
There you go 
:
[Edit]
Some error checking would be vital....
: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
Some error checking would be vital....
Posted: 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!
I am going to see if I can add this to your password routines... There is a method to my maddness here!Posted: 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.
. If you want, I can make it be affected by the password (use encryption) just like the others.Posted: 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.
Posted: Mon Mar 31, 2008 3:43 pm
Roger that... I'm on it .
.Posted: 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.
[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?
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
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?
Posted: Mon Mar 31, 2008 5:25 pm
Very usefull code!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.
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.
Posted: 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.
. No idea why it sometimes fails.Posted: 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.
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.
Add an space to selected line
Posted: Fri Oct 10, 2008 6:58 pm
Hi Inf0Byt3
I try this source:
But not working here with unicode file name....
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 Posted: 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
Posted: 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!
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!
Posted: 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?
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
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
I am using this PAK
http://www.bluemesapc.com/Downloads/Temp.pak