近几天闲来无事,想写一个公用的数据访问类,但是却由于本人愚钝,对于Oracle和SyBase数据库不甚了解,所以一直未遂心愿,现将愚作公布于此,望有识之士多加指点.
类设计:
类代码:
<%
'***********************************************************************
' Module: Common.asp
' Author: 施煜
' Modified: 2005年3月3日 13:22:12
' Purpose:
' Comment:基本模块
'***********************************************************************
'********************************************************************************
'Begin>>>
'利用正则表达式判断字符串是否符合某一模式
'
'strFound:备查询的字符串
'strMode:替换体,正则表达式
'
'返回值:非0-第一次出现的位置,0-未找到
'********************************************************************************
Function InstrRegExp(strFound, strMode)
On Error Resume Next
InstrRegExp = 0
If Len(strMode) > 0 Then
Dim objRegExp
Dim objMatchs, objMatch
Set objRegExp = New RegExp
objRegExp.Pattern = strMode
objRegExp.IgnoreCase = True
objRegExp.Global = False
objRegExp.Multiline = True
Set objMatchs = objRegExp.Execute(strFound)
If objMatchs.Count <> 0 Then
Set objMatch = objMatchs.Item(0)
InstrRegExp = objMatch.FirstIndex + 1
Set objMatch = Nothing
End If
Set objMatchs = Nothing
Set objRegExp = Nothing
End If
If Err.Number <> 0 Then
'错误处理(待续)
Err.Clear
End If
End Function
'********************************************************************************
'Begin>>>
'利用正则表达式判断字符串是否符合某一模式
'
'strFound:备查询的字符串
'strMode:替换体,正则表达式
'
'返回值:非0-第一次出现的位置,0-未找到
'<<<End
'********************************************************************************
'********************************************************************************
'Begin>>>
'利用正则表达式替换字符串
'
'strInput:输入的要替换的原字符串
'strReplaced:被替换体,正则表达式
'strReplace:替换体,正则表达式
'********************************************************************************
Function ReplaceRegExp(strInput, strReplaced, strReplace)
On Error Resume Next
ReplaceRegExp = strInput
If Len(strReplaced) > 0 Then
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Pattern = strReplaced
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Multiline = True
ReplaceRegExp = objRegExp.Replace(strInput, strReplace)
Set objRegExp = Nothing
End If
If Err.Number <> 0 Then
'错误处理(待续)
Err.Clear
End If
End Function
'********************************************************************************
'利用正则表达式替换字符串
'
'strInput:输入的要替换的原字符串
'strReplaced:被替换体,正则表达式
'strReplace:替换体,正则表达式
'<<<End
'********************************************************************************
'********************************************************************************
'Begin>>>
'利用正则表达式提取字符串
'
'strInput:输入的要提取字符串的原字符串
'strMode:提取模式,正则表达式
'strPicker:提取体,正则表达式
'********************************************************************************
Function PickRegExp(strInput, strMode, strPicker)
On Error Resume Next
PickRegExp = ""
If Len(strMode) > 0 Then
Dim objRegExp
Dim objMatchs, objMatch
Set objRegExp = New RegExp
objRegExp.Pattern = strMode
objRegExp.IgnoreCase = True
objRegExp.Global = False
objRegExp.Multiline = True
Set objMatchs = objRegExp.Execute(strInput)
If objMatchs.Count <> 0 Then
Set objMatch = objMatchs.Item(0)
PickRegExp = objRegExp.Replace(objMatch.Value, strPicker)
Set objMatch = Nothing
End If
Set objMatchs = Nothing
Set objRegExp = Nothing
End If
If Err.Number <> 0 Then
'错误处理(待续)
Err.Clear
End If
End Function
'********************************************************************************
'利用正则表达式提取字符串
'
'strInput:输入的要提取字符串的原字符串
'strMode:提取模式,正则表达式
'strPicker:提取体,正则表达式
'<<<End
'********************************************************************************
%>
<%
'***********************************************************************
' Module: Mathsfield_Data.asp
' Author: 施煜
' Modified: 2005年3月3日 13:22:12
' Purpose:
' Comment:基本数据访问类
'***********************************************************************
Class Mathsfield_Data
' Attributes
Private mClassName
Private objConn
Private mDataBaseType
Private mDataBaseServer ' 用于数据库服务器的连接字符串
Private mDataBaseName
Private mDataBaseUser
Private mDataBasePass
Private mConnectionString
Public ErrorNO
Public dicConnectionString ' 数据库连接字符串列表
Public dicConnectionDriver ' 数据库连接类型列表
Public dicTypeReplaced ' 数据类型转换用被替换体正则表达式列表
Public dicTypeReplace ' 数据类型转换用替换体正则表达式列表
' Properties
Public Property Get ClassName()
ClassName = mClassName
End Property
Public Property Get DataBaseType()
DataBaseType = mDataBaseType
End Property
Public Property Let DataBaseType(ByVal newDataBaseType)
On Error Resume Next
Select Case UCase(Replace(newDataBaseType, " ",""))
Case "SQL", "SQLSERVER"
newDataBaseType = "SQLSERVER"
Case "ACCESS"
newDataBaseType = "ACCESS"
Case "MYSQL"
newDataBaseType = "MYSQL"
Case "ORACLE"
newDataBaseType = "ORACLE"
Case Else
newDataBaseType = "SQLSERVER"
End Select
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
newDataBaseType = "SQLSERVER"
End If
mDataBaseType = newDataBaseType
End Property
Public Property Get DataBaseName()
DataBaseName = mDataBaseName
End Property
Public Property Let DataBaseName(ByVal newDataBaseName)
On Error Resume Next
newDataBaseName = Trim(CStr(newDataBaseName))
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
newDataBaseName = ""
End If
mDataBaseName = newDataBaseName
End Property
Public Property Get DataBaseUser()
DataBaseUser = mDataBaseUser
End Property
Public Property Let DataBaseUser(ByVal newDataBaseUser)
On Error Resume Next
newDataBaseUser = Trim(CStr(newDataBaseUser))
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
newDataBaseUser = ""
End If
mDataBaseUser = newDataBaseUser
End Property
Public Property Get DataBasePass()
DataBasePass = mDataBasePass
End Property
Public Property Let DataBasePass(ByVal newDataBasePass)
On Error Resume Next
newDataBasePass = Trim(CStr(newDataBasePass))
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
newDataBasePass = ""
End If
mDataBasePass = newDataBasePass
End Property
Public Property Get DataBaseServer()
DataBaseServer = mDataBaseServer
End Property
Public Property Let DataBaseServer(ByVal newDataBaseServer)
On Error Resume Next
Select Case mDataBaseType
Case "SQLSERVER", "ORACLE"
newDataBaseServer = Trim(CStr(newDataBaseServer))
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
newDataBaseServer = ""
End If
Case Else
newDataBaseServer = ""
End Select
mDataBaseServer = newDataBaseServer
End Property
Public Property Get ConnectionString()
ConnectionString = mConnectionString
End Property
Public Property Let ConnectionString(ByVal newConnectionString)
On Error Resume Next
Dim strTemp, strTempType
Dim ii
'获取数据库类型
strType = ""
strTemp = PickRegExp(newConnectionString, "Driver/s*=/s*([A-Za-z0-9_ /*/./(/)/{/}]*)", "$1") ' ODBC Driver
If Len(strTemp) = 0 Then
strTemp = PickRegExp(newConnectionString, "Provider/s*=/s*([A-Za-z0-9_ /*/./(/)/{/}]*)", "$1") ' OLEDB Driver
If Len(strTemp) > 0 Then
strTempType = "OLEDB"
End If
Else
strTempType = "ODBC"
End if
For Each ii In dicConnectionDriver
If InstrRegExp(strTemp, ii) > 0 Then
strTemp = dicConnectionDriver(ii)
Exit For
End If
Next
DataBaseType = strTemp
'获取要操作的数据库
Select Case strTempType
Case "ODBC"
Select Case mDataBaseType
Case "SQLSERVER"
DataBaseServer = PickRegExp(newConnectionString, "Server/s*=/s*([A-Za-z0-9_ /*/(/)/.]*)", "$1")
DataBaseName = PickRegExp(newConnectionString, "Database/s*=/s*([A-Za-z0-9_ /*/(/)]*)", "$1")
Case "ACCESS"
DataBaseServer = ""
DataBaseName = PickRegExp(newConnectionString, "Dbq/s*=/s*([A-Za-z0-9_ :///.]*)", "$1")
Case "MYSQL"
DataBaseServer = ""
DataBaseName = PickRegExp(newConnectionString, "Database/s*=/s*([A-Za-z0-9_ /*/./(/)]*)", "$1")
Case "ORACLE"
DataBaseServer = PickRegExp(newConnectionString, "Server/s*=/s*([A-Za-z0-9_ /*/(/)]*)/s*/./s*([A-Za-z0-9_ /*/(/)]*)", "$1")
DataBaseName = PickRegExp(newConnectionString, "Server/s*=/s*([A-Za-z0-9_ /*/(/)]*)/s*/./s*([A-Za-z0-9_ /*/(/)]*)", "$2")
Case Else
DataBaseServer = ""
DataBaseName = ""
End Select
'获取数据库用户名和密码
DataBaseUser = PickRegExp(newConnectionString, "Uid/s*=/s*([A-Za-z0-9_ ]*)", "$1")
DataBasePass = PickRegExp(newConnectionString, "Pwd/s*=/s*([A-Za-z0-9_ ]*)", "$1")
Case "OLEDB"
Select Case mDataBaseType
Case "SQLSERVER"
DataBaseServer = PickRegExp(newConnectionString, "Data/s*Source/s*=/s*([A-Za-z0-9_ /*/(/)/.]*)", "$1")
DataBaseName = PickRegExp(newConnectionString, "Initial/s*Catalog/s*=/s*([A-Za-z0-9_ /*/(/)]*)", "$1")
Case "ACCESS"
DataBaseServer = ""
DataBaseName = PickRegExp(newConnectionString, "Data/s*Source/s*=/s*([A-Za-z0-9_ :///*/(/)/.]*)", "$1")
Case "MYSQL"
DataBaseServer = ""
DataBaseName = ""
Case "ORACLE"
DataBaseServer = PickRegExp(newConnectionString, "Data/s*Source/s*=/s*([A-Za-z0-9_ :///*/(/)/.]*)/.([A-Za-z0-9_ :///*/(/)/.]*)", "$1")
DataBaseName = PickRegExp(newConnectionString, "Data/s*Source/s*=/s*([A-Za-z0-9_ :///*/(/)/.]*)/.([A-Za-z0-9_ :///*/(/)/.]*)", "$2")
Case Else
DataBaseServer = ""
DataBaseName = ""
End Select
'获取数据库用户名和密码
DataBaseUser = PickRegExp(newConnectionString, "User Id/s*=/s*([A-Za-z0-9_ ]*)", "$1")
DataBasePass = PickRegExp(newConnectionString, "Password/s*=/s*([A-Za-z0-9_ ]*)", "$1")
End Select
If Err.Number <> 0 Then
DataBaseType = ""
DataBaseServer = ""
DataBaseName = ""
DataBaseUser = ""
DataBasePass = ""
ErrorNO = Err.Number
Err.Clear
End If
End Property
' Implements
' Procedures
' 构造函数(VB)
Private Sub Class_Initialize()
On Error Resume Next
'初始化数据
mClassName = "Mathsfield_Data"
Set objConn = Server.CreateObject("ADODB.Connection")
mDataBaseType = "SQLSERVER"
mDataBaseServer = ""
mDataBaseName = ""
mDataBaseUser = ""
mDataBasePass = ""
mConnectionString = ""
ErrorNO = 0
Set dicConnectionString = Server.CreateObject("Scripting.Dictionary")
'********************************************************************************
'Begin>>>
'连接字符串正则表达式列表
'
'MicroSoft SQL Server:SQLSERVER
'MicroSoft Access:ACCESS
'MySQL:MYSQL
'Oracle:ORACLE
'********************************************************************************
'ODBC连接
dicConnectionString.Add "ODBC_SQLSERVER", "Driver={Sql Server};Server=[DataBaseServer];Database=[DataBaseName];Uid=[DataBaseUser];Pwd=[DataBasePass];"
dicConnectionString.Add "ODBC_ACCESS", "Driver={Microsoft Access driver(*.mdb)};Dbq=[DataBaseName];Uid=[DataBaseUser];Pwd=[DataBasePass];"
dicConnectionString.Add "ODBC_MYSQL", "Driver={MySQL};Database=[DataBaseName];Uid=[DataBaseUser];Pwd=[DataBasePass];Option=16386;" ' 这里要视具体情况而定,有时要加上版本号
dicConnectionString.Add "ODBC_ORACLE", "Driver={Microsoft ODBC For Oracle};Server=[DataBaseServer].[DataBaseName];Uid=[DataBaseUser];Pwd=[DataBasePass];"
'OLEDB连接
dicConnectionString.Add "OLEDB_SQLSERVER", "Provider = SQLOLEDB;Data Source = [DataBaseServer];Initial Catalog = [DataBaseName];User Id = [DataBaseUser];Password = [DataBasePass];"
dicConnectionString.Add "OLEDB_ACCESS", "Provider=Microsoft.Jet.Oledb.4.0;Data Source=[DataBaseName];User Id=[DataBaseUser];Password=[DataBasePass];"
dicConnectionString.Add "OLEDB_MYSQL", "Driver={MySQL};Database=[DataBaseName];Uid=[DataBaseUser];Pwd=[DataBasePass];Option=16386;"
dicConnectionString.Add "OLEDB_ORACLE", "Provider = Oraoledb.Oracle;Data Source = [DataBaseServer].[DataBaseName];User Id = [DataBaseUser];Password = [DataBasePass];"
'********************************************************************************
'连接字符串正则表达式列表
'
'MicroSoft SQL Server:SQLSERVER
'MicroSoft Access:ACCESS
'MySQL:MYSQL
'Oracle:ORACLE
'<<<End
'********************************************************************************
Set dicConnectionDriver = Server.CreateObject("Scripting.Dictionary")
'********************************************************************************
'Begin>>>
'数据库驱动正则表达式列表
'
'MicroSoft SQL Server:SQLSERVER
'MicroSoft Access:ACCESS
'MySQL:MYSQL
'Oracle:ORACLE
'********************************************************************************
'ODBC连接
dicConnectionDriver.Add "/{/s*SQL/s+Server/s*/}", "SQLSERVER"
dicConnectionDriver.Add "/{/s*Microsoft/s+Access/s+driver/(/*/.mdb/)/s*/}", "ACCESS"
dicConnectionDriver.Add "/{/s*MySQL/s*/}", "MYSQL"
dicConnectionDriver.Add "/{/s*Microsoft/s+ODBC/s+For/s+Oracle/s*/}", "ORACLE"
'OLEDB连接
dicConnectionDriver.Add "/s*SQLOLEDB/s*", "SQLSERVER"
dicConnectionDriver.Add "/s*Microsoft/s*/./s*Jet/s*/./s*Oledb/s*/./s*4/s*/./s*0/s*", "ACCESS"
dicConnectionDriver.Add "/s*OraOLEDB/s*/./s*Oracle/s*", "ORACLE"
'********************************************************************************
'数据库驱动正则表达式列表
'
'MicroSoft SQL Server:SQLSERVER
'MicroSoft Access:ACCESS
'MySQL:MYSQL
'Oracle:ORACLE
'<<<End
'********************************************************************************
Set dicTypeReplaced = Server.CreateObject("Scripting.Dictionary")
'********************************************************************************
'Begin>>>
'数据类型转换用被替换体正则表达式列表
'
'字符串STRING,日期DATE,实数REAL,整数INT,内容TEXT
'********************************************************************************
dicTypeReplaced.Add "STRING", "(/[STRING/])([/s/S]*)(/[/STRING/])"
dicTypeReplaced.Add "DATE", "(/[DATE/])(/d{2}|/d{4})-(/d{1,2})-(/d{1,2})(/[/DATE/])"
dicTypeReplaced.Add "REAL", "(/[REAL/])(/d+|/d+/.?/d*|/d*/.?/d+)(/[/REAL/])"
dicTypeReplaced.Add "INT", "(/[INT/])(/d+)(/[/INT/])"
dicTypeReplaced.Add "TEXT", "(/[TEXT/])([/s/S]*)(/[/TEXT/])"
'********************************************************************************
'数据类型转换用替换体正则表达式列表
'<<<End
'********************************************************************************
Set dicTypeReplace = Server.CreateObject("Scripting.Dictionary")
'********************************************************************************
'Begin>>>
'数据类型转换用替换体正则表达式列表
'
'字符串STRING,日期DATE,实数REAL,整数INT,内容TEXT
'********************************************************************************
'SQL Server
dicTypeReplace.Add "SQLSERVERSTRING", "'$2'"
dicTypeReplace.Add "SQLSERVERDATE", "'$2-$3-$4'"
dicTypeReplace.Add "SQLSERVERREAL", "$2"
dicTypeReplace.Add "SQLSERVERINT", "$2"
dicTypeReplace.Add "SQLSERVERTEXT", "'$2'"
'Access
dicTypeReplace.Add "ACCESSSTRING", "'$2'"
dicTypeReplace.Add "ACCESSDATE", "#$2-$3-$4#"
dicTypeReplace.Add "ACCESSREAL", "$2"
dicTypeReplace.Add "ACCESSINT", "$2"
dicTypeReplace.Add "ACCESSTEXT", "'$2'"
'MySQL
dicTypeReplace.Add "MYSQLSTRING", "'$2'"
dicTypeReplace.Add "MYSQLDATE", "'$2-$3-$4'"
dicTypeReplace.Add "MYSQLREAL", "$2"
dicTypeReplace.Add "MYSQLINT", "$2"
dicTypeReplace.Add "MYSQLTEXT", "'$2'"
'Oracle
dicTypeReplace.Add "ORACLESTRING", "'$2'"
dicTypeReplace.Add "ORACLEDATE", "'$2-$3-$4'"
dicTypeReplace.Add "ORACLEREAL", "$2"
dicTypeReplace.Add "ORACLEINT", "$2"
dicTypeReplace.Add "ORACLETEXT", "'$2'"
'********************************************************************************
'数据类型转换用替换体正则表达式列表
'<<<End
'********************************************************************************
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
End If
End Sub
' 析构函数(VB)
Private Sub Class_Terminate()
On Error Resume Next
'释放对象
dicTypeReplaced.RemoveAll
dicTypeReplace.RemoveAll
dicConnectionDriver.RemoveAll
dicConnectionString.RemoveAll
Set dicTypeReplaced = Nothing
Set dicTypeReplace = Nothing
Set dicConnectionDriver = Nothing
Set dicConnectionString = Nothing
Call DisConnect
Set objConn = Nothing
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
End If
End Sub
' Functions
' 连接数据库,返回值:1-成功;0-失败
Public Function Connect()
On Error Resume Next
If objConn.State <> 0 Then
objConn.Close
End if
mConnectionString = FormatConnectionString("ODBC")
objConn.ConnectionString = mConnectionString
objConn.Open
If Err.Number <> 0 Then
Err.Clear
mConnectionString = FormatConnectionString("OLEDB")
objConn.ConnectionString = mConnectionString
objConn.Open
End If
Connect = 1
If Err.Number <> 0 Then
Connect = 0
mConnectionString = ""
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 断开数据库连接,返回值:1-成功;0-失败
Public Function DisConnect()
On Error Resume Next
If objConn.State <> 0 Then
objConn.Close
End if
mConnectionString = ""
DisConnect = 1
If Err.Number <> 0 Then
DisConnect = 0
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 执行一条返回记录集的SQL语句 ' 返回一个Recordset ' 根据记录集的状态,判断语句是否成功
Public Function RunSQLRecordset(ByVal strSQL)
On Error Resume Next
Dim objRs
Set objRs = Server.CreateObject("ADODB.Recordset")
Set objRs = objConn.Execute(FormatCondition(strSQL))
Set RunSQLRecordset = objRs
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 执行不返回记录集的SQL语句 ' 返回值:1-成功;0-失败
Public Function RunSQLNull(ByVal strSQL)
On Error Resume Next
objConn.Execute FormatCondition(strSQL), , adCmdText + adExcuteNoRecords
RunSQLNull = 1
If Err.Number <> 0 Then
RunSQLNull = 0
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 产生一个查询记录集 ' 返回一个Recordset ' 根据记录集的状态,判断语句是否成功
Public Function SelectRecordset(ByVal strFields, ByVal strTableName, ByVal strCondition)
On Error Resume Next
Dim strSQL, objRs
Set objRs = Server.CreateObject("ADODB.Recordset")
strCondition = Trim(strCondition)
If Len(strCondition) = 0 Then
strCondition = "(1 = 1)"
End If
strSQL = "SELECT " & strFields
strSQL = strSQL & " FROM " & strTable
strSQL = strSQL & " WHERE " & FormatCondition(strCondition)
Set objRs = objConn.Execute(strSQL)
Set SelectRecordset = objRs
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 插入数据,返回值:1-成功;0-失败
Public Function InsertRecord(ByVal strTable, ByVal strFields, ByVal strValues)
On Error Resume Next
Dim strSQL
Dim arrFields, arrValues
Dim intUFields, intLFields
Dim intUValues, intLValues
Dim ii
arrFields = Split(strFields, ",")
arrValues = Split(strValues, ",")
intUFields = Ubound(arrFields)
intLFields = LBound(arrFields)
intUValues = Ubound(arrValues)
intLValues = LBound(arrValues)
If (intUFields - intLFields) <> (intUValues - intLValues) Then
Err.Raise 1000 '自己设置(待续)
End If
If Not (Err.Number <> 0) Then
For ii = intLValues To intUValues
arrValues(ii) = FormatValue(arrValues(ii))
Next
strSQL = "INSERT INTO " & strTable
strSQL = strSQL & " (" & Join(arrFields,", ") & ")"
strSQL = strSQL & " VALUES(" & Join(arrValues,", ") & ")"
objConn.Execute strSQL, , adCmdText + adExcuteNoRecords
End If
InsertRecord = 1
If Err.Number <> 0 Then
InsertRecord = 0
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 插入数据并返回指定字段处数据 ' 返回一个Recordset ' 根据记录集的状态,判断语句是否成功 ' 不安全 不进行值检查
Public Function InsertReturnValue(ByVal strTable, ByVal strFields, ByVal strValues)
On Error Resume Next
Dim strSQL, objRs
Dim arrFields, arrValues
Dim intUFields, intLFields
Dim intUValues, intLValues
Dim ii
Set InsertReturnValue = Server.CreateObject("ADODB.Recordset")
arrFields = Split(strFields, ",")
arrValues = Split(strValues, ",")
intUFields = Ubound(arrFields)
intLFields = LBound(arrFields)
intUValues = Ubound(arrValues)
intLValues = LBound(arrValues)
If (intUFields - intLFields) <> (intUValues - intLValues) Then
Err.Raise 1000 '自己设置(待续)
End If
If Not (Err.Number <> 0) Then
Set objRs = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM " & strTable " Where (1 <> 1)"
With objRs
.CursorType = 2
.LockType = 3
.CursorLocation = 3
.Open strSQL, objConn
.AddNew
For ii = intLFields To intUFields
.Fields(arrFields(ii)) = arrValues(intLValues + ii - intLFields)
Next
If Err.Number = 0 Then
.Update
End If
End With
End If
If Not (Err.Number <> 0) Then
Set InsertReturnValue = objRs
End If
If Err.Number <> 0 Then
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 更新数据,返回值:1-成功;0-失败
Public Function UpdateRecord(ByVal strTable, ByVal strFields, ByVal strValues, ByVal strCondition)
On Error Resume Next
Dim strSQL
Dim arrFields, arrValues
Dim intUFields, intLFields
Dim intUValues, intLValues
Dim ii
arrFields = Split(strFields, ",")
arrValues = Split(strValues, ",")
intUFields = Ubound(arrFields)
intLFields = LBound(arrFields)
intUValues = Ubound(arrValues)
intLValues = LBound(arrValues)
If (intUFields - intLFields) <> (intUValues - intLValues) Then
Err.Raise 1000 '自己设置(待续)
End If
If Not (Err.Number <> 0) Then
strCondition = Trim(strCondition)
If Len(strCondition) = 0 Then
strCondition = "(1 <> 1)"
End If
strCondition = FormatCondition(strCondition)
For ii = intLValues To intUValues
arrValues(ii) = arrFields(intLFields + ii - intLValues) & " = " & FormatValue(arrValues(ii))
Next
strSQL = "UPDATE " & strTable
strSQL = strSQL & " SET " & Join(arrValues, ", ")
strSQL = strSQL & " WHERE " & strCondition
objConn.Execute strSQL, , adCmdText + adExcuteNoRecords
End If
UpdateRecord = 1
If Err.Number <> 0 Then
UpdateRecord = 0
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 删除数据,返回值:1-成功;0-失败 ' 当约束条件为空时,不删除任何数据
Public Function DeleteRecord(ByVal strTable, ByVal strCondition)
On Error Resume Next
Dim strSQL
strCondition = Trim(strCondition)
If Len(strCondition) = 0 Then
strCondition = "(1 <> 1)"
End If
strSQL = "DELETE FROM " & strTable
strSQL = strSQL & " WHERE " & FormatCondition(strCondition)
objConn.Execute strSQL, , adCmdText + adExcuteNoRecords
DeleteRecord = 1
If Err.Number <> 0 Then
DeleteRecord = 0
ErrorNO = Err.Number
Err.Clear
End If
End Function
' 格式化有值参加的字符串,使他符合给定的数据库类型
Private Function FormatValue(ByVal strInput)
On Error Resume Next
Dim arrType, ii
arrType = Array("STRING", "DATE", "REAL", "INT", "TEXT")
For Each ii In arrType
strInput = ReplaceRegExp(strInput, dicTypeReplaced(ii), dicTypeReplace(mDataBaseType & ii))
Next
FormatValue = strInput
End Function
' 格式化条件字符串,使他符合给定的数据库类型 ' 这里包括格式化值与各种运算符
Private Function FormatCondition(ByVal strInput)
On Error Resume Next
FormatCondition = FormatValue(strInput)
End Function
' 产生标准的连接字符串
Private Function FormatConnectionString(ByVal strType)
On Error Resume Next
FormatConnectionString = ""
strType = UCase(Trim(strType))
Select Case strType
Case "ODBC", "OLEDB"
Case Else
strType = "ODBC"
End Select
Select Case mDataBaseType
Case "SQLSERVER"
If Len(mDataBaseServer) * Len(mDataBaseName) > 0 Then
FormatConnectionString = dicConnectionString(strType & "_" & mDataBaseType)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseServer/]", mDataBaseServer)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseName/]", mDataBaseName)
End if
Case "ACCESS"
If Len(mDataBaseName) > 0 Then
FormatConnectionString = dicConnectionString(strType & "_" & mDataBaseType)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseName/]", mDataBaseName)
End if
Case "MYSQL"
If Len(mDataBaseName) > 0 Then
FormatConnectionString = dicConnectionString(strType & "_" & mDataBaseType)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseName/]", mDataBaseName)
End if
Case "ORACLE"
If Len(mDataBaseServer) * Len(mDataBaseName) > 0 Then
FormatConnectionString = dicConnectionString(strType & "_" & mDataBaseType)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseServer/]", mDataBaseServer)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseName/]", mDataBaseName)
End if
End Select
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBaseUser/]", mDataBaseUser)
FormatConnectionString = ReplaceRegExp(FormatConnectionString, "/[DataBasePass/]", mDataBasePass)
End Function
End Class
%>
类测试: