The establishment or compression of an Access database based on pure coding

Source: Internet
Author: User
Tags exit ole servervariables trim access database
access| Code | data | database | 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 <br>" & Err.Number & "<br>" & 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, please check error message <br>" & Err.Number & "<br>" & 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 <br>" & Err.Number & "<br>" & Err.Description)
Err.Clear
DeleteFile = False
End If
Call FSO. DeleteFile (filespec)
Set FSO = Nothing
DeleteFile = True



Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.