inc_engine.asp

可在线管理ACCESS数据库,可新建,修改,建表等如同本地操作数据库

<%


'//////////////////////////////////////////////////////////////////////////////////////////////////
'// Stp Database Administrator Engine
'// Engine version: 1.3.2
'// Copyright ?2002-2003 by Philip Patrick. All rights reserved
'//
'// Author:		Philip Patrick
'// E-mail:		[e-mail]
'// Web-site:	http://www.stpworks.com
'// Description:
'//		Set of classes and functions for managing Access database on the Web

Const DBAE_JET_PROVIDER		= "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Const DBAE_ENGINE_VERSION	= "1.3.2"
Const DBAE_DEBUG			= False


'/////////////////////////////////////////////////////////
'// Global functions

'#Makes syntax coloring for given SQL statement
Function HighlightSQL(sSQL)
	Const KeyWords =	"CREATE|TABLE|COUNTER|NOT NULL|DEFAULT|INDEX|ON|PRIMARY|WITH|LONG|TEXT|DATETIME|BIT|MONEY|BINARY|TINYINT|DECIMAL|FLOAT|INTEGER|REAL|UNIQUEIDENTIFIER|MEMO|UNIQUE|INSERT|INTO|SELECT|FROM|WHERE|UPDATE|DELETE|VALUES|PARAMETERS|ORDER BY|OR|AND|IN|SUM|AS|TOP|SET|LEFT|RIGHT|INNER|JOIN|ASC|DESC|GROUP BY|HAVING|CONSTRAINT|ADD|COLUMN|CASCADE|DROP|TOP|DISTINCT|DISTINCTROW|KEY|MIN|MAX|COUNT|AVG|PROCEDURE|VIEW|STDEV|STDEVP|UNION|ALTER|REFERENCES|FOREIGN|NO ACTION"
	
	dim RegEx, s
	set RegEx = new RegExp
	RegEx.Global = True
	RegEx.IgnoreCase = true
	
	sSQL = Replace(sSQL, vbCrLf, "<br>")
	
	'Replace code
	RegEx.Pattern = "(\b" & Replace(KeyWords, "|", "\b|\b") & "\b)"
	sSQL = RegEx.Replace(sSQL, "<font color=""blue"">$1</font>")
	
	'replace numbers
	RegEx.Pattern = "([\s\(<>=\-\+])([0-9]+)([\s,;\)<>=\-\+])"
	sSQL = RegEx.Replace(sSQL, "$1<font color=""green"">$2</font>$3")
	
	set RegEx = nothing
	HighlightSQL = sSQL
End Function

'/////////////////////////////////////////////////////////
'// Classes
Class DBAdmin

	'constructor
	Private Sub Class_Initialize
		Set Tables_		= Server.CreateObject("Scripting.Dictionary")
		Set Views_		= Server.CreateObject("Scripting.Dictionary")
		Set Relations_	= Server.CreateObject("Scripting.Dictionary")
		Set Procedures_	= Server.CreateObject("Scripting.Dictionary")
		
		EngineVersion_	= DBAE_ENGINE_VERSION
		UseADOX_		= True
		
		call Reset
	End Sub

	'destructor
	Private Sub Class_Terminate
		call Reset

		Set Tables_		= Nothing
		Set Views_		= Nothing
		Set Relations_	= Nothing
		Set Procedures_	= Nothing
	End Sub


	'######################################################## 
	'#Returns the version of Engine (not the whole product)
	Public Property Get EngineVersion
		EngineVersion = EngineVersion_
	End Property  

	'######################################################## 
	'#Path to Access database
	Public Property Let DatabasePath(v)
		call Reset
		DatabasePath_ = CStr(v)
	End Property    
	
	Public Property Get DatabasePath
		DatabasePath = DatabasePath_
	End Property  

	'######################################################## 
	'#Active ADO Connection object
	Public Property Get JetConnection
		Set JetConnection = JetConnection_
	End Property  

	'######################################################## 
	'#Last error occured in operation
	Public Property Let LastError(v)
		LastError_ = CStr(v)
	End Property    
	
	Public Property Get LastError
		LastError = LastError_
	End Property  

	'######################################################## 
	'#Use ADOX or force to use only SQL?
	Public Property Let UseADOX(v)
		UseADOX_ = CBool(v)
	End Property
	
	Public Property Get UseADOX
		UseADOX = UseADOX_
	End Property

	'######################################################## 
	'#Returns a size of database file in bytes
	Public Property Get Size
		Size = 0
		
		dim fso, f
		if not DBAE_DEBUG then On Error Resume Next
		set fso = Server.CreateObject("Scripting.FileSystemObject")
		set f = fso.GetFile(DatabasePath_)
		
		If not IsError then
			Size = f.Size
		end if

		set f = Nothing
		set fso = Nothing
	End Property  

	'######################################################## 
	'#Returns how much space can be reclaimed after compacting the database
	Public Property Get ReclaimedSpace
		ReclaimedSpace = 0
		
		If not DBAE_DEBUG then On Error Resume Next
		If IsOpen then
			ReclaimedSpace = CLng(JetConnection_.Properties("Jet OLEDB:Compact Reclaimed Space Amount").Value)
		end if
	End Property  

	'######################################################## 
	'# Returns locale identifier of the database
	Public Property Get LocaleIdentifier
		If not DBAE_DEBUG then On Error Resume Next
		
		If IsOpen then LocaleIdentifier = JetConnection_.Properties("Locale Identifier").Value
	End Property

	'######################################################## 
	'#Dictionary object contains all tables in database
	Public Property Get Tables
		if Tables_.Exists(".uninitialized") then
			'first time. Let's get tables names
			dim tbl, xTable, xCat, tableType
			Tables_.RemoveAll
			if not DBAE_DEBUG then On Error Resume Next
			set xCat = Server.CreateObject("ADOX.Catalog")
			if xCat Is Nothing or IsEmpty(xCat) or not UseADOX Then
				'ADOX is not available, so we'll get tables list using schemas
				set xCat = JetConnection_.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, Empty))
				Do While Not xCat.EOF
					tableType = xCat("TABLE_TYPE").Value
					If tableType = "SYSTEM TABLE" or tableType = "TABLE" or tableType = "ACCESS TABLE" or tableType = "LINK" _
						or tableType = "PASS-THROUGH" Then
						set tbl = new DBATable
						With tbl
							.Name =			xCat("TABLE_NAME").Value
							.DateCreated =	xCat("DATE_CREATED").Value
							.DateModified = xCat("DATE_MODIFIED").Value
							.Description =	xCat("DESCRIPTION").Value
							.TableType =	xCat("TABLE_TYPE").Value
							Set .Parent = Me
						End With
						Set Tables_.Item(tbl.Name) = tbl
					End If
					xCat.MoveNext
				Loop
				call xCat.Close()
			Else
				set xCat.ActiveConnection = JetConnection_
				if IsError then Exit Property
				for each xTable in xCat.Tables
					tableType = xTable.Type
					If tableType = "SYSTEM TABLE" or tableType = "TABLE" or tableType = "ACCESS TABLE" or tableType = "LINK" _
						or tableType = "PASS-THROUGH" Then
						set tbl = new DBATable
						with tbl
							.Name = xTable.Name
							.DateCreated = xTable.DateCreated
							.DateModified = xTable.DateModified
							.Description = ""
							.TableType = xTable.Type
							Set .Parent = Me
						end with
						Set Tables_.Item(tbl.Name) = tbl
					end if
				next
				
			End If
			set xCat = nothing
		end if
		
		Set Tables = Tables_
	End Property  

	'######################################################## 
	'#Dictionary object contains all procedures in database
	Public Property Get Procedures
		if Procedures_.Exists(".uninitialized") then
			dim p, xProc, xCat
			Procedures_.RemoveAll
			
			if not DBAE_DEBUG then On Error Resume Next
			set xCat = Server.CreateObject("ADOX.Catalog")
			if IsEmpty(xCat) or xCat is Nothing or not UseADOX Then
				set xCat = JetConnection_.OpenSchema(adSchemaProcedures)
				Do While Not xCat.EOF
					set p = new DBAProcedure
					With p
						.Name = xCat("PROCEDURE_NAME").Value
						.Body = xCat("PROCEDURE_DEFINITION").Value
						.DateCreated = xCat("DATE_CREATED").Value
						.DateModified = xCat("DATE_MODIFIED").Value
						.Description = xCat("DESCRIPTION").Value
						Set .Parent = Me
					End With
					Set Procedures_.Item(p.Name) = p
					xCat.MoveNext
				Loop
				xCat.Close
			Else
				set xCat.ActiveConnection = JetConnection_
				If IsError Then Exit Property
				for each xProc in xCat.Procedures
					set p = new DBAProcedure
					with p
						.Name = xProc.Name
						.Body = xProc.Command.CommandText
						.DateCreated = xProc.DateCreated
						.DateModified = xProc.DateModified
						.Description = ""
						Set .Parent = Me
					end with
					Set Procedures_.Item(p.Name) = p
				next
			End If
			
			set xCat = nothing
		end if
	
		Set Procedures = Procedures_
	End Property  

	'######################################################## 
	'# Dictionary object contains all views in database
	Public Property Get Views
		if Views_.Exists(".uninitialized") then
			dim v, xCat, xView
			Views_.RemoveAll
			
			if not DBAE_DEBUG then On Error Resume Next
			set xCat = Server.CreateObject("ADOX.Catalog")
			if IsEmpty(xCat) or xCat Is Nothing or not UseADOX Then
				set xCat = JetConnection_.OpenSchema(adSchemaViews)
				Do While Not xCat.EOF
					set v = new DBAView
					With v
						.Name = xCat("TABLE_NAME").Value
						.Body = xCat("VIEW_DEFINITION").Value
						.DateCreated = xCat("DATE_CREATED").Value
						.DateModified = xCat("DATE_MODIFIED").Value
						.Description = xCat("DESCRIPTION").Value
						Set .Parent = Me
					End With
					Set Views_.Item(v.Name) = v
					xCat.MoveNext
				Loop
				xCat.Close
			Else
				set xCat.ActiveConnection = JetConnection_
				If IsError Then Exit Property
				for each xView in xCat.Views
					set v = new DBAView
					with v
						.Name = xView.Name
						.Body = xView.Command.CommandText
						.DateCreated = xView.DateCreated
						.DateModified = xView.DateModified
						.Description = ""
						Set .Parent = Me
					end with
					Set Views_.Item(v.Name) = v
				next
			End If
			
			set xCat = Nothing
		end if
		
		Set Views = Views_
	End Property  

	'######################################################## 
	'# Dictionary Object contains all relationships in database
	Public Property Get Relations
		if Relations_.Exists(".uninitialized") then
			dim rec, rel
			Relations_.RemoveAll
			
			if not DBAE_DEBUG then On Error Resume Next
			set rec = JetConnection_.OpenSchema(adSchemaForeignKeys)
			If IsError Then Exit Property
			do while not rec.EOF
				set rel = new DBARelation
				with rel
					.Name = rec("FK_NAME").Value
					.PrimaryTable = rec("PK_TABLE_NAME").Value
					.PrimaryField = rec("PK_COLUMN_NAME").Value
					.PrimaryIndex = rec("PK_NAME").Value
					.ForeignTable = rec("FK_TABLE_NAME").Value
					.ForeignField = rec("FK_COLUMN_NAME").Value
					.OnUpdate = rec("UPDATE_RULE").Value
					.OnDelete = rec("DELETE_RULE").Value
					Set .Parent = Me
				end with
				Set Relations_.Item(rel.Name) = rel
				
				rec.MoveNext
			loop
			rec.Close
			set rec = nothing
		end if

		Set Relations = Relations_
	End Property  

	'######################################################## 
	'# Returns True if the database is Access 97 database
	Public Property Get IsAccess97
		if not DBAE_DEBUG then On Error Resume Next
		IsAccess97 = False
		if IsOpen then
			if CInt(JetConnection_.Properties("Jet OLEDB:Engine Type")) = 5 then IsAccess97 = False else IsAccess97 = True
		end if
	End Property

	'######################################################## 
	'# Opens a database connection, closing the existing one is present
	Public Function Connect(MDBPath, Password)
		dim strCon

		Connect = True
		call Reset
		
		'check if DSN was passed and retrieve file name
		if InStr(1, MDBPath, "DSN=", vbTextCompare) = 1 Then MDBPath = Mid(MDBPath, 5)
		If InStr(1, MDBPath, ":") <> 2 and InStr(1, MDBPath, "\\") <> 1 Then MDBPath = GetFilenameFromDSN(MDBPath, Password)
		
		DatabasePath_ = CStr(MDBPath)
		DatabasePassword_ = CStr(Password)
		
		strCon = DBAE_JET_PROVIDER & DatabasePath_
		if Len(DatabasePassword_) > 0 then strCon = strCon & ";Jet OLEDB:Database password=" & DatabasePassword_
		Set JetConnection_ = Server.CreateObject("ADODB.Connection")
		JetConnection_.CursorLocation = adUseServer
		JetConnection_.IsolationLevel = adXactReadUncommitted
		
		if not DBAE_DEBUG then On Error Resume Next
		JetConnection_.Open strCon
		
		if IsError then
			dim lastErr : lastErr = LastError
			call Reset
			LastError = lastErr
			Connect = False
		end if
	End Function

	'######################################################## 
	'# Creates a new blank database, and if successful, opens current connection with it
	Public Function CreateDatabase(Path)
		dim catalog
		
		if not DBAE_DEBUG then On Error Resume Next
		set catalog = Server.CreateObject("ADOX.Catalog")
		if IsEmpty(catalog) or catalog Is Nothing Then
			LastError = "ADOX is not available. Database couldn't be created"
		Else
			if Right(Path, 4) <> ".mdb" then Path = Path & ".mdb"
			
			call catalog.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path)
			
			set catalog = nothing
			
			if not IsError then call Connect(Path, "")
		End If
		CreateDatabase = not HasError
	End Function

	'######################################################## 
	'# Creates a new table in existing database
	Public Function CreateTable(Name)
		If not IsOpen then
			LastError = "Object is not initialized"
			CreateTable = False
			Exit Function
		end if
		
		dim objTbl
		if not DBAE_DEBUG then On Error Resume Next
		JetConnection_.Execute "CREATE TABLE [" & Name & "]", adExecuteNoRecords
		
		CreateTable = not IsError
		if Len(LastError) = 0 Then
			'remove all tables and reload them
			Tables_.Item(".uninitialized") = null
		end if
	End Function

	'######################################################## 
	'# Creates a linked table in existing database
	Public Function CreateLinkedTable(ExternalDBPath, DBpwd, ExternalTable, AliasName)
		If not IsOpen Then
			LastError = "Object is not initialized"
			CreateLinkedTable = False