www.gusucode.com > CC校友录贴吧 CCBar源码程序asp编程 > class/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 %>