The essence of pure coding to achieve Access database establishment or compression
<%
' ###### #以下是一个类文件, the following annotation is the method of calling the class ################################################
' # Note: If the system does not support the creation of Scripting.FileSystemObject objects, then the database compression feature will not be available
' # Access Database class
' # Createdbfile Create an Access database file
' # CompactDatabase compressed an Access database file
' # Create object method:
' # Set a = New databasetools
' # by (She) s.f.
'#########################################################################################
Class Databasetools
Public Function Createdbfile (byVal dbfilename,byval dbver,byval Savepath)
' Create a database file
' 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 ("Sorry, the database already exists!")
Createdbfile = False
Else
Dim Ca
Set Ca = Server.CreateObject ("ADOX.") Catalog ")
If err.number<>0 Then
Response.Write ("cannot be established, please check the error message")
"& 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)
' Compress database files
' 0 is Access 97
' 1 is 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 ("Sorry, the database already exists!")
CompactDatabase = False
Else
Dim Cd
Set Cd =server.createobject ("JRO. JetEngine ")
If err.number<>0 Then
Response.Write ("Unable to compress, check error message")
"& 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 OLE DB; 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 OLE DB; Encrypt database=true ")
End If
' Delete old database files
Call DeleteFile (Savepath & Dbfilename)
' Restores the compressed database file
Call RenameFile (Savepath & Dbfilename & ". Bak.mdb", Savepath & Dbfilename)
Set Cd = False
CompactDatabase = True
End If
End Function
Public Function dbexists (ByVal dbpath)
' Find out if a database file exists
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 ()
' Take the current real path
AppPath = Server.MapPath ("./")
End Function
Public Function AppName ()
' Take the current program name
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)
' Delete a file
Dim FSO
Set fso = CreateObject ("Scripting.FileSystemObject")
If err.number<>0 Then
Response.Write ("Delete file Error!) Please check the error message
"& 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)
' Modify a file
