ASP编程技巧大全

################################################
  ''# 注意：如果系统不支持建立Scripting.FileSystemObject对象，那么数据库压缩功能将无法使用
  ''# Access 数据库类
  ''# CreateDbFile 建立一个Access 数据库文件
  ''# CompactDatabase 压缩一个Access 数据库文件
  ''# 建立对象方法:
  ''# Set a = New DatabaseTools
  ''# by (萧寒雪) s.f.
  ''#########################################################################################
 
  Class DatabaseTools
 
  Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)
  ''建立数据库文件
  ''If DbVer is 0 Then Create Access97 dbFile
  ''If DbVer is 1 Then Create Access2000 dbFile
  On error resume Next
  If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
  If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
  If DbExists(SavePath & dbFileName) Then
  Response.Write ("对不起，该数据库已经存在!")
  CreateDBfile = False
  Else
  Dim Ca
  Set Ca = Server.CreateObject("ADOX.Catalog")
  If Err.number<>0 Then
  Response.Write ("无法建立，请检查错误信息
  " & Err.number & "
  " & Err.Description)
  Err.Clear
  Exit function
  End If
  If DbVer=0 Then
  call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName)
  Else
  call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName)
  End If
  Set Ca = Nothing
  CreateDBfile = True
  End If
  End function
 
  Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)
  ''压缩数据库文件
  ''0 为access 97
  ''1 为access 2000
  On Error resume next
  If Right(SavePath,1)<>"\" Or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"
  If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
  If DbExists(SavePath & dbFileName) Then
  Response.Write ("对不起，该数据库已经存在!")
  CompactDatabase = False
  Else
  Dim Cd
  Set Cd =Server.CreateObject("JRO.JetEngine")
  If Err.number<>0 Then
  Response.Write ("无法压缩，请检查错误信息
  " & Err.number & "
  " & Err.Description)
  Err.Clear
  Exit function
  End If
  If DbVer=0 Then
  call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data
  Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
  Else
  call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
  SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
  SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
  End If
  ''删除旧的数据库文件
  call DeleteFile(SavePath & dbFileName)
  ''将压缩后的数据库文件还原
  call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
  Set Cd = False
  CompactDatabase = True
  End If
  end function
 
  Public function DbExists(byVal dbPath)
  ''查找数据库文件是否存在
  On Error resume Next
  Dim c
  Set c = Server.CreateObject("ADODB.Connection")
  c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
  If Err.number<>0 Then
  Err.Clear
  DbExists = false
  else
  DbExists = True
  End If
  set c = nothing
  End function
 
  Public function AppPath()
  ''取当前真实路径
  AppPath = Server.MapPath("./")
  End function
 
  Public function AppName()
  ''取当前程序名称
  AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))
  End Function
 
  Public function DeleteFile(filespec)
  ''删除一个文件
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Err.number<>0 Then
  Response.Write("删除文件发生错误!请查看错误信息
  " & Err.number & "
  " & Err.Description)
  Err.Clear
  DeleteFile = False
  End If
  call fso.DeleteFile(filespec)
  Set fso = Nothing
  DeleteFile = True
  End function
 
  Public function RenameFile(filespec1,filespec2)
  ''修改一个文件
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Err.number<>0 Then
  Response.Write("修改文件名时发生错误!请查看错误信息
  " & Err.number & "
  " & Err.Description)
  Err.Clear
  RenameFile = False
  End If
  call fso.CopyFile(filespec1,filespec2,True)
  call fso.DeleteFile(filespec1)
  Set fso = Nothing
  RenameFile = True
  End function
 
  End Class
  %>
 
  现在已可以压缩有密码的数据库，代码如下，但是压缩之后的数据库密码就没有了！如何解决？
 
  <%
  Const JET_3X = 4
 
  Function CompactDB(dbPath, boolIs97)
  Dim fso, Engine, strDBPath
  strDBPath = left(dbPath,instrrev(DBPath,"\"))
  Set fso = CreateObject("Scripting.FileSystemObject")
 
  If fso.FileExists(dbPath) Then
  Set Engine = CreateObject("JRO.JetEngine")
 
  If boolIs97 = "True" Then
  Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
  "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=''XXXXXXXX'';Data Source=" & strDBPath & "temp.mdb;" _
  & "Jet OLEDB:Engine Type=" & JET_3X
  Else
  Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=''XXXXXXXX'';Data Source=" & dbpath, _
  "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
  End If
 
  fso.CopyFile strDBPath & "temp.mdb",dbpath
  fso.DeleteFile(strDBPath & "temp.mdb")
  Set fso = nothing
  Set Engine = nothing
 
  CompactDB = "你的数据库, " & dbpath & ", 已经压缩成功!" & vbCrLf
 
  Else
  CompactDB = "数据库名称或路径不正确. 请重试!" &