asp打包网站文件

发布时间:2007年03月15日      浏览次数:1966 次
<%'----感谢CRACKER 给我的启发。。。。
'--------本程序由天街凡想制作
'--------QQ:5078712
Server.ScriptTimeout = 90
sub frm()%>
<form action="" method="post" name="frm_data" id="frm_data">
<table border="0" cellpadding="5" cellspacing="1">
<tr>
<td>要打包的目录</td>
<td><input name="data_path" type="text" id="data_path" value="<%=server.MapPath("./")%>"></td>
</tr>
<tr>
<td>生成数据库文件名</td>
<td><input name="data_name" type="text" id="data_name" value="luckyboy.mdb"></td>
</tr>
<tr align="center">
<td colspan="2"><input type="submit" name="Submit" value="提交"></td>
</tr>
</table>
</form>
<%
end sub
if request("data_path")="" then
frm()
else
dim mdbfile,packfolder
dim dbfile,fso,sql
packfolder=request("data_path") & "/"
mdbfile=request("data_name")
if trim(mdbfile)="" then mdbfile="luckyboy.mdb"
dbfile=server.MapPath(mdbfile)
checkdata(dbfile)
creatdata(dbfile)
'开始建表
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(packfolder)
'开始查找文件
search objfolder
response.write("搞定,收工!<a href="&mdbfile&"><font color=red>请下载文件</font></a><br>")
end if
'=======================函数定义
'开始建立数据库
function creatdata(objdata)
set cat=server.CreateObject("ADOX.Catalog")
'建立access2000的数据库
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & objdata
set cat=nothing
if err.number=0 then
Response.Write "数据库 " & objdata & " 创建成功<br> "
else
Response.Write "数据库创建失败,原因: " & err.description
Response.End
end if
end function
'检查同名数据库
function checkdata(objdata)
Set FSO = CreateObject("Scripting.FileSystemObject")
'如果数据库存在就删除原有数据
if fso.FileExists(objdata) then
fso.DeleteFile(objdata)
end if
set fso=nothing
end function
'文件搜索函数
function search(objfolder)
dim objsubfolder
for each objfile in objfolder.files
Set objStream = Server.CreateObject("ADODB.Stream")
a=a+1
objStream.Type = 1
objStream.Open
'跳过数据库本身和.LDB文件
errortxt=0
if right(objfile.path,len(mdbfile))=mdbfile or right(trim(objfile.path),4)=".ldb" then
errortxt=1
response.write objfile.path & "################文件跳过################<br>"
else
errortxt=0
end if
if errortxt=0 then
response.write objfile.path
on error resume next
objStream.LoadFromFile objfile.path
response.write "---<font color=red>写入成功</font>" & "<br>"
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
end function%>
免责声明:本站相关技术文章信息部分来自网络,目的主要是传播更多信息,如果您认为本站的某些信息侵犯了您的版权,请与我们联系,我们会即时妥善的处理,谢谢合作!