class_db.asp

是一个很好用的通信录源码,可以用在同学朋友等的通信上使用!

<%
Class classDBOprt

'===================================================================
'= Description  : Class's parameters define
'= Time		    : Created At OCT,19,2003
'= Modify       :
'=               Time    Description
'===================================================================
Private strTableName,strSQLType,strWhere,strOrder
Public	strDBSQL
Private objDBConn		'== 数据库连接
Private strDBName
Private	strAllSQL		'== 完整SQL操作语句
Public intErrNum	    '== 错误号

Public	objPubRS		'== 对外公用数据集
Public	intRSNum		'== 记录数

Public	arrDBDebug(30,5)'== 数据库操作记录二维数组
						'== format : Opt type,SQL,Effected rows,Error,Execute time
Private	blnIsDebug		'== 是否进行debug
Private intDebug		'== 记录数下标

'===================================================================
'= Description  : Class's initialization
'= Time		    : Created At OCT,19,2003
'= Modify       :
'=               Time    Description
'===================================================================
Private Sub Class_Initialize()
	strTableName = ""
	strSQLType = "SELECT"
	strWhere = ""
	strOrder = ""
	strDBSQL = ""
	strAllSQL = ""
	intErrNum = 0 
	intRSNum = 0
	strDBName = "db/db.mdb"
	

	blnIsDebug = true
	intDebug = 0

	Call OpenDBConn(objDBConn,strDBName)
End Sub

'===================================================================
'= Description  : Class's terminate
'= Time		    : Created At OCT,19,2003
'= Change Log   :
'===================================================================
Private Sub Class_Terminate()
	intDebug = 0
	Erase arrDBDebug
	Set objPubRS = Nothing
	Call CloseDBConn(objDBConn)
End Sub


'===================================================================
'= Description  : Set members parameters
'= Time		    : Created At OCT,19,2003
'= Change Log   :
'===================================================================
'设置表名的属性
Public Property Let TableName(value) 
	strTableName = Ucase(Trim(value))
End Property

'设置查询条件
Public Property Let Where(value)
	strWhere = value
End Property

'设置排序方式
Public Property Let Order(value)
	strOrder = value
End Property

'设置纯SQL语句
Public Property Let AllSQL(value)
	strAllSQL = value
End Property

'设置查询语句的类型
Public Property Let SQLType(value)
	strSQLType = Ucase(Trim(value))
	Select Case strSQLType
		Case "INSERT" :
			strDBSQL = "INSERT INTO #0 (#1) VALUES (#2)"
		Case "UPDATE" :
			strDBSQL = "UPDATE #0 SET #1 = #2"
		Case "DELETE" :
			strDBSQL = "DELETE FROM #0 "
		Case "SELECT" :
			strDBSQL = "SELECT #1 FROM #0 " 
	End Select
End Property

'===================================================================
'= Description  : CheckBadWords(strRule,strWord)
'= Time		    : Created At Jun,27,2004
'= Descript:	: check bad words and return error
'===================================================================
Public Function CheckBadWords(strRule,strWord)
	Dim i
	'== check wether or not use this function 
	If Not CTL_BAD_WORDS Then
		Exit Function
	End If
	'== strRule format : word1|||word2|||word3
	'== divider : |||
	Dim arrTmp
	
	arrTmp = Split(strRule,"|||")
	If IsArray(arrTmp) Then
		For i = Lbound(arrTmp) To Ubound(arrTmp)
			If Instr(strWord,arrTmp(i)) Then
				CheckBadWords = True
				Exit Function
			End If
		Next
	End If

	CheckBadWords = False
End Function


'===================================================================
'= Description  : Set public functions and sub of class
'= Time		    : Created At OCT,19,2003
'= Change Log   :
'===================================================================
'增加字段（字段名称，字段值）
Public Sub AddField(strFieldName,strValue)
	Select Case strSQLType
	Case "INSERT" :
		strDBSQL = Replace(strDBSQL, "#1", Ucase(strFieldName) & ",#1")
		strDBSQL = Replace(strDBSQL, "#2", "'" & strValue & "',#2")
	Case "UPDATE" :
		strDBSQL = Replace(strDBSQL, "#1", Ucase(strFieldName))
		strDBSQL = Replace(strDBSQL, "#2", "'" & strValue & "',#1 = #2")
	Case "SELECT" :
		strDBSQL = Replace(strDBSQL, "#1", Ucase(strFieldName) & ",#1")
	End Select
End Sub

'增加set字段（字段值）
Public Sub AddSet(strValue)	
	strDBSQL = Replace(strDBSQL, "#1 = #2", strValue & ",#1 = #2")
End Sub

'返回SQL语句
Public Function ReturnSQL()
	strDBSQL = Replace(strDBSQL,"#0",strTableName)
	Select Case strSQLType
		Case "INSERT" :
			strDBSQL = Replace(strDBSQL,",#1","")
			strDBSQL = Replace(strDBSQL,",#2","")
		Case "UPDATE" :
			strDBSQL = Replace(strDBSQL,",#1=#2","")
			strDBSQL = Replace(strDBSQL,",#1 = #2","")
		Case "SELECT" :
			strDBSQL = Replace(strDBSQL,",#1","")
	End Select

	If strWhere <> "" Then
		strDBSQL = strDBSQL & " WHERE " & strWhere
	End If
	If strOrder <> "" Then
		strDBSQL = strDBSQL & " ORDER BY " & strOrder
	End If

	ReturnSQL = strDBSQL
	'== 纯SQL操作
	If strAllSQL <> "" Then
		ReturnSQL = strAllSQL
		strDBSQL = strAllSQL
	End If
End Function

'清空语句
Public Sub Clear()	
	strTableName = ""
	strSQLType = "SELECT"
	strWhere = ""
	strOrder = ""
	strDBSQL = ""
	strAllSQL = ""
	intErrNum = 0
	intRSNum = 0
	strDBName = "db/class.mdb"
	Set objPubRS = Nothing
End Sub

Public Function SQLExeCute()
	Dim iCounter,NowDBTime,arrTmp,strErrDes
	On Error Resume Next

	GBL_intDBNum = GBL_intDBNum + 1

	'==  for bad words check
	If intErrNum <> 0 Then
		Exit Function
	End If

	If blnIsDebug Then
		NowDBTime = Timer
	End If

	Call objDBConn.ExeCute(ReturnSQL(),intRSNum)

	'== Check dbconnection's error
	For iCounter = 0 To objDBConn.Errors.Count - 1
		intErrNum = objDBConn.Errors(iCounter).Number
		strErrDes = objDBConn.Errors(iCounter).Description 
		If iCounter <> 0 Then 
			objDBConn.Errors.Clear 
		End If
	Next

	'== debug   
	If blnIsDebug Then

		arrDBDebug(intDebug,1) = strDBSQL
		arrTmp = split(strDBSQL," ")
		arrDBDebug(intDebug,0) = arrTmp(0)
		arrDBDebug(intDebug,2) = intRSNum
		arrDBDebug(intDebug,3) = intErrNum & ": " & strErrDes
		NowDBTime = FormatNumber(cCur(Timer - NowDBTime),3,True)
		arrDBDebug(intDebug,4) = NowDBTime * 1000 

		intDebug = intDebug + 1

	End If

	SQLExeCute = SetErrorException()
End Function

Public Function SQLRSExeCute() 
	Dim iCounter,strErrDes,NowDBTime,arrTmp
	On Error Resume Next

	GBL_intDBNum = GBL_intDBNum + 1

	'==  for bad words check
	If intErrNum <> 0 Then
		Exit Function
	End If

	'== debug  
	If blnIsDebug Then
		NowDBTime = Timer
	End If

	iCounter = 0
	Call OpenRecordSet(objPubRS)
	objPubRS.Open ReturnSQL(),objDBConn,1,1

	'== Check dbconnection's error
	For iCounter = 0 To objDBConn.Errors.Count - 1
		intErrNum = objDBConn.Errors(iCounter).Number
		strErrDes = objDBConn.Errors(iCounter).Description 
		If iCounter <> 0 Then 
			objDBConn.Errors.Clear 
		End If
	Next

	'== Check recordset's number
	objDBConn.Errors.Clear 
	If strSQLType = "SELECT" Then
		intRSNum = objPubRS.RecordCount
	End If

	'== debug 
	If blnIsDebug Then

		arrDBDebug(intDebug,1) = strDBSQL
		arrTmp = split(strDBSQL," ")
		arrDBDebug(intDebug,0) = arrTmp(0)
		arrDBDebug(intDebug,2) = intRSNum
		arrDBDebug(intDebug,3) = intErrNum & ": " & strErrDes
		NowDBTime = FormatNumber(cCur(Timer - NowDBTime),3,True)
		arrDBDebug(intDebug,4) = NowDBTime * 1000 

		intDebug = intDebug + 1

	End If

	SQLRSExeCute = SetErrorException()
End Function

'== 置异常的错误信息
Private Function SetErrorException()
	Dim strInfo

	SetErrorException = True

	If intErrNum <> 0 Then
		Select Case intErrNum
			Case    -2147217913 : strInfo = "插入记录数据有误!" 
			Case	-2147217900 : strInfo = "SQL语句错误!"
			Case	-2147467259 : strInfo = "没有足够权限进行写操作"
			Case	-2147217904 : strInfo = ""
			Case	-2147217865	: strInfo = ""
			Case Else : strInfo = ""
		End Select
		Call GBL_objException.catchErr(intErrNum,"数据库错误：" & strInfo)
		SetErrorException = False
	End If
End Function

' 返回数据集二维数组
Public Function GetRSRows()
	If Not IsObject(objPubRS) Then
		GetRSRows = null
	Else
		arrTemp = objPubRS.GetRows
		ReDim arrTemp1(Ubound(arrTemp,2),Ubound(arrTemp))
		For i = Lbound(arrTemp) To Ubound(arrTemp)
			For j = Lbound(arrTemp,2) To Ubound(arrTemp,2)
				arrTemp1(j,i) = arrTemp(i,j)
			Next
		Next
		GetRSRows = arrTemp1
		objPubRS.MoveFirst
	End If
End Function

'== 取得单条记录集为dictionary形式
Public Function GetRSOneRow()
	Dim arrTemp,i,j,Sql,Tmp,objRegEx
	If Not IsObject(objPubRS) Then
		GetRSOneRow = null
	Else
		Dim objDict
		If intRSNum > 0 Then
			arrTemp = objPubRS.GetRows
			ReDim arrTemp1(Ubound(arrTemp,2),Ubound(arrTemp))
			For i = Lbound(arrTemp) To Ubound(arrTemp)
				For j = Lbound(arrTemp,2) To Ubound(arrTemp,2)
					arrTemp1(j,i) = arrTemp(i,j)	
				Next
			Next

			Set objDict = Server.CreateObject("Scripting.Dictionary")
			objDict.CompareMode = vbTextCompare
			Sql = UCase(strDBSQL)

			Tmp = Split(Sql,"FROM")
			Set objRegEx = New RegExp              
			objRegEx.Pattern = "^SELECT"           
			objRegEx.IgnoreCase = True             
			Sql = objRegEx.Replace(Trim(Tmp(0)), "")
			Set objRegEx = Nothing
			Sql = Trim(Sql)
			Tmp = Split(Sql,",")
			For i = Lbound(Tmp) To Ubound(Tmp)
				objDict.Add Trim(Tmp(i)), arrTemp1(0,i)
			Next
			Set GetRSOneRow = objDict
			objPubRS.MoveFirst
			objDict.Add "Exist",True
			Set objDict = Nothing
		Else
			Set objDict = Server.CreateObject("Scripting.Dictionary")
			objDict.CompareMode = vbTextCompare
			Set GetRSOneRow = objDict
			Set objDict = Nothing
		End If
	End If
End Function

End Class

'===================================================================
'= Function     : GetNextRS(strOutField,strTabName,strWhere,strOrder)
'= Time		    : Created At 2006-5-5
'= Input        : strOutField: out filed 
'=				  strWhere	: where
'=				  strTabName: now table name
'=				  strOrder	: order conditions
'= Return       :  id
'= Description  : 取得上一条/下一条记录的某个字段
'===================================================================
Function GetNextRS(strOutField,strTabName,strWhere,strOrder)
	
	GBL_objPubDB.Clear()
	GBL_objPubDB.TableName = strTabName
	GBL_objPubDB.SQLType = "SELECT"
	GBL_objPubDB.AddField " Top 1 " & strOutField,""
	If Trim(strWhere) <> "" Then
		GBL_objPubDB.Where = strWhere
	End If
	If Trim(strOrder) <> "" Then
		GBL_objPubDB.Order = strOrder
	End If
	If Not GBL_objPubDB.SQLRSExecute() Then
		GetNextRS = -1
		Exit Function
	End If
	'== no find the record
	If GBL_objPubDB.intRSNum <= 0 Then
		GetNextRS = GBL_objPubDB.intRSNum
		Exit Function
	Else
		GetNextRS = GBL_objPubDB.objPubRS(strOutField)
	End If

End Function

'===================================================================
'= Function    : RecordCounter(strTableName,strField,intCounter,strWhere)
'= Time		   : Created At 2006-5-3
'= Input       : strTableName : the table name of db
'=				 strField     : the field name to update
'=				 intCounter   : the update value
'=				 strWhere     : the update record's condition
'= Description : 记录动作数
'===================================================================
Function RecordCounter(strTableName,strField,intCounter,strWhere)
	
	GBL_objPubDB.Clear()
	GBL_objPubDB.TableName = strTableName
	GBL_objPubDB.SQLType = "UPDATE"
	GBL_objPubDB.AddSet strField & "=" & strField & "+" & intCounter
	GBL_objPubDB.Where = "1=1 " & strWhere
	GBL_objPubDB.SQLExecute()
	Call ResultExecute(GBL_objPubDB.intErrNum,strField & " update"&GBL_objPubDB.ReturnSQL(),"ES_ERR")

End Function
%>