Professional website packaging/unpacking asp tool (hard‑packed E version )!
This asp program is suitable for uploading personal websites that are too large and compressed into one file!
It is also suitable for compressing the website without an ftp password before downloading it!
Reposted: Bad Wolf safety net www.winshell.cn
File Size: (8 K)
For the code, see (copy the text and change the extension to asp ):
<% @ LANGUAGE = "VBSCRIPT" CODEPAGE = "936" %>
<Object runat = "server" id = "fso" scope = "page" classid = "clsid: 0D43FE01-F093-11CF-8940-00A0C9054228"> </object>
<%
Option Explicit
'Asp Separation software bundles
Dim fsoX
Const isDebugMode = False ''Does debugging mode
Sub createIt (fsoX)
If isDebugMode = False Then
On Error Resume Next
End If
Set fsoX = Server. CreateObject ("Scripting. FileSystemObject ")
If IsEmpty (fsoX) Then
Set fsoX = fso
End If
If Err Then
Err. Clear
End If
End Sub
Sub chkErr (Err)
If Err Then
Echo "<style> body {margin: 8; border: none; overflow: hidden; background-color: buttonface ;}</style>"
Echo "<br/> <font size = 2> <li> error:" & Err. description & "</li> <li> error:" & Err. source & "</li> <br/>"
Echo "Err. Clear
Response. End
End If
End Sub
Sub echo (str)
Response. Write (str)
End Sub
Function HtmlEncode (str)
If isNull (str) Then
Exit Function
End If
HtmlEncode = Server. HTMLEncode (str)
End Function
Sub alertThenClose (strInfo)
Response. Write "<script> alert (" "& strInfo &" "); window. close (); </script>"
End Sub
Sub showErr (str)
Dim I, arrayStr
Str = Server. HtmlEncode (str)
ArrayStr = Split (str, "$ ")
'Response. Clear
Echo "<font size = 2>"
Echo "error: <br/>"
For I = 0 To UBound (arrayStr)
Echo "" & (I + 1) & "." & arrayStr (I) & "<br/>"
Next
Echo "</font>"
Response. End
End Sub
Call createIt (fsoX)
Call PageAddToMdb ()
Set fsoX = Nothing
Sub PageAddToMdb ()
Dim theAct, thePath
TheAct = Request ("theAct ")
ThePath = Request ("thePath ")
Server. ScriptTimeOut = 5000
If theAct = "addToMdb" Then
AddToMdb (thePath)
AlertThenClose ("OK! ")
Response. End
End If
If theAct = "releaseFromMdb" Then
UnPack (thePath)
AlertThenClose ("OK! ")
Response. End
End If
Echo "Echo "Echo "<title> Packing folders/untied device </title>" & vbNewLine
Echo "<style>" & vbNewLine
Echo "A: visited {color: # ffffff; text-decoration: none;}" & vbNewLine
Echo "A: active {color: # ffffff; text-decoration: none;}" & vbNewLine
Echo "A: link {color: # ffffff; text-decoration: none;}" & vbNewLine
Echo "A: hover {color: # ffffff; text-decoration: none;}" & vbNewLine
Echo "BODY {font-size: 9pt; COLOR: # ffffff; font-family:" "Courier New" "; border: none; background-color: #000000 ;} "& vbNewLine
Echo "textarea {font-family:" "Courier New" "; font-size: 12px; border-width: 1px; color: #000000 ;}" & vbNewLine
Echo "table {font-size: 9pt;}" & vbNewLine
Echo "form {margin: 0;}" & vbNewLine
Echo "# fsoDriveList span {width: 100px;}" & vbNewLine
Echo "# FileList span {width: 90; height: 70; cursor: hand; text-align: center; word-break: break-all; border: 1px solid buttonface ;} "& vbNewLine
Echo ". anotherSpan {color: # ffffff; width: 90; height: 70; text-align: center; background-color: # 0A246A; border: 1px solid # 0A246A;} "& vbNewLine
Echo ". font {font-size: 35px; line-height: 40px;}" & vbNewLine
Echo "# filecyclertools {background-color: buttonFace;}" & vbNewLine
Echo ". input, input {border-width: 1px;}" & vbNewLine
Echo "</style>" & vbNewLine
Echo "Echo "<body>" & vbNewLine
Echo "P: <br/>" & vbNewLine
Echo "<form method = post target = _ blank>"
Echo "<input name = thePath value =" & HtmlEncode (Server. MapPath (".") & "" size = 80> "& vbNewLine
Echo "<input type = hidden value = addToMdb name = theAct>"
Echo "<select name = theMethod> <option value = fso> FSO </option> <option value = app> no-FSO </option>" & vbNewLine
Echo "</select>" & vbNewLine
Echo "<br> <input type = submit value = 'P'>" & vbNewLine
Echo "</form>" & vbNewLine
Echo "Echo "<form method = post target = _ blank>" & vbNewLine
Echo "<input name = thePath value =" & HtmlEncode (Server. MapPath (".") & "\ badwolf. mdb" "size = 80>" & vbNewLine
Echo "<input type = hidden value = releaseFromMdb name = theAct> <input type = submit value = 'U'>" & vbNewLine
Echo "Echo "</form>" & vbNewLine
Echo "</body>"
Echo "
End Sub
Sub addToMdb (thePath)
If isDebugMode = False Then
On Error Resume Next
End If
Dim rs, conn, stream, connStr, adoCatalog
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 ("badwolf. 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
If Request ("theMethod") = "fso" Then
FsoTreeForMdb thePath, rs, stream
Else
SaTreeForMdb thePath, rs, stream
End If
Rs. Close
Conn. Close
Stream. Close
Set rs = Nothing
Set conn = Nothing
Set stream = Nothing
Set adoCatalog = Nothing
End Sub
Function fsoTreeForMdb (thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList
SysFileList = "$ badwolf. mdb $ badwolf. ldb $"
If fsoX. FolderExists (thePath) = False Then
ShowErr (thePath & "error! ")
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, 4)
Stream. LoadFromFile (item. Path)
Rs ("fileContent") = stream. Read ()
Rs. Update
End If
Next
Set files = Nothing
Set folders = Nothing
Set theFolder = Nothing
End Function
Sub unPack (thePath)
If isDebugMode = False Then
On Error Resume Next
End If
Server. ScriptTimeOut = 5000
Dim rs, ws, str, conn, stream, connStr, theFolder
Str = Server. MapPath (".")&"\"
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 "FileData", conn, 1, 1
Stream. Open
Stream. Type = 1
Do Until rs. Eof
TheFolder = Left (rs ("thePath"), faster Rev (rs ("thePath "),"\"))
If fsoX. FolderExists (str & theFolder) = False Then
CreateFolder (str & theFolder)
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
End Sub
Sub createFolder (thePath)
Dim I
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
Sub saTreeForMdb (thePath, rs, stream)
Dim item, theFolder, sysFileList
SysFileList = "$ badwolf. mdb $ badwolf. ldb $"
Set theFolder = saX. NameSpace (thePath)
For Each item In theFolder. Items
If item. IsFolder = True Then
SaTreeForMdb item. Path, rs, stream
Else
If InStr (sysFileList, "$" & item. Name & "$") <= 0 Then
Rs. AddNew
Rs ("thePath") = Mid (item. Path, 4)
Stream. LoadFromFile (item. Path)
Rs ("fileContent") = stream. Read ()
Rs. Update
End If
End If
Next
Set theFolder = Nothing
End Sub
%>