asp在线打包工具

时间：2008-07-16 22:09:04浏览：42352 ZWind's Blog



<%@LANGUAGE=\"VBSCRIPT\" CODEPAGE=\"936\"%>
<%
Option Explicit
Response.Buffer = True
Server.ScriptTimeOut=999999999
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'************************* 文件打包 *************************
'作者:henaxxz
'网站:http://hi.baidu.com/henaxxz
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是必须保留作者此版权信息。
'使用前请先确保目标文件具有读写权限，否则将因无法创建文件而导致程序出错。
'请确保剩余空间大于打包文件大小。
'************************************************************
'其实这段是废话，版权没有，违者不究！
%>
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\">
<head>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=gb2312\" />
<title>asp在线打包工具</title>
<style type=\"text/css\">
*{font-size:10pt;line-height:20px;}
</style>
</head>
<body>
<%
dim dbFile,Fso,Sql,mdbFile,Cat,Conn,Rs,obj,objFolder,objFile,objStream,strNoPack
mdbFile=\"pop.mdb\" '数据库名字
strNoPack = \"pop.mdb|1.asp|unpak\" '不打包的文件或文件夹
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 
%>
</body>
</html>

优点：代码少，执行速度快！解包的就不贴了，多的是，通用！比如海阳的~~ 以下是代码： 1

上一篇：asp的网站打包、解包程序
下一篇：利用eWebEditor获得WebShell

发表评论

昵称：验证码：

关于博主

博主：BlueCode

职业：web程序

简介：2002年开始一直从事Web制作，网站运营，会PHP+MYSQL ASP+MSSQL，微信开发

Linux文章
PHP文章
随机文章

BlueCode的自留地

asp在线打包工具

关于博主