Recursive file/folder packer
Posted: Sat May 03, 2003 1:54 am
This is one of the first projects i completed (mostly) with PureBasic, but it's a good one.
you can give it a folder, and it will compress the contents of that folder, and all subfolders from it. i made the program create 2 small index files that's added to the pack first, containing all of the directory structure. I used a few other snippets of source here and there, but 90% of this is original code.
and yes, i know i hardly ever check for errors... that's what i'm working on adding now. hopefully someone will find this usefull.
i welcome all tips, comments, and yes, even flames
you can give it a folder, and it will compress the contents of that folder, and all subfolders from it. i made the program create 2 small index files that's added to the pack first, containing all of the directory structure. I used a few other snippets of source here and there, but 90% of this is original code.
and yes, i know i hardly ever check for errors... that's what i'm working on adding now. hopefully someone will find this usefull.
i welcome all tips, comments, and yes, even flames
Code: Select all
; Aszid's Packer v 0.9
;
;- Constants
;
#Main = 0
#Status = 0
#Pack = 1
#Quit = 2
#UnPack = 3
#Progressbar = 4
#Packfn = 5
#Gadget_6 = 6
#Pfname = 7
#gadget_8 = 8
#Comp = 9
;- Arrays
;
Dim Dirlist$(10000)
Dim Filelist$(10000)
Dim Filecnt(10000)
;- Global Variables
;
Global curfile$
Global prog.f
Global Filelist$
Global Dirlist$
Global FileCnt
Global Stepnum
Global filenum
Global dirnum
Global fsz.f
Global comp
Global runone
Global rootlen
Procedure Open_Main()
If OpenWindow(#Main, 216, 0, 270, 225, #PB_Window_TitleBar , "Packer")
If CreateGadgetList(WindowID())
ListViewGadget(#Status, 10, 10, 230, 110)
ButtonGadget(#Pack, 10, 150, 70, 20, "Pack")
ButtonGadget(#Quit, 180, 150, 60, 20, "Quit")
ButtonGadget(#UnPack, 90, 150, 80, 20, "UnPack")
ProgressBarGadget(#Progressbar, 10, 125, 230, 15, 0, 100, #PB_ProgressBar_Smooth)
StringGadget(#Packfn, 100, 175, 140, 20, "")
TextGadget(#Gadget_6, 10, 175, 85, 15, "Pack Filename:")
StringGadget(#Pfname, 100, 200, 140, 20, "")
TextGadget(#gadget_8, 10, 200, 80, 15, "Pack Folder:")
TrackBarGadget(#Comp, 245, 10, 20, 210, 0, 9, #PB_TrackBar_Ticks | #PB_TrackBar_Vertical)
EndIf
EndIf
EndProcedure
Procedure AddStep(StepText$)
AddGadgetItem(#Status, -1, StepText$)
SetGadgetState(#Status, Stepnum)
Stepnum = Stepnum + 1
EndProcedure
Procedure GetList(root$, Start)
If runone = 0
filenum = 0
dirnum = 0
rootlen = Len(root$)
runone = 1
EndIf
If ExamineDirectory(Start, root$, "")
Repeat
Type = NextDirectoryEntry()
If Type = 2
If DirectoryEntryName() <> "." And DirectoryEntryName() <> ".."
dirnum = dirnum + 1
If root$ = ""
Dirlist$(dirnum) = DirectoryEntryName() + "\"
GetList(Dirlist$(dirnum), Start+1)
Else
Dirlist$(dirnum) = root$ + DirectoryEntryName() + "\"
GetList(Dirlist$(dirnum), Start+1)
EndIf
UseDirectory(Start)
EndIf
Else
If Type = 1
filecnt(Start) = filecnt(Start) + 1
filenum = filenum + 1
Filelist$(filenum) = root$ + DirectoryEntryName()
EndIf
EndIf
Until Type = 0
EndIf
EndProcedure
Procedure stbar(spos, dpos)
prog = spos*100/fsz
SetGadgetState(#Progressbar, prog)
EventID=WindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case #Quit
a = ClosePack()
addstep("Cancelling: " + curfile$)
a = DeleteFile(curfile$)
End
EndSelect
EndIf
ProcedureReturn 1
EndProcedure
Procedure makepack(packname$, folder$)
Compl = GetGadgetState(#Comp)
curfile$ = packname$
If Right(folder$, 1) <> "\"
folder$ = folder$ + "\"
EndIf
GetList(folder$, 1)
b = CreateFile(1,"index.dir")
WriteStringN(Str(dirnum))
For a = 1 To dirnum
WriteStringN(Right(dirlist$(a),Len(dirlist$(a)) - rootlen))
WriteStringN(Str(filecnt(a)))
Next a
CloseFile(1)
b = CreateFile(1,"index.fil")
WriteStringN(Str(filenum))
For a = 1 To filenum
WriteStringN(Right(Filelist$(a),Len(Filelist$(a)) - rootlen))
Next a
CloseFile(1)
PackerCallback(@stbar())
b = CreatePack(packname$)
AddStep("adding: index.dir")
b = AddPackFile("index.dir", Compl)
AddStep("adding: index.fil")
b = AddPackFile("index.fil", Compl)
b = DeleteFile("index.dir")
b = DeleteFile("index.fil")
For a = 1 To filenum
fsz = FileSize(Filelist$(a))
AddStep("adding: " + Filelist$(a))
b = AddPackFile(Filelist$(a),Compl)
Next a
AddStep("Done!")
b = ClosePack()
EndProcedure
Procedure UnPack(PackName$, dest$)
If Right(dest$,1) <> "\"
dest$ = dest$ + "\"
EndIf
If dest$ = "\"
dest$ = ""
EndIf
c = OpenPack(PackName$)
memloca = NextPackFile()
FileLength = PackFileSize()
b = CreateFile(1,"index.dir")
WriteData(memloca,FileLength)
CloseFile(1)
memloca = NextPackFile()
FileLength = PackFileSize()
b = CreateFile(1,"index.fil")
WriteData(memloca,FileLength)
CloseFile(1)
b = OpenFile(1,"index.dir")
dirnum = Val(ReadString())
For a = 1 To dirnum
dirlist$(a) = ReadString()
filecnt(a) = Val(ReadString())
Next a
CloseFile(1)
b = DeleteFile("index.dir")
b = OpenFile(1,"index.fil")
filenum = Val(ReadString())
For a = 1 To filenum
filelist$(a) = ReadString()
Next a
CloseFile(1)
b = DeleteFile("index.fil")
; make dirs
b = CreateDirectory(dest$)
For a = 1 To dirnum
b = CreateDirectory(dest$ + Dirlist$(a))
Next a
; decompress files to the proper dirs
For a = 1 To filenum
Addstep("Decompressing: " + Filelist$(a))
memloca = NextPackFile()
FileLength = PackFileSize()
b = CreateFile(1,dest$ + Filelist$(a))
WriteData(memloca,FileLength)
CloseFile(1)
Next a
b = ClosePack()
EndProcedure
;- Main Program
;
Open_Main()
SetGadgetState(#Comp,9)
Repeat
Event = WaitWindowEvent()
If Event = #PB_EventMenu
Select EventMenuID()
EndSelect
EndIf
If Event = #PB_EventGadget
Select EventGadgetID()
Case #Pack
packfil$ = GetGadgetText(#Packfn)
If UCase(Left(packfil$,5)) <> ".PACK"
packfil$ = packfil$ + ".pack"
EndIf
pfolder$ = GetGadgetText(#Pfname)
makepack(packfil$,pfolder$)
runone = 0
Case #UnPack
packfil$ = GetGadgetText(#Packfn)
If UCase(Left(packfil$,5)) <> ".PACK"
packfil$ = packfil$ + ".pack"
EndIf
pfolder$ = GetGadgetText(#Pfname)
Unpack(packfil$,pfolder$)
AddStep("Done!")
Case #Quit
CloseWindow(#Main)
End
EndSelect
EndIf
Until Event = #PB_EventCloseWindow
End
Joe