ASP FSO on-line compression decompression code

ASP FSO on-line compression decompression code
<%
''=====================
' FSO on-line compression and decompression
' Automatically generate Hytop.mdb
''=====================
Sub Addtomdb (Thepath)
On Error Resume Next
Dim Rs, Conn, Stream, ConnStr, Adocatalog, Fsox
Set Fsox = CreateObject ("Scripting.FileSystemObject")
If fsox.fileexists (Server.MapPath ("Hytop.mdb")) Then
Fsox.deletefile (Server.MapPath ("Hytop.mdb"))
End If
Set Rs = Server.CreateObject ("Adodb.recordset")
Set Stream = Server.CreateObject ("ADODB.stream")
Set Conn = Server.CreateObject ("Adodb.connection")
Set Adocatalog = Server.CreateObject ("ADOX. Catalog ")
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & Server.MapPath ("Hytop.mdb")
Adocatalog.create ConnStr
Conn.Open ConnStr
Conn.execute ("Create Table filedata (Id int IDENTITY (0,1) Primary Key Clustered, Thepath VarChar, filecontent Image)")
Stream.open
Stream.type = 1
Rs.Open "Filedata", Conn, 3, 3
Fsotreeformdb Thepath, Rs, Stream
Rs.close
Conn.close
Stream.Close
Set Rs = Nothing
Set Conn = Nothing
Set Stream = Nothing
Set Adocatalog = Nothing
End Sub

Sub Fsotreeformdb (Thepath, Rs, Stream)
Dim Item, Thefolder, Folders, Files, Sysfilelist, Fsox
Set Fsox = Server.CreateObject ("Scripting.FileSystemObject")
Sysfilelist = "$HYTop. mdb$hytop.ldb$"

If fsox.folderexists (thepath) = False Then
Response.Write (thepath& "directory does not exist or access is not allowed!")
End If
Set Thefolder = Fsox.getfolder (thepath)
Set Files = Thefolder.files
Set Folders = thefolder.subfolders
For each Item in Folders
Fsotreeformdb Item.path, Rs, Stream
Next
For each Item in Files
If InStr (sysfilelist, "$" & Item.name & "$") <= 0 Then
Rs.addnew
Rs ("thepath") = Mid (Item.path,len (Request ("Thepath")) +1)
Stream.loadfromfile (Item.path)
Rs ("filecontent") = Stream.read ()
Rs.update
End If
Next
Set Files = Nothing
Set Folders = Nothing
Set Thefolder = Nothing
Set Fsox = Nothing
End Sub

Sub Unpack (Thepath)
On Error Resume Next
Server.ScriptTimeout = 5000
Dim Rs, Ws, Str, Conn, Stream, ConnStr, Thefolder, Fsox
STR = Server.MapPath (".") & ""
Set Fsox = CreateObject ("Scripting.FileSystemObject")
Set Rs = CreateObject ("Adodb.recordset")
Set Stream = CreateObject ("ADODB.stream")
Set Conn = CreateObject ("Adodb.connection")
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & Thepath & ";"
Conn.Open ConnStr
Rs.Open "SELECT * from Filedata", Conn, 1, 1
Stream.open
Stream.type = 1
Do Until rs.eof
Thefolder=left (RS ("Thepath"), InStrRev (RS ("Thepath"), "")
Response. Write str&thefolder& "&nbsp;&nbsp; exist? "&fsox.folderexists (Str&thefolder) &" <br> "
If fsox.folderexists (str&thefolder) =false Then
Thefolderarr=split (Thefolder, "")
If Ubound (Thefolderarr) >2 Then
Thefolderstr= ""
For Xid=0 to UBound (Thefolderarr)
Thefolderstr=thefolderstr&thefolderarr (Xid) & ""
Fsox.createfolder (STR&AMP;THEFOLDERSTR)
Next
Else
Fsox.createfolder (Str&thefolder)
End If
End If
Stream.seteos ()
Stream.Write Rs ("Filecontent")
Stream.savetofile str&rs ("Thepath"), 2
Rs.movenext
Loop
Rs.close
Conn.close
Stream.Close
Set Ws = Nothing
Set Rs = Nothing
Set Stream = Nothing
Set Conn = Nothing
Set Fsox = Nothing
End Sub

Sub CreateFolder (Thepath)
Dim I, Fsox
Set Fsox = CreateObject ("Scripting.FileSystemObject")
i = Instr (Thepath, "")
Do While I >0
If fsox.folderexists (Left (thepath, i)) = False Then
Fsox.createfolder (Left (Thepath, i-1))
End If
If InStr (Mid (thepath,i,1), "") Then
i = I+instr (Mid (thepath,i,1), "")
Else
i = 0
End If
Loop
End Sub
If Trim (Request ("Zip")) <> "Then
Addtomdb (Request ("Thepath"))
Response.Write ("Compressed files complete!")
Response.Write ("<a href=hytop.mdb> Download compressed file </a>")
End If
If Trim (Request ("UnZip")) <> "Then
Unpack (Request ("Thefile"))
Response.Write ("Decompression complete!")
End If
%>

<style type= "Text/css" >
<!--
. STYLE1 {color: #FF0000}
. STYLE2 {
Color: #FFFFFF;
Font-weight:bold;
font-size:14px;
}
*{font-size:12px;}
-->
</style>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<form id= "Form1" Name= "Form1" method= "Post" action= "" >
<table width= "100%" height= "border=" 0 "cellpadding=" 0 "cellspacing=" 1 "bgcolor=" #66CCCC ">
<tr>
&LT;TD height= "colspan=" 3 "align=" center "><span class=" STYLE2 ">asp online compression-decompression </span></td>
</tr>
<tr>
&LT;TD width= "35%" height= "bgcolor=" "#FFFFFF" > Compressed directory (after compression is completed by default for this program directory <span class= "STYLE1" >hytop.mdb</ span> file) </td>
&LT;TD width= "41%" height= "bgcolor=" "#FFFFFF" >
&nbsp; <input name= "Thepath type=" text "id=" Thepath "value=" <% If Right (Server.MapPath ("."), 1) <> "" Then Response . Write (Server.MapPath (".")) & "Else Response.Write (Server.MapPath (". ")) End If%> "Size="/></td>
&LT;TD width= "24%" height= "bgcolor=" #FFFFFF "><input name=" Zip "type=" submit "id=" Zip "value=" online compression "/>< /TD>
</tr>
<tr>
&LT;TD height= bgcolor= "#FFFFFF" > Uncompressed files (default is <span class= "STYLE1" >HYTop.mdb</span> files) </ Td>
&LT;TD height= "bgcolor=" "#FFFFFF" >&nbsp; <input name= "Thefile" type= "text" id= "thefile" value= "<%=server.mappath (" Hytop.mdb ")%>" size= "/>< /TD>
&LT;TD height= "bgcolor=" "#FFFFFF" >
<input name= "UnZip" type= "Submit" id= "UnZip" value= "online decompression"/></td>
</tr>
</table>
</form>