<% ####### The following is a class file, the following annotation is the method of calling the class ######################## Note: If the system does not support the establishment of the Scripting.FileSystemObject object, then the database compression function will not be able to use the '# Access database class' # createdbfile to create an Access database file' # CompactDatabase to compress an Access Database file '#770:' # set a = New DatabaseTools '# by (Xiao Hanxue) sf' ###################################################################################################################################################################################################################################################################### ############################################################
Class DatabaseTools
Public function CreateDBfile (byVal dbFileName, byVal DbVer, byVal SavePath) 'establishment of 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 (DBFT (DBFILENAME, 1) = "/" THEN DBFILENAME = TRIM (MID (DBFileName, 2, Len (DBFileName)) The response.write ("Sorry, this database already exists!") CreateDbfile = false else Dim Ca set CA = Server.createObject ("Adox .Catalog ") if Err.Number <> 0 Then Response.write (" Unable to establish, please check the error message
"& err.Number &"
"& err.description) err.clear exit function endiff 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) 'Compressed Database File' 0 for Access 97 '1 for 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 RESE.WRITE ("Sorry, this 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 the error message
" & err.number & "
" & err.description) err.clear exit function end if if dbver = 0 the 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 ElsePt 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 'Delete the old database files call DeleteFile (SavePath & dbFileName)' database files will be compressed reducing call RenameFile (SavePath & dbFileName & ".bak.mdb", savepath & dbfilename) SET CD = false compactDatabase = true end if end function
Public Function Dbexists (Byval dbpath) 'Finding if the 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 functionPublic function app path () 'Take the current real path AppPath = Server.mAppath ("./") end function
Public Function AppName () 'Take the current program name AppName = MID (Request.ServerVariables ("Script_name"), (Request.ServerVariables ("script_name"), "/", - 1, 1)) 1, LEN Request.ServerVariables ("script_name"))) End Function
Public Function Deletefile (filespec) deletes 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 DIM FSO SET FSO = CreateObject (" scripting.filesystemObject ") if err.Number <> 0 Then Response.write (" Errors when modifying the file name! Please check the error message < Br> "& 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%>
