)Code: Select all
;MicroPack.pbi
;(c) 2008 Trutia Alexandru
;PB4.20 B1
;www.bytessence.com
;
;Small include file for packing/depacking folders, recursive and with password
;The filenames are stored too, like in regular archives
;Very easy to extend
;License: Free for any use, credits appreciated but not necessary
;
;MP_PackFolder(Folder.s,Pack.s,Level) ;Pack a folder, level 0-9 (9 = best)
;MP_UnpackFolder(Pack.s,Folder.s) ;Unpack the files to a folder
;MP_GetPackFileCount(Pack.s) ;Count the files in a pack
;MP_SetPassword(Password.s) ;Set password for compression/decompression
;--------------------------------------------------
Global NewList FullPath.s()
Global NewList RelativePath.s()
Global MP_Internal_Pass.s
;Procedure MP_CRC32(fname.s)
; BufferSize = 1024000 ;1mb
; FileCRCH = ReadFile(#PB_Any,fname)
; If IsFile(FileCRCH)
; SizeToCheck = Lof(FileCRCH)
; *mem = AllocateMemory(BufferSize)
; If *mem
; While SizeToCheck
; chunk = SizeToCheck
; If chunk > BufferSize
; chunk = BufferSize
; EndIf
; ReadData(FileCRCH,*mem,chunk)
; crc = CRC32Fingerprint(*mem,chunk,crc) ; initially crc=0
; SizeToCheck - chunk
; Wend
; If *mem
; FreeMemory(*mem)
; EndIf
; If IsFile(FileCRCH)
; CloseFile(FileCRCH)
; EndIf
; ProcedureReturn crc
; Else
; ProcedureReturn -1
; EndIf
; Else
; ProcedureReturn -2
; EndIf
;EndProcedure
Procedure MP_FileList(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
FName.s = RemoveString(EntryPath + EntryName,OldPath)
AddElement(FullPath())
FullPath() = EntryPath + EntryName
AddElement(RelativePath())
RelativePath() = FName
EndIf
If EntryType = #PB_DirectoryEntry_Directory
MP_FileList(EntryPath + EntryName,OldPath)
EndIf
Wend
FinishDirectory(UsedDirectory)
ProcedureReturn 1
EndProcedure
Procedure MP_RC4(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 MP_SetPassword(Password.s)
MP_Internal_Pass.s = Password
ProcedureReturn 1
EndProcedure
Procedure MP_PackFolder(Folder.s,Pack.s,Level)
ClearList(FullPath())
ClearList(RelativePath())
If Right(folder.s,1) <> "\"
Folder.s+"\"
EndIf
If MP_FileList(folder.s,folder.s) = 1
ForEach RelativePath()
FileTable.s + RelativePath() + #LF$
Made + 1
Next
If CreatePack(pack.s)
AddPackMemory(@FileTable,Len(Filetable),9)
ForEach FullPath()
If MP_Internal_Pass <> ""
FLR = ReadFile(#PB_Any,FullPath())
If IsFile(FLR)
LenFile = Lof(FLR)
*Temp = AllocateMemory(LenFile)
ReadData(FLR,*Temp,LenFile)
MP_RC4(*Temp,LenFile, MP_Internal_Pass)
CloseFile(FLR)
EndIf
AddPackMemory(*Temp,LenFile,level)
If *Temp
FreeMemory(*Temp)
EndIf
Else
AddPackFile(FullPath(),level)
EndIf
Next
ClosePack()
ProcedureReturn Made
EndIf
EndIf
ProcedureReturn -1
EndProcedure
Procedure MP_UnpackFolder(Pack.s,Folder.s)
ClearList(FullPath())
ClearList(RelativePath())
If Right(Folder.s,1) <> "\"
Folder.s + "\"
EndIf
If FileSize(Folder) <> -2
CreateDirectory(Folder)
EndIf
If OpenPack(Pack)
*FileList = NextPackFile()
Size = PackFileSize()
If *FileList And Size
DataString.s = PeekS(*FileList,Size)
TotalFiles = CountString(DataString,#LF$)
For SplitFiles = 1 To TotalFiles
FName.s = StringField(DataString,SplitFiles,#LF$)
AddElement(FullPath())
FullPath() = Folder + FName
Next
ForEach FullPath()
FolderName.s = GetPathPart(FullPath())
If FileSize(FolderName) <> -2
CreateDirectory(FolderName)
EndIf
*File = NextPackFile()
Size = PackFileSize()
FileOut = CreateFile(#PB_Any,FullPath())
If IsFile(FileOut)
If MP_Internal_Pass <> ""
MP_RC4(*File,Size, MP_Internal_Pass)
EndIf
WriteData(FileOut,*File,Size)
CloseFile(FileOut)
Made + 1
EndIf
Next
EndIf
ClosePack()
EndIf
ProcedureReturn Made
EndProcedure
Procedure MP_GetPackFileCount(Pack.s)
If OpenPack(Pack)
*FileList = NextPackFile()
Size = PackFileSize()
If *FileList And Size
DataString.s = PeekS(*FileList,Size)
TotalFiles = CountString(DataString,#LF$)-1
EndIf
ClosePack()
EndIf
ProcedureReturn TotalFiles
EndProcedure
;--------------------------------------------------
;Example
;MP_SetPassword("TestPass")
MP_PackFolder("C:\Test\","C:\Test.pack",9) ;Pack all contents of "C:\MyFiles\"
;MP_SetPassword("TestPassa") ;1 letter changed and the files will be corrupted as the pass is different ;)
MP_UnpackFolder("C:\Test.pack","C:\Out\") ;And unpack the contents back to "C:\Out\" [Edit]
Code updated to support password, but it kinda needs a crc32 check there. If I have some time i'll find a fix.
. It should not be <that> hard. I can make it use RC4 as it's the easyest and i'll also make some mods for buffered procedures, as if you compress a 2gb file now it will require 2gb of ram 
. 
. Watch out, I may be in the news soon 
