Create a folder (I call mine folder1) with some files.
You can have other folders containing files inside folder1 also.
#inclib "zlib1" here, you will have a different name I think.
Then run this code beside your folder.
Code: Select all
#Include "dir.bi"
#include "file.bi"
#inclib "zlib1"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Ulong Ptr, Byval source As Const Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Ulong Ptr, Byval source As Const Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Namespace fbz
Dim As String file
Dim As Integer f
Dim As boolean expand,folder
Dim As Integer passed_length
Dim As Ubyte Ptr source,destination
Sub string_split(Byval s As String,chars As String,result() As String)
Redim result(0)
Dim As String var1,var2
Dim As Long pst,LC=Len(chars)
#macro split(stri)
pst=Instr(stri,chars)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+LC)
Else
var1=stri
End If
If Len(var1) Then
Redim Preserve result(1 To Ubound(result)+1)
result(Ubound(result))=var1
End If
#endmacro
Do
split(s):s=var2
Loop Until var2=""
End Sub
Function getfileuc(file As String) As String
If Fileexists(file)=0 Then Print file;" not found":Sleep:End
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
f=Freefile
Open file For Binary Access Read As #f
Dim As String text
If Lof(f) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
Function getfile(file As String) As String
If Fileexists(file)=0 Then Print file;" not found":Sleep:End
f=Freefile
Open file For Binary Access Read As #f
Dim As String text
If Lof(f) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
Return text
End Function
'================= UNPACK ===============
Sub unpack
Var text=getfileuc(file)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
destination =Allocate(destinationlength)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
'Build the uncompressed string
uncompressed=String(destinationlength,0)
Print "Please wait"
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Redim As String temp()
string_split(file,"\",temp())
Var filename= Rtrim(temp(Ubound(temp)),".fbz")
f=Freefile
Open "_"+filename For Output As #f
Print #f,uncompressed
Close #f
Print "The UNcompressed file is "&"_"+filename
End Sub
'=================== PACK ============
Sub pack
Var text=getfile(file)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
destination = Allocate(destinationlength)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
Redim As String temp()
string_split(file,"\",temp())
Var filename=temp(Ubound(temp))
Print filename & " To Compress"
Print filename & " Length = ";Len(text)
Print filename & " Compressed length = ";destinationlength
Print "Compression = ";destinationlength/Len(text)
If mistake <>0 Then Print "There was an error"
Dim As String compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
f=Freefile
Open filename+".fbz" For Output As #f
Print #f,stringlength &"|";
Print #f,compressed
Close #f
Print "The compressed file is "&filename+".fbz"
End Sub
Function isfolder(fname As String) As boolean
Return Len(Dir(fname,fbDirectory))
End Function
Function isfile(fname As String) As boolean
Return Iif(isfolder(fname),0,1)
End Function
Function pipeout(Byval s As String="") Byref As String
Var f=Freefile
Dim As String tmp
Open Pipe s For Input As #f
s=""
Do Until Eof(f)
Line Input #f,tmp
s+=tmp+Chr(10)
Loop
Close #f
Return s
End Function
Sub finish Destructor
Print "ending"
Deallocate destination
destination=0
End Sub
End Namespace
'============== use =========
Sub compressfolder(inputs As String)
Dim As String s=fbz.pipeout("dir /b " + inputs)
Dim As String a()
dim as long counter
fbz.string_split(s,Chr(10),a())
Dim As String newfolder=inputs+".fbz"
if fbz.isfolder(newfolder)=true then shell "rmdir /Q /s "+ newfolder
Shell "mkdir "+ newfolder
For n As Long=Lbound(a) To Ubound(a)
counter+=1
Dim As String path=(inputs+"\"+a(n))
If fbz.isfile(path) Then
fbz.file=path
fbz.pack
Shell "move "+ a(n)+".fbz " + newfolder
Else
compressfolder(path) 'for nested folders
Shell "move "+ path+".fbz " + newfolder
End If
Print
Next n
Print "Total number files compressed = ";counter
Print "Destination folder is ";newfolder
End Sub
Dim As String inputs="folder1" '<--------- a folder with files.
If fbz.isfolder(inputs) Then fbz.folder=true
If Instr(inputs,".fbz") Then fbz.expand=true Else fbz.expand=false
'============ 'compress a folder + files==========
If fbz.expand=false And fbz.folder=true Then compressfolder(inputs)
Sleep