在线压缩MDB数据库

<%
option explicit
response.buffer=true
%>
<!--#include file="conn.asp"-->

<%
   Call CompactData()
%>

<%
sub CompactData()
        '关闭数据库链接
        Call CloseConn()
Dim fso, Engine,strDBPath,PDB_1,DbTemp
PDB_1 = server.mappath(DbPath)'数据库文件
        Randomize timer
DbTemp = CStr(Clng(8999999*Rnd+1000000))
if instr(PDB_1,"/") then
   strDBPath = left(PDB_1,instrrev(PDB_1,"/"))
else
   strDBPath = left(PDB_1,instrrev(PDB_1,"\"))
end if
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(PDB_1) Then
   Set Engine = CreateObject("JRO.JetEngine")
   Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & PDB_1," Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & DbTemp & ".asa"
   fso.CopyFile strDBPath & DbTemp & ".asa",PDB_1
   fso.DeleteFile(strDBPath & DbTemp & ".asa")
   response.write "<br>数据库压缩成功!"
Else
                FoundErr=True
   response.write "<br><li>数据库没有找到!</li>"
End If
Set fso = nothing
Set Engine = nothing
end sub
%>

<%
Const CMSDataBase = 0
Dim DbPath

If CMSDataBase = 0 Then
DbPath = "Data/#db1.asp" '修改数据库名称后，需要相应的修改这里
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DbPath)
Else
'
End If
%>
<%
Dim Conn,ConnStr,Rs

Call OpenConn()

Set Rs = Server.CreateObject("Adodb.RecordSet")

Private Sub CloseConn()
Conn.Close
Set Conn = Nothing
End Sub

Private Sub OpenConn()
On Error Resume Next
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open ConnStr
If Err.Number<>0 Then
   Response.Write("数据库连接错误")
   Err.Clear
   Response.End()
   Else
    On Error Goto 0
End If
End Sub
%>