inc_engine.asp

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

	' Constructor
	Private Sub Class_Initialize()
		Set Parent_		= Nothing
		Name_			= ""
		Body_			= ""
		DateCreated_	= null
		DateModified_	= null
		Description_	= ""
	End Sub
	
	' Destructor
	Private Sub Class_Terminate()
		Set Parent_ = Nothing
	End Sub


End Class
' END CLASS DEFINITION DBAProcedure


'///////////////////////////////////////////////////
'// ' Class describes single field in a table
'//
Class DBAField



	'######################################################## 
	'# 
	Public Property Set Parent(v)
		Set Parent_ = v
	End Property    
	
	Public Property Get Parent
		Parent = Parent_
	End Property  

	'######################################################## 
	'# 
	Public Property Let Name(v)
		if Len(Name_) > 0 then 
			'change the name of the column
			dim xCat
			set xCat = Server.CreateObject("ADOX.Catalog")
			If IsEmpty(xCat) or xCat Is Nothing Then
				Parent_.Parent.LastError = "ADOX is not available. Couldn't change column's name"
				v = Name_
			Else
				set xCat.ActiveConnection = Parent_.Parent.JetConnection
				xCat.Tables(Parent_.Name).Columns(Name_).Name = CStr(v)
				set xCat = Nothing
			End If
		end if
		Name_ = CStr(v)
	End Property    
	
	Public Property Get Name
		Name = Name_
	End Property  

	'######################################################## 
	'# sets/returns field type
	Public Property Let FieldType(v)
		If FieldType_ >= 0 and v <> FieldType_ then PendingUpdates_ = True
		if IsNumeric(v) then 
			FieldType_ = CLng(v)
		else
			Select Case UCase(v)
				Case "COUNTER"			IsAutonumber_ = True : FieldType_ = 3
				Case "LONG"				FieldType_ = 3
				Case "DATETIME"			FieldType_ = 7
				Case "BIT"				FieldType_ = 11
				Case "MONEY"			FieldType_ = 6
				Case "BINARY"			FieldType_ = 128
				Case "TINYINT"			FieldType_ = 17
				Case "DECIMAL"			FieldType_ = 131
				Case "FLOAT"			FieldType_ = 5
				Case "INTEGER"			FieldType_ = 2
				Case "REAL"				FieldType_ = 4
				Case "UNIQUEIDENTIFIER"	FieldType_ = 72
				Case "MEMO"				MaxLength_ = 0 : FieldType_ = 203
				Case "TEXT"				FieldType_ = 130
				Case Else				FieldType_ = -1
			End Select
		end if
	End Property    
	
	Public Property Get FieldType
		call UpdateBatch
		
		FieldType = FieldType_
	End Property  

	'######################################################## 
	'# 
	Public Property Let MaxLength(v)
		if not IsEmpty(MaxLength_) and v <> MaxLength_ then PendingUpdates_ = True
		if IsNumeric(v) then MaxLength_ = CInt(v) else MaxLength_ = -1
	End Property    
	
	Public Property Get MaxLength
		call UpdateBatch
		
		MaxLength = MaxLength_
	End Property  

	'######################################################## 
	'# 
	Public Property Get IsPrimaryKey
		if IsNull(IsPrimaryKey_) then
			dim key
			IsPrimaryKey_ = False
			for each key in Parent_.Indexes.Keys
				if Parent_.Indexes.Item(key).TargetField = Name_ and Parent_.Indexes.Item(key).IsPrimary then
					IsPrimaryKey_ = True
					Exit for
				end if
			next
		end if
		
		IsPrimaryKey = IsPrimaryKey_
	End Property  

	'######################################################## 
	'# 
	Public Property Let IsAutonumber(v)
		if not IsEmpty(IsAutonumber_) and not IsNull(v) and v <> IsAutonumber_ then PendingUpdates_ = True
		if not IsNull(v) then IsAutonumber_ = CBool(v)
	End Property
	
	Public Property Get IsAutonumber
		IsAutonumber = IsAutonumber_
	End Property  

	'######################################################## 
	'# 
	Public Property Let Ordinal(v)
		if Ordinal_ = 0 then Ordinal_ = CInt(v)
	End Property    
	
	Public Property Get Ordinal
		Ordinal = Ordinal_
	End Property  

	'######################################################## 
	'# 
	Public Property Get HasDefault
		HasDefault = not IsNull(DefaultValue_) and not IsEmpty(DefaultValue_)
	End Property  

	'######################################################## 
	'# 
	Public Property Let DefaultValue(v)
		if not IsEmpty(DefaultValue_) and v <> DefaultValue_ then PendingUpdates_ = True
		DefaultValue_ = v
	End Property    
	
	Public Property Get DefaultValue
		call UpdateBatch
		
		DefaultValue = DefaultValue_
	End Property  

	'######################################################## 
	'# 
	Public Property Let IsNullable(v)
		if not IsEmpty(IsNullable_) and v <> IsNullable_ then PendingUpdates_ = True
		IsNullable_ = CBool(v)
	End Property    
	
	Public Property Get IsNullable
		IsNullable = IsNullable_
	End Property  

	'######################################################## 
	'# 
	Public Property Let Description(v)
		if not IsNull(v) and v <> Description_ and not IsEmpty(Description_) then PendingUpdates_ = True
		if IsNull(v) then Description_ = "" else Description_ = CStr(v)
	End Property    
	
	Public Property Get Description
		Description = Description_
	End Property  

	'######################################################## 
	'# 
	Public Property Let AllowZeroLength(v)
		if not IsEmpty(AllowZeroLength_) and not IsNull(v) and v <> AllowZeroLength_ then PendingUpdates_ = True
		AllowZeroLength_ = CBool(v)
	End Property
	
	Public Property Get AllowZeroLength
		AllowZeroLength = AllowZeroLength_
	End Property

	'######################################################## 
	'# 
	Public Property Let Compressed(v)
		if not IsNull(v) then Compressed_ = CBool(v)
	End Property

	Public Property Get Compressed
		Compressed = Compressed_
	End Property

	'######################################################## 
	'# return SQL string for this field
	Public Property Get SQL
		call UpdateBatch
		
		dim strSQL
		strSQL = "[" & Name_ & "] " & GetSQLTypeName()
		if GetSQLTypeName() = "TEXT" then strSQL = strSQL & "(" & MaxLength_ & ")"
		if not IsNullable_ then strSQL = strSQL & " NOT NULL"
		if HasDefault then strSQL = strSQL & " DEFAULT " & DefaultValue_
		SQL = strSQL
	End Property  

	'######################################################## 
	'# 	
	Public Function IsInitialized()
		if Len(Name_) > 0 and FieldType_ >= 0 and TypeName(Parent_) <> "Nothing" then IsInitialized = True else IsInitialized = False
	End Function
	
	'######################################################## 
	'# Returns SQL type name
	Function GetSQLTypeName
		Select Case FieldType_
		Case 3		if IsAutonumber then GetSQLTypeName = "COUNTER" else GetSQLTypeName = "LONG"
		Case 7		GetSQLTypeName = "DATETIME"
		Case 11		GetSQLTypeName = "BIT"
		Case 6		GetSQLTypeName = "MONEY"
		Case 128,205	GetSQLTypeName = "BINARY"
		Case 17		GetSQLTypeName = "TINYINT"
		Case 131	GetSQLTypeName = "DECIMAL"
		Case 5		GetSQLTypeName = "FLOAT"
		Case 2		GetSQLTypeName = "INTEGER"
		Case 4		GetSQLTypeName = "REAL"
		Case 72		GetSQLTypeName = "UNIQUEIDENTIFIER"
		Case 130	if MaxLength_ = 0 then GetSQLTypeName = "MEMO" else GetSQLTypeName = "TEXT"
		Case 202	GetSQLTypeName = "TEXT"
		Case 203	GetSQLTypeName = "MEMO"
		Case Else	if DBAE_DEBUG Then GetSQLTypeName = FieldType_ Else GetSQLTypeName = ""
		End Select
	End Function
 
	'######################################################## 
	'# Returns human-readable name of the type, as it is in Access	
	Function GetTypeName
		Select Case FieldType_
		Case 3			if IsAutonumber then GetTypeName = "自动编号" else GetTypeName = "长整型"
		Case 7			GetTypeName = "日期/时间"
		Case 11			GetTypeName = "是/否"
		Case 6			GetTypeName = "货币"
		Case 128,204,205	GetTypeName = "二进制"
		Case 17			GetTypeName = "字节"
		Case 131		GetTypeName = "小数"
		Case 5			GetTypeName = "双精度数字"
		Case 2			GetTypeName = "整型"
		Case 4			GetTypeName = "单精度数字"
		Case 72			GetTypeName = "同步复制 ID"
		Case 130		if MaxLength_ = 0 then GetTypeName = "备注" else GetTypeName = "文本"
		Case 202		GetTypeName = "文本"
		Case 203		GetTypeName = "备注"
		Case Else		if DBAE_DEBUG Then GetTypeName = FieldType_ Else GetTypeName = ""
		End Select
	End Function
	
	'######################################################## 
	'# Updates any changes made to the field. Triggered from almost all functions and properties	
	Function UpdateBatch
		if not PendingUpdates_ or TypeName(Parent_) = "Nothing" then 
			UpdateBatch = True
			Exit Function
		end if

		dim xCat, field, sSQL, sSQLType
		
		if not DBAE_DEBUG then On Error Resume Next
		sSQLType = GetSQLTypeName
		sSQL = "ALTER TABLE [" & Parent_.Name & "] ALTER COLUMN [" & Name_ & "] " & sSQLType
		if sSQLType = "TEXT" then sSQL = sSQL & "(" & MaxLength_ & ")"
		if not IsNullable then sSQL = sSQL & " NOT NULL"
		call Parent_.Parent.Execute(sSQL)
		if not Parent_.Parent.IsError then
			'set other field properties
			set xCat = Server.CreateObject("ADOX.Catalog")
			if not IsEmpty(xCat) and not xCat Is Nothing Then
				set xCat.ActiveConnection = Parent_.Parent.JetConnection
				set field = xCat.Tables(Parent_.Name).Columns(Name_)
				with field
					if sSQLType = "TEXT" or sSQLType = "MEMO" then
						.Properties("Jet OLEDB:Allow Zero Length").Value = AllowZeroLength_
					end if
					if not IsNull(DefaultValue_) then .Properties("Default").Value = DefaultValue_
					if not IsNull(Description_) then .Properties("Description").Value = Description_
				end with
				set field = Nothing
				set xCat = Nothing
				Parent_.Parent.IsError
			End If
		end if
		
		UpdateBatch = not Parent_.Parent.HasError
		PendingUpdates_ = False
		
		'if error occured, let parent reload fields
		if Parent_.Parent.HasError then Parent_.Fields.Item(".uninitialized") = null
	End Function
	
	'######################################################## 
	'# Cancels any updates pending
	Public Sub CancelUpdates
		PendingUpdates_ = False
	End Sub
	
	'######################################################## 
	'# Returns a related table name or empty string if no related table
	Public Property Get LookupTable
		if IsEmpty(LookupTable_) and not Parent_ Is Nothing Then
			dim rec
			LookupTable_ = ""
			LookupField_ = ""
			set rec = Parent_.Parent.JetConnection.OpenSchema(adSchemaForeignKeys, Array(Empty,Empty,Empty,Empty,Empty,Parent_.Name))
			do while not rec.EOF
				if rec("FK_COLUMN_NAME").Value = Name_ Then
					LookupTable_ = rec("PK_TABLE_NAME").Value
					LookupField_ = rec("PK_COLUMN_NAME").Value
					Exit Do
				End If
				call rec.MoveNext()
			loop
			call rec.Close()
			
			set rec = Nothing
		End If
		LookupTable = LookupTable_
	End Property
	
	'######################################################## 
	'# Returns a related column name or empty string if no related column
	Public Property Get LookupField
		'fetch if needed
		LookupTable
		LookupField = LookupField_
	End Property
	

	'---------------------------
	'protected and private

	Private Parent_
	Private Name_
	Private FieldType_
	Private MaxLength_
	Private IsPrimaryKey_
	Private IsAutonumber_
	Private Ordinal_
	Private DefaultValue_
	Private IsNullable_
	Private Description_
	Private PendingUpdates_
	Private AllowZeroLength_
	Private Compressed_
	Private LookupTable_
	Private LookupField_


	' Constructor
	Private Sub Class_Initialize()
		Set Parent_		= Nothing
		Name_			= ""
		FieldType_		= -1
		MaxLength_		= Empty
		IsPrimaryKey_	= null
		IsAutonumber_	= Empty
		Ordinal_		= 0
		DefaultValue_	= Empty
		IsNullable_		= Empty
		Description_	= Empty
		PendingUpdates_	= False
		AllowZeroLength_= Empty
		Compressed_		= Empty
		LookupTable_	= Empty
		LookupField_	= Empty
	End Sub

	' Destructor
	Private Sub Class_Terminate()
		call UpdateBatch
		
		Set Parent_ = Nothing
	End Sub


End Class
' END CLASS DEFINITION DBAField



'///////////////////////////////////////////////////
'// ' Holds information about particular index in the table
'//
Class DBAIndex



	'######################################################## 
	'# 
	Public Property Set Parent(v)
		Set Parent_ = v
	End Property    
	
	Public Property Get Parent
		Parent = Parent_
	End Property  

	'######################################################## 
	'# 
	Public Property Let Name(v)
		Name_ = CStr(v)
	End Property    
	
	Public Property Get Name
		Name = Name_
	End Property