ASP数据操作类-查询-筛选-更新
最近太忙了，博客老是忘记更新。今天周末，说什么也要抽点时间交点作业出来。
还是老话题，ASP的一点东西，关于ASP的这些，抖完了，真不想再碰了。这次是ASP中的核心点-数据库操作。还是老样子，写成了一个操作类，反正自己用着挺方便的。
这个类也是经过了两期的进化，第一期很久了，是第一次写ASP系统的时候写的，只是为了组装SQL语句，类名就起了个SQLMake，后来又有了新想法，就完全重写了。这个重写的类，到现在经过差不多两年的使用，完善，自觉得功能和实用性上没什么挑踢的了，特此共享出来。虽然ASP没什么前途了，俗话说，破家值万贯，自己花心思做出来的东西，再没用处，也是宝贝。再者，天下语言是一家，虽然是用VBS写的类，但都是程序的道理，方便的时候我会把它重写成php,.net甚至java。这也是一些朋友的提议。哈哈，不扯了，放代码。
这是类源码(核心类有两个，一个是xTable,一个是xTableJoin用于联表)，仅供过目，使用的时候还需要一些常量和函数，下面都打包好了。
'+++++++++++++++++++++++++++++++++++
'数据表操作通用类
'部分操作要求数据表必须有名称为 前缀+id的递增字段
'需要指定一个打开的数据库链接
'shirne@126.com
'http://www.shirne.com
'+++++++++++++++++++++++++++++++++++
Class xTable
Public Fields '字段(Array)
Public fLmt '起始条目
Public nLmt '条数
Public Pre '表前缀
Public PM '主键
Public Mode 'sql模式,区别sql server(1)和access(0)
Private Tbl '表名称(String)
Private Value '需要添加或更新的值(Dic)
Private sWhere '条件(String)
Private sIden 'where条件最后的连接符
Private sOrder '排序(String)
Private RsOrder '反向排序(String)用于分页记录
Private sGroup '分组
Private Rs 'RecordSet
Private Count_ '记录集数目缓存
Private SQL '最后一次查询的sql语句
Private conn '用于连接数据库的连接
Private LastError '错误信息
Private BrackCount '子条件查询的未闭合括号数
Private bakBrackCount
Public DelBack '列名,删除记录时返回这些字段的值供后期处理，数据保留在RetainArr中
Public RetainData '保留数据，Update更新后将旧数据保留在Dictionary中
Public RetainArr '批量更新或删除操作，将旧数据保存在二维数组中
Public InsertID '插入操作成功后返回插入新记录的ID
Public numRows '返回批量操作影响的行数
'构造函数
Private Sub Class_Initialize
Tbl = ""
Pre = ""
DelBack = "" '"image,thumb,picture,view,content,files"
Mode = 1
fLmt = 0 '
nLmt = 10 '默认选择条目
BrackCount = 0
bakBrackCount=0
Set Rs = Server.CreateObject("ADODB.RecordSet")
End Sub
Private Sub Class_Terminate
If rs.State<>0 Then rs.Close
Set rs=Nothing
Set conn = Nothing
End Sub
Public Property Let ActiveConnection( c)
Set conn=c
End Property
'获取错误信息
Public Property Get getError()
getError = LastError
End Property
Public Property Get getSQL
getSQL = SQL
End Property
'获取参数
Public Property Get Param( key)
Select Case Lcase(key)
Case "table","name"
Param = Right(Tbl, Len(Tbl)-Len(Pre))
Case "where"
Param = sWhere
Case "iden"
Param = sIden
Case "order"
Param = sOrder
Case "rorder"
Param = RsOrder
Case "fields"
Param = Fields
Case "limit"
Param = Array(fLmt, nLmt)
Case "group"
Param = sGroup
Case "pm","pk","primarykey"
Param = PM
Case Else
Param = Empty
End Select
End Property
Public Sub Reset()
If rs.State<>0 Then rs.Close
Tbl = ""
PM = ""
fLmt = 0
nLmt = 10
Count_ = 0
sWhere = ""
sOrder = ""
RsOrder = ""
sIden = ""
sGroup = ""
Set Value=Nothing
Fields = Empty
End Sub
Public Sub ResetWhere
sWhere = ""
End Sub
Public Sub ResetOrder
sOrder = ""
RsOrder = ""
End Sub
'设定表名称
Public Property Let Table( tb)
If tb&"" = "" Then cError "xTable.Table: 表名不能为空"
Reset
tbl = pre & tb
End Property
Public Sub Trancate()
Select Case(Mode)
Case 1
conn.Execute "TRANCATE TABLE ["& tbl &"]"
Case 0
conn.Execute "DELETE FROM ["& tbl &"] WHERE 1=1"
conn.Execute "Alter table ["& tbl &"] Alter Column ["& PM &"] Counter(1,1)"
End Select
End Sub
Public Sub InitFields()
Dim F, I
If IsEmpty(Application.Contents(Pre & "table_" & tbl)) Then
SQL = "SELECT * FROM ["& tbl &"] WHERE 1<>1"
rs.Open SQL,conn,1,1
ReDim fields(rs.Fields.Count-1)
i=0
For Each F In rs.Fields
Fields(i)= F.Name
If PM="" Then PM=Fields(i)
i=i+1
Next
rs.Close
If USE_APPCache Then
Application.Lock()
Application.Contents(Pre & "table_" & tbl)=Fields
Application.UnLock()
End If
Else
Fields = Application.Contents(Pre & "table_" & tbl)
If PM="" Then PM=Fields(0)
End If
End Sub
Public Function FieldExists( fld)
Dim I
FieldExists=False
For i=0 To Ubound(Fields)
If StrComp(fld,Fields(i),1)=0 Then
FieldExists= True
Exit For
End If
Next
End Function
'以下几个属性调用form后才能调用
'============================================
'过滤值,键名,类型,参数,不存在返回False
Public Property Get filtVal( key, tp, l)
filtVal = False
If value.Exists( key) Then
Select Case Lcase(tp&"")
Case "1","number","n" '纯数字,l为默认值
If IsNumeric(value(key)) And value(key)<>"" Then value(key)=Int(value(key)) Else value(key)=l
filtVal=True
Case "2","date","d" '日期,l为默认值
If IsDate(value(key)) Then value(key)=Cdate(value(key)) Else value(key)=l
filtVal=True
Case "3","cutstr" '截取定长字符,l为长度
Value(key) = Left(value(key)&"",l)
filtVal=True
Case "4","limit" '限制长度
If Len(Value(key))>l Then filtVal=True
Case "5","nohtml" '过滤html
Value(key) = nohtml(Value(key))
filtVal=True
Case "6","encodehtml" '编码html
Value(key) = Server.HTMLEncode(Value(key))
filtVal=True
Case "7","bool","boolean","b" '转换布尔值,l为true的等价
value(key) = value(key)=l
filtVal=True
Case "8","invalue" '值在范围内,l为数组,不在时取第一个值
If Value(key)="" Then
Value(key)=l(0)
Else
If InStr("|"&Join(l,"|")&"|","|"&Value(key)&"|")<1 Then
Value(key)=l(0)
End If
End If
Case "9","state" '状态值设置
If Value(key)="1" Then
Value(key) = 1
Else
Value(key) = 0
End If
Case "10","noxss" 'XSS过滤
Value(key) = noXSS(Value(key))
End Select
End If
End Property
'设定值
Public Property Let Item( key, val)
If value.Exists( key) Then
value(key) = val
Else
value.Add key, val
End If
End Property
'获取值
Public Default Property Get Item( key)
If Value.Exists( key) Then
Item = Value(key)
Else
Item = ""
End If
End Property
Public Function Exists( fld)
Exists= Value.Exists(fld)
End Function
'删除不需更新的值并返回
Public Function DelItem(key)
If Value.Exists( key) Then
DelItem = Value(key)
Value.Remove(key)
Else
DelItem = Empty
End If
End Function
'===========================================
'从form或其它类Dictionary获取对应值,传入表列名的数组
Public Sub Form( f, Dic)
check
Dim I
If Not IsArray(f) Then f=Fields
Set value = Server.CreateObject("Scripting.Dictionary")
value.CompareMode = 1 '文本比较模式,不区分大小写
If TypeName(Dic)="Dictionary" Or TypeName(Dic)="IRequestDictionary" Then
For i=0 To Ubound(Fields)
If Not IsEmpty(Dic(Fields(i))) Then
value.Add Fields(i),CStr(Dic(Fields(i)))
End If
Next
End If
End Sub
'开启子条件
Public Function OpenBrack(l)
sIden = sIden & String(l,"(")
bakBrackCount = bakBrackCount+l '暂存开启数目,在调用之后才添加上去
'BrackCount = BrackCount + l
End Function
'结束子条件
Public Function CloseBrack(l)
If l>BrackCount Then l=BrackCount
sWhere = sWhere & String(l,")")
BrackCount = BrackCount - l
End Function
Public Function CheckBrack()
If BrackCount>0 Then
sWhere = sWhere & String(BrackCount,")")
End If
End Function
'解析where条件
'格式一,直接使用where字符串(不含where)
'格式二,使用id作为主键条件
'格式三,使用数组,特殊的连接符会强制类型(如:位操作强制数值,like强制字符,in强制字符或数字)
'Array(
' Array("键名","值"[,值类型s[,连接符=[,后向连接AND]]]),
' "键名=值"
' 主键值
' …
')
'值类型s(字符串),i(数字),b(布尔),d(日期)
Public Property Let Where(ByVal wh)
If Not IsArray(wh) Then
If Trim(wh&"")<>"" Then
If IsNumeric(wh) Then wh= Array(Array(PM, wh,"I", "=", "AND"))
Else
Exit Property
End If
End If
If IsArray(wh) Then
If sWhere="" Then sWhere=" WHERE "
Dim I, j, comp, vType, l, continue, sIdenExp
If Not IsArray(wh(0)) Then
If RegTest("^[\w\d]+$",wh(0)&"") Then
wh = Array(wh)
End If
End If
For i=0 To Ubound(wh)
comp="="
vType="s"
If IsArray(wh(i)) Then
l=Ubound(wh(i))
If l<1 Then cError "xTable.Where: 条件传入格式不正确"
'If Len(wh(i)(1))>100 Then cError "xTable.Where: 查询值太长,不能超过100个字符"
If sIden<>"" Then
sWhere=sWhere & sIden
If InStr(sIden,"(")>0 Then
BrackCount = BrackCount + bakBrackCount
bakBrackCount = 0
End If
End If
'检查操作符
If l>2 Then comp=Ucase(Trim(wh(i)(3)))
'检查值类型
If l>1 Then vType=wh(i)(2)
continue = True
'拼接操作符
Select Case comp
Case "=",">","<",">=","<=","<>"
sWhere = sWhere & "["& wh(i)(0) &"] "& comp &" "
Case "BAND","BOR","BXOR"
vType="I"
sWhere = sWhere & "(["& wh(i)(0) &"] " & comp &" "& parseInt(wh(i)(1)) &") = "
Case "LIKE"
vType="s"
sWhere = sWhere & "["& wh(i)(0) &"] LIKE "
Case "INSTR"
continue = False
vType="s"
sWhere = sWhere & " CHARINDEX('"& Escape(Trim(wh(i)(1))) &"',["& wh(i)(0) &"])>0 "
Case "IN"
continue = False
sWhere = sWhere &" ["& wh(i)(0) &"] IN ("
If Not IsArray(wh(i)(1)) Then
wh(i)(1)=Split(wh(i)(1)&"",",")
End If
Select Case vType
Case "I"
For j=0 To Ubound(wh(i)(1))
wh(i)(1)(j)= parseLng(wh(i)(1)(j))
Next
sWhere = sWhere & Join(wh(i)(1),", ")
Case Else
For j=0 To Ubound(wh(i)(1))
wh(i)(1)(j)= Escape(Trim(wh(i)(1)(j)))
Next
sWhere = sWhere &"'"& Join(wh(i)(1),"', '") &"' "
End Select
sWhere = sWhere &") "
Case "BETWEEN"
continue = False
wh(i)(1) = Split(wh(i)(1)&",",",")
If vType = "I" Then
wh(i)(1)(0) = parseInt(wh(i)(1)(0))
wh(i)(1)(1) = parseInt(wh(i)(1)(1))
Else
wh(i)(1)(0) = "'"&Escape(wh(i)(1)(0))&"'"
wh(i)(1)(1) = "'"&Escape(wh(i)(1)(1))&"'"
End If
sWhere = sWhere & "["& wh(i)(0) &"] BETWEEN "& wh(i)(1)(0) &" AND "& wh(i)(1)(1)
Case Else
cError "xTable.Where: 暂时不支持的数据库操作:"& comp
End Select
If continue Then
Select Case vType
Case "I"
sWhere = sWhere & parseLng(wh(i)(1)) &" "
Case "b"
sWhere = sWhere & Cbol(wh(i)(1)) &" "
Case Else 's
sWhere = sWhere &"'"& Escape(wh(i)(1)) &"' "
End Select
End If
sIden = " AND "
If l>3 Then
If Ucase(Trim(wh(i)(4)))="OR" Then
sIden = " OR "
End If
End If
ElseIf wh(i)&""<>"" Then
If sIden<>"" Then sWhere=sWhere & sIden
If IsNumeric(wh(i)) Then
sWhere=sWhere & "["& PM &"]="& parseLng(wh(i))
Else
'提取条件结尾的连接符
Set sIdenExp=REObject("\s+(and|or)\s*$","I").Execute(wh(i))
If sIdenExp.Count>0 Then
wh(i) = Left(wh(i), sIdenExp.Item(0).FirstIndex)
sIden = " "&Ucase(Trim(sIdenExp.Item(0).Value))&" "
Else
sIden = " AND "
End If
sWhere=sWhere & wh(i)
End If
End If
Next
Else
If sWhere="" Then
sWhere=" WHERE "
Else
sWhere=sWhere & sIden
End If
'提取条件结尾的连接符
Set sIdenExp=REObject("\s+(and|or)\s*$","I").Execute(wh)
If sIdenExp.Count>0 Then
wh = Left(wh, sIdenExp.Item(0).FirstIndex)
sIden = " "&Ucase(Trim(sIdenExp.Item(0).Value))&" "
Else
sIden = " AND "
End If
sWhere = sWhere & wh
End If
End Property
'排序,注意:如果是分页记录，排序的字段一定要在选取的字段内有
'格式一,直接使用单个字段,默认为ASC 如: "id"
'格式二,使用数组 如:Array("id asc","date desc")
'格式三,直接指字排序字符串(不含order)如: "id asc, date desc"
Public Property Let Order(ByVal od)
Dim Mth, oMth
If IsArray(od) Then
od = Join(od, ", ")
End If
Set oMth=REObject("(?:\b|\[)([\w\d]+)(?:\]|\b)(?:\s+(asc|desc)\b)?","ig").Execute(od)
For Each Mth In oMth
If sOrder<>"" Then sOrder = sOrder &", "
If RsOrder<>"" Then RsOrder = RsOrder &", "
sOrder = sOrder &" ["& Mth.subMatches(0) &"] "
RsOrder = RsOrder &" ["& Mth.subMatches(0) &"] "
If IsEmpty(Mth.subMatches(1)) Or Ucase(Mth.subMatches(1))="ASC" Then
sOrder = sOrder & " ASC "
RsOrder = RsOrder & " DESC "
Else
sOrder = sOrder & " DESC "
RsOrder = RsOrder & " ASC "
End If
Next
End Property
Public Property Let Group(ByVal gp)
Dim Mth, oMth
If IsArray(gp) Then
od = Join(gp, ", ")
End If
Set oMth=REObject("(?:\b|\[)([\w\d]+)(?:\]|\b)","g").Execute(gp)
For Each Mth In oMth
If sGroup<>"" Then
sGroup = sGroup &", "
Else
sGroup = " GROUP BY "
End If
sGroup = sGroup &" ["& Mth.subMatches(0) &"] "
Next
End Property
'使用Array传参必须传两个
Public Property Let Limit( lmt)
If IsArray(lmt) Then
fLmt = lmt(0)
nLmt = lmt(1)
ElseIf InStr(lmt,",")<1 And IsNumeric(lmt) Then
fLmt = 0
nLmt = Int(lmt)
ElseIf InStr(lmt&"",",")>0 Then
lmt = Split(lmt,",")
fLmt = Int(lmt(0))
nLmt = Int(lmt(1))
End If
End Property
'更新单个记录,返回旧的内容以便处理文件
Public Property Get Update( id)
Dim I, c
Update = False
On Error Resume Next
If Trim(id)<>"" Then Where=id
LastError = ""
SQL = "SELECT "& sField(Value) &" FROM ["& tbl &"]"& sWhere
rs.Open SQL, conn,1,3
Set c = Server.CreateObject("Scripting.Dictionary")
If Not rs.EOF Then
'If PM<>"" Then delItem(PM)
For Each I In Value
c.Add I, rs(i).Value
If i<>PM Then
rs(i) = AutoType(rs(i),Value(i))
End If
If Err Then Exit For
Next
If Err Then
LastError = Err.Number &":"& Err.Description
Err.Clear
Else
rs.Update
If Err Then
LastError = Err.Number &":"& Err.Description
Err.Clear
Else
Update = True
End If
End If
Else
LastError = "xTable.Update:记录不存在"
End If
rs.Close
Set RetainData = c
On Error GoTo 0
End Property
'编辑记录,返回可编辑的Recordset
Public Property Get Edit( fl)
Set Edit=Server.CreateObject("ADODB.RecordSet")
SQL = "SELECT "& sField(fl) &" FROM ["& tbl &"]"& sWhere
Edit.Open SQL,conn,1,3
End Property
'按ID删除记录,返回一个包含了指定字段的二维数组，如果没有包含这些字段，则返回删除的数目
Public Property Get Delete( idn)
Delete=False
Dim I, id
On Error Resume Next
If IsArray(idn) Then
id=Join(idn, ", ")
Else
id=idn
End If
If id="" Or Not TestBat(id) Then Exit Property
Dim backf
backf = CheckFields(DelBack)
If IsArray(backf) Then
RetainArr = Conn.Execute("SELECT "& sField(backf) &" FROM ["& tbl &"] WHERE ["& PM &"] IN("& id &")").GetRows
End If
SQL = "DELETE FROM ["& tbl &"] WHERE ["& PM &"] IN("& id &")"
Conn.Execute SQL, I
If Err Then
LastError = Err.Number &":"& Err.Description
Else
numRows = I
Delete=True
End If
End Property
'插入记录,返回插入的ID
Public Property Get Insert
Insert=False
Dim I
On Error Resume Next
SQL = "SELECT "& sField(value) &" FROM ["& tbl &"] WHERE 1<>1"
rs.Open SQL, conn,1,3
rs.AddNew
For Each I In Value
If i<>PM Then
rs(i) = AutoType(rs(i),Value(i))
End If
Next
If Err Then
rs.CancelUpdate
LaseError = Err.Number &":"& Err.Description
Err.Clear
Else
rs.Update
If Err Then
LastError = Err.Number &":"& Err.Description
Err.Clear
Else
InsertID=conn.Execute("SELECT MAX(["& PM &"]) FROM ["& tbl &"]")(0)
Insert=True
End If
End If
rs.Close
On Error Goto 0
End Property
'批量更新,返回更新影响的数目
Public Property Get BatchUpdate( val, wh)
Where = wh
If val="" Then
val = ValueToVal(value)
End If
SQl = "UPDATE ["& tbl &"] SET "& val & sWhere
conn.Execute SQL,BatchUpdate
End Property
Private Function ValueToVal(value)
Dim vals, Field, EditRs, oWer, val
oWer = sWhere
sWhere = " 1<>1"
Set EditRs = Edit(value)
sWhere = oWer
For Each Field In EditRs.Fields
If vals<>"" Then vals=vals &", "
val = AutoType(Field,Value(Field.Name))
If TypeName(val)="String" Then
vals = vals &"["& Field.Name &"]='"& val &"'"
ElseIf IsNumeric(val) Then
vals = vals &"["& Field.Name &"]="& val
End If
Next
EditRs.Close
Set EditRs=Nothing
ValueToVal = vals
End Function
'批量删除,返回删除的数目
Public Property Get BatchDel( wh)
Where = wh
SQL = "DELETE FROM ["& tbl &"]"& sWhere
conn.Execute SQL,BatchDel
End Property
'检查某个字段是否有重复值,有则返回true,直接传入条件
Public Function CheckUnique( wh)
CheckUnique = False
Dim nWhere, nIden
nWhere = sWhere
nIden = sIden
ResetWhere
If Count(wh)>0 Then
CheckUnique = True
End If
sWhere = nWhere
sIden = nIden
End Function
'获取单条记录,不存在返回一个包含所有键为空字符串的字典
Public Property Get Record( wh)
check
On Error Resume Next
Dim I, rd
Where = wh
SQL = "SELECT TOP 1 "& sField("") &" FROM ["& tbl &"]"& sWhere & sGroup
rs.Open SQL,conn,1,1
If rs.EOF Then
Set rd = Server.CreateObject("Scripting.Dictionary")
rd.CompareMode = 1
For i=0 To Ubound(fields)
rd.Add fields(i),""
Next
Else
Set rd = rs.Clone
End If
rs.Close
Set Record = rd
End Property
'获取记录集
Public Property Get Records( list)
check
Dim sFields
If sOrder="" Then Order = PM
sFields = sField(list)
'屏蔽超出错误
If fLmt>1 And Count_<fLmt Then fLmt=Count_
If fLmt<1 Then fLmt=1
If nLmt<1 Then nLmt=1
If fLmt<2 Then
SQL = "SELECT TOP "& nLmt & sFields &" FROM ["& tbl &"]"& sWhere & sGroup &" ORDER BY "& sOrder
ElseIf fLmt>1 Then
SQL = "SELECT TOP "& nLmt &" * FROM (SELECT TOP "& (Count_ - fLmt ) & sFields &" FROM ["& tbl &"]"& sWhere & sGroup &" ORDER BY "& RsOrder&") a ORDER BY "& sOrder
End If
On Error Resume Next
rs.Open SQL,conn,1,1
If Err Then
cError "xTable.Records:错误<br />SQL:"& SQL &"<br />"
End If
Set Records=rs.Clone
rs.Close
End Property
Public Property Get Count( wh)
Where = wh
SQL = "SELECT COUNT(0) FROM ["& tbl &"]"& sWhere & sGroup
On Error Resume Next
Count_=conn.Execute(SQL)(0)
If Err Then
cError "xTable.Count:错误<br />SQL:"& SQL &"<br />"
End If
Count = Count_
End Property
Public Property Get Sum(fld, wh)
Where = wh
SQL = "SELECT SUM(["& fld &"]) FROM "& tbl & sWhere & sGroup
On Error Resume Next
Sum=conn.Execute(SQL)(0)
If Err Then
cError "xTable.Count:错误<br />SQL:"& SQL &"<br />"
End If
If IsNull(Sum) Then Sum=0
End Property
Public Property Get stat(fld, wh, typ)
Where = wh
Select Case Lcase(typ)
Case "sum","avg","max","min","first","last","stdev","stdevp","var","varp"
SQL = "SELECT "& Ucase(typ) &"(["& fld &"]) FROM "& tbl & sWhere & sGroup
On Error Resume Next
stat=conn.Execute(SQL)(0)
If Err Then
cError "xTable.Count:错误<br />SQL:"& SQL &"<br />"
End If
If IsNull(stat) Then stat=0
Case Else
stat = 0
End Select
End Property
'联表参数
'oTbl -- 表名称(不含前缀)
'tFld -- 联表时选取的字段
'Fld -- 联表时的On条件,外联表不需要
'外联表
Public Function Ojoin( sTbl, tFld)
Dim xJoin
Set xJoin=new xTableJoin
xJoin.ActiveConnection = conn
xJoin.AddTable "",Me,Array("id")
xJoin.AddTable "Outer",getTable(sTbl,tFld)
Set Ojoin = xJoin
End Function
'左联表
Public Function Ljoin( sTbl, tFld, Fld)
Dim xJoin
Set xJoin=new xTableJoin
xJoin.ActiveConnection = conn
xJoin.AddTable "",Me,Array("id")
xJoin.AddTable "Left",getTable(sTbl,tFld), Fld
Set Ljoin = xJoin
End Function
'右联表
Public Function Rjoin( sTbl, tFld, Fld)
Dim xJoin
Set xJoin=new xTableJoin
xJoin.ActiveConnection = conn
xJoin.AddTable "",Me,Array("id")
xJoin.AddTable "Right",getTable(sTbl,tFld), Fld
Set Rjoin = xJoin
End Function
'内联表
Public Function Ijoin( sTbl, tFld, FLd)
Dim xJoin
Set xJoin=new xTableJoin
xJoin.ActiveConnection = conn
xJoin.AddTable "",Me,Array("id")
xJoin.AddTable "Inner",getTable(sTbl,tFld), Fld
Set Ijoin = xJoin
End Function
'联合表
Public Function Union( oTbl)
End Function
'依次检查输入的数组中是否包含在该表已指定的列名中,返回被包含的列名数组
'如果没有，则返回False
Private Function CheckFields( f)
Dim AllFields, rtn(), I, j
AllFields=Lcase(","&Join(Fields,",")&",")
j = 0
If Not IsArray(f) Then f=Split(f,",")
For i=0 To Ubound(f)
f(i)=Lcase(Trim(f(i)))
If InStr(AllFields,","&f(i)&",")>0 Then
ReDim Preserve rtn(j)
rtn(j) = f(i)
j = j+1
End If
Next
If j<1 Then
CheckFields = False
Else
CheckFields = rtn
End If
End Function
'组装选择字段
Private Function sField( f)
Dim I, a, j
If TypeName(f)="Dictionary" Then
a = f.Keys
Else
If IsArray(f) Then
a = f
ElseIf Len(Trim(f&""))>0 Then
a = Split(f,",")
Else
a = Fields
End If
End If
'去除空字符
For i=0 To Ubound(a)
a(i)=Trim(a(i))
Next
sField = " ["& Join(a, "], [")&"] "
End Function
'安全编码sql字符串,用于查询
Private Function Escape( str)
'删除不可见字符
'转义单引号
Escape = Replace(str,"'","''")
End Function
'自动过滤字段类型
Private Function AutoType( Fld, val)
Select Case Fld.Type
Case adEmpty:AutoType = Empty
Case adTinyInt,adUnsignedTinyInt
AutoType = parseInt(val)
If AutoType>255 Or AutoType<0 Then
AutoType=0
End If
Case adSmallInt
AutoType = parseInt(val)
If AutoType>32767 Or AutoType<-32768 Then
AutoType=0
End If
Case adInteger,adUnsignedInt:AutoType = parseInt(val)
Case adBigInt,adUnsignedBigInt:AutoType = parseLng(val)
'Case adUnsignedTinyInt:AutoType = "TinyInt" 'UnsignedTinyInt
Case adUnsignedSmallInt
AutoType = parseInt(val)
If AutoType>65535 Or AutoType<0 Then
AutoType=0
End If
'Case adUnsignedInt:AutoType = "UnsignedInt"
'Case adUnsignedBigInt:AutoType = "UnsignedBigInt"
Case adSingle:AutoType = parseSng(val) 'Single
Case adDouble:AutoType = parseDbl(val) 'Double
Case adCurrency:AutoType = parseCur(val) 'Currency
Case adDecimal,adNumeric:AutoType = FormatNumber(parseDbl,Fld.NumericScale)
'Case adNumeric:AutoType = "Numeric" 'Numeric
Case adBoolean:AutoType = Cbol(val) 'Boolean
Case adError:AutoType = parseLng(val)
Case adUserDefined:AutoType = val
Case adVariant:AutoType = val
Case adIDispatch:AutoType = val
Case adIUnknown:AutoType = val
Case adGUID:AutoType = Null 'GUID
Case adDATE,adDBDate,adDBTime,adDBTimeStamp
If IsDate(val) Then
AutoType = Cdate(val) 'Date
Else
'If Fld.Value<>"" Then
' AutoType = Fld.Value
'Else
AutoType = NULL
'End If
End If
'Case adDBDate:AutoType = "DBDate"
'Case adDBTime:AutoType = "DBTime"
'Case adDBTimeStamp:AutoType = "DateTime" 'DBTimeStamp
Case adBSTR:AutoType = "BSTR"
Case adChar, adVarChar, adLongVarChar
AutoType = AutoLeftStr( val&"", Fld.DefinedSize)
'Case adVarChar:AutoType = Left(val&"")
'Case adLongVarChar:AutoType = "LongVarChar"
Case adWChar, adVarWChar, adLongVarWChar 'Wchar类型 SQL中为Text
AutoType = Left( val&"", Fld.DefinedSize)
'Case adVarWChar:AutoType = "VarChar" 'VarWChar
'Case adLongVarWChar:AutoType = "Text" 'LongVarWChar
Case adBinary, adVarBinary, adLongVarBinary
AutoType = Left( val&"", Fld.DefinedSize)
'Case adVarBinary:AutoType = "VarBinary"
'Case adLongVarBinary:AutoType = "LongBinary"'LongVarBinary
Case adChapter:AutoType = Null '暂不支持
Case adPropVariant:AutoType = Null
Case Else:AutoType = Null
End Select
End Function
'检查错误
Private Sub check
If tbl="" Then cError "请指定数据表"
If Not IsArray(fields) Then cError "请指定数据列"
End Sub
Private Sub cError( msg)
Response.Write msg
If Err Then
Response.Write("<br>Number:"& Err.Number)
Response.Write("<br>Description:"& Err.Description)
End If
Response.End()
End Sub
End Class
测试代码下载(含核心类及常量，函数库):数据库操作类测试代码
豫公网安备 41112102000155号