（原创）自动获取表格数据添加，修改数据库数据的类

此类个人觉得是很有用的！！！对于以后提交表单数据，不用再一个一个去写了，直接引用该类，再SAVE或EDIT即可，简单多了，但当然，因为它不是智能的，所以对于某些数据格式是不能做核查的！！使用示例代码如下：

Dim action

action=Request("action")

If action="save" Then

Dim objClass

Set objClass=New SaveFormData

objClass.MDBFile=Server.Mappath("data/data.mdb")

'objClass.SaveRecord "number","*","id"

objClass.SaveRecord "number","Num1,text",""

'objClass.EditRecord "number","*","id=15","id"

Set objClass=Nothing

End If

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"

"http://www.w3.org/TR/html4/loose.dtd">

<html>

<head>

<title>无标题文档</title>

</head>

<body>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

</table>

</form>

</body>

</html>

类的说明：

如果是使用ACCESS数据库，则首先指定数据库的绝对地址！[Obj].MDBFile=“数据库文件地址“

如果不是ACCESS数据库，则指定类对象的CONN属性，示例：Set [Obj].Conn=[Connection对象]

然后就可以使用

[Obj].SaveRecord(“表名“,“填加字段名列表“，“不填加字段名列表”) = 新增加数据

说明：此方法返回True或False,True则新填加新数据成功，否则失败！

“表名”：要填表加新记录数据的数据表名

“填加字段名列表”：新添数据时的字段名，用“逗号”隔开，如：“name,word,sex“

“不填加字段名列表”：添加数据时对此字段列表里包括的字段不进行添加操作。

[Obj].SaveRecord “User“,“*“,“id“

[Obj].EditRecord(“表名“，“修改字段名列表“，“修改条件”，“不修改字段列表“）=修改某条数据

“表名”，“修改字段列表”和“不修改字段列表”同SAVERECORD方法一样！

“修改条件”：SQL查询条件，不带“WHERE”

示例：[Obj].EditRecord “User“,“Pass,Sex“,“id=22“,““

注意：“填加字段列表”和“修改字段列表”可以使用“”值或“*”值，表明修改所有字段，但建议此时“不填加字段名列表”和“不修改字段名列表”里写上“自动增加”型的字段名，要不然填加或修改数据时将会失败！

类代码：

'/*****************************************************************************************

Class SaveFormData

Private C_ErrNumber '错误返回代码

Private C_NumericAllowNull '数字型字段时是否允许接收非数字值,True = 可以(非数字值时用0代替) False = 不可以(非数字值时将会出错,ErrNumber = 9)

Private C_DateTimeAllowNull '日期时间型字段时是否允许接收非日期时间,True = 可以(非日期时间值时用(Now)代替) False = 不可以(非日期时间值时将会出错,ErrNumber = 10)

Private C_Conn '数据库CONN连接对象

Private C_MDBFile 'ACCESS数据库文件地址,如果不是设置CONN属性,则该属性一定不能为空!

Private Sub Class_Initialize

C_Conn=Null

C_NumericAllowNull=True

C_DateTimeAllowNull=True

End Sub

Private Sub Class_Terminate

If Not IsNothing(C_Conn) Then

C_Conn.Close

Set C_Conn=Nothing

End If

End Sub

'/***************************************************************************

'/* 设置/返回Conn对象

'/*说明：添加这个是为了其它数据库(如：MSSQL)

'/***************************************************************************

Public Property Set Conn(sNewValue)

On Error Resume Next

If Not IsNothing(sNewValue) Then

C_Conn.Close

Set C_Conn=Nothing

End If

Set C_Conn=sNewValue

End Property

Public Property Get Conn

If Not IsNothing(C_Conn) Then

Set Conn=C_Conn

Else

Conn=Null

End If

End Property

'/***************************************************************************

'/* 设置/返回数据库文件

'/*说明：

'/***************************************************************************

Public Property Let MDBFile(sNewValue)

If Trim(sNewValue)<>C_MDBFile Then '如果数据库文件改变则重新建立CONN对象

C_MDBFile=Trim(sNewValue)

Call ReCreateConn

End If

End Property

Public Property Get MDBFile

MDBFile=C_MDBFile

End Property

'/***************************************************************************

'/* 设置/返回错误代码

'/*说明：

'/***************************************************************************

Public Property Get ErrNumber

ErrNumber=C_ErrNumber

End Property

Public Sub ClearErr

C_ErrNumber=0

End Sub

'/***************************************************************************

'/* 设置/返回NumericAllowNull(数值型字段是否允许空值)

'/*说明：

'/***************************************************************************

Public Property Let NumericAllowNull(sNewValue)

C_NumericAllowNull=CBool(sNewValue)

End Property

Public Property Get NumericAllowNull

NumericAllowNull=C_NumericAllowNull

End Property

'/***************************************************************************

'/* 设置/返回DateTimeAllowNull(数值型字段是否允许空值)

'/*说明：

'/***************************************************************************

Public Property Let DateTimeAllowNull(sNewValue)

C_DateTimeAllowNull=CBool(sNewValue)

End Property

Public Property Get DateTimeAllowNull

DateTimeAllowNull=C_DateTimeAllowNull

End Property

'/***************************************************************************

'/* 通过数据库的所有字段表进行获取数据并保存

'/*说明：sTable = 表名 sFields = 要保存的字段名 NotFields = 不保存的字段名

'/***************************************************************************

Public Function SaveRecord(ByVal sTable,ByVal sFields,ByVal NotFields)

On Error Resume Next

Dim Rs,i,sText,sItem

Dim dArray()

Call InitConn

If IsNull(C_Conn) Then

ErrNumber = 1 'ErrNumber = 1 保存数据进数据库时出未知错误

SaveRecord=False

Exit Function

End If

Set Rs = server.CreateObject("ADODB.Recordset")

If Trim(sFields)="" Then sFields="*"

NotFields=","&NotFields&","

Rs.Open "Select "&sFields&" From ["&sTable&"]",C_Conn,1,3

ReDim dArray(Rs.Fields.Count-1) '临时存放数据数组

For i=0 To Rs.Fields.Count-1

Set sItem=Rs.Fields.Item(i)

If InStr(NotFields,","&sItem.Name&",")<1 Then '排除字段

dArray(i)=TSpace(Request(sItem.Name)) '取得表格数据

If IsTextFields(sItem.Type) Then '如果是字符字段则取得字段大小的数据

dArray(i)=Left(dArray(i),sItem.DefinedSize)

ElseIf IsNumericFields(sItem.Type) Then '如果是数值型字段,则判断是否是数值否则不给予添加

If Not IsNumeric(dArray(i)) Then

If C_NumericAllowNull Then

dArray(i)=0

Else

ErrNumber = 9 'ErrNumber = 9 (获取的是非数字值)

SaveRecord=False

Exit Function

End If

ElseIf IsDateTimeFields(sItem.Type) Then '日期时间型字段

If Not IsDate(dArray(i)) Then

If C_DateTimeAllowNull Then

dArray(i)=Date

Else

ErrNumber = 10 'ErrNumber = 10 (获取的是非日期时间型)

SaveRecord=False

Exit Function

End if

End If

'添加进数据库

Rs.AddNew

For i=0 To Rs.Fields.Count-1

Set sItem=Rs.Fields.Item(i)

If InStr(NotFields,","&sItem.Name&",")<1 Then

Rs(sItem.Name)=dArray(i)

End If

If Err.Number<>0 Then

ErrNumber = 1 'ErrNumber = 3 保存数据进数据库时出未知错误

SaveRecord=False

Err.Clear

Exit Function

End If

Rs.Update

Rs.Close

Set Rs=Nothing

Erase dArray '清除数组数据

If Err.Number<>0 Then

ErrNumber = 1 'ErrNumber = 1 保存数据进数据库时出未知错误

SaveRecord=False

Err.Clear

Else

SaveRecord=True

End If

End Function

'/***************************************************************************

'/* 通过数据库的所有字段表进行获取数据并保存

'/*说明：sTable = 表名 sWhere =查询的条件 sFields = 要修改数据的列表名

'/***************************************************************************

Public Function EditRecord(ByVal sTable,ByVal sFields,ByVal sWhere,ByVal NotFields)

On Error Resume Next

Dim Rs,i,sText,sItem

Dim dArray()

Call InitConn

If IsNull(C_Conn) Then

ErrNumber = 3 'ErrNumber = 1 保存数据进数据库时出未知错误

EditRecord=False

Exit Function

End If

Set Rs = server.CreateObject("ADODB.Recordset")

If Trim(sFields)="" Then sFields="*"

If Trim(sWhere)="" Then sWhere="1=1"

NotFields=","&NotFields&","

Rs.Open "Select "&sFields&" From ["&sTable&"] Where "&sWhere,C_Conn,1,3

ReDim dArray(Rs.Fields.Count-1) '临时存放数据数组

For i=0 To Rs.Fields.Count-1

Set sItem=Rs.Fields.Item(i)

If InStr(NotFields,","&sItem.Name&",")<1 Then

dArray(i)=TSpace(Request(sItem.Name)) '取得表格数据

If IsTextFields(sItem.Type) Then '如果是字符字段则取得字段大小的数据

dArray(i)=Left(dArray(i),sItem.DefinedSize)

ElseIf IsNumericFields(sItem.Type) Then '如果是数值型字段,则判断是否是数值否则不给予添加

If Not IsNumeric(dArray(i)) Then

If C_NumericAllowNull Then

dArray(i)=0

Else

ErrNumber = 9 'ErrNumber = 9 (获取的是非数字值)

EditRecord=False

Exit Function

End If

ElseIf IsDateTimeFields(sItem.Type) Then '日期时间型字段

If Not IsDate(dArray(i)) Then

If C_DateTimeAllowNull Then

dArray(i)=Date

Else

ErrNumber = 10 'ErrNumber = 10 (获取的是非日期时间型)

EditRecord=False

Exit Function

End if

End If

'修改数据库

For i=0 To Rs.Fields.Count-1

Set sItem=Rs.Fields.Item(i)

If InStr(NotFields,","&sItem.Name&",")<1 Then

Rs(sItem.Name)=dArray(i)

End If

If Err.Number<>0 Then

ErrNumber = 3 'ErrNumber = 3 保存数据进数据库时出未知错误

EditRecord=False

Err.Clear

Exit Function

End If

Rs.Update

Rs.Close

Set Rs=Nothing

Erase dArray '清除数组数据

If Err.Number<>0 Then

ErrNumber = 3 'ErrNumber = 3 保存数据进数据库时出未知错误

EditRecord=False

Err.Clear

Else

EditRecord=True

End If

End Function

'/***************************************************************************

'/* 初始化Adodb.Connection组件对象

'/*

'/***************************************************************************

Private Sub InitConn()

On Error Resume Next

Dim ConnStr

If IsNothing(C_Conn) Then

If C_MDBFile="" Then

C_Conn=Null

C_ErrNumber = 8 'ErrNumber = 8 (打开数据库出错)

Exit Sub

Else

Set C_Conn=Server.CreateObject("ADODB.Connection")

ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & C_MDBFile

C_Conn.Open ConnStr

If Err.Number<>0 Then

C_ErrNumber = 8 'ErrNumber = 8 (打开数据库出错)

Err.Clear

C_Conn=Null

Exit Sub

End If

End Sub

Private Sub ReCreateConn()

On Error Resume Next

Dim ConnStr

If Not IsNothing(C_Conn) Then

C_Conn.Close

Else

Set C_Conn=Server.CreateObject("ADODB.Connection")

End If

ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & C_MDBFile

C_Conn.Open ConnStr

If Err.Number<>0 Then

C_ErrNumber = 8 'ErrNumber = 8 (打开数据库出错)

Err.Clear

C_Conn=Null

End If

End Sub

Private Function TSpace(ByVal sVal)

sVal=Trim(sVal)

sVal=Replace(sVal,"'","''")

TSpace=sVal

End Function

'/**字段的Type属性集*******

'/*Type = 2 整形

'/*Type = 3 长整形

'/*Type = 4 单精度形

'/*Type = 5 双精度形

'/*Type = 6 货币形

'/*Type = 7 日期时间

'/*Type = 17 字节形

'/*Type = 11 逻辑形

'/*Type = 202 文本型

'/*Type = 203 备注型

'/*Type = 205 OLE对象

Private Function IsNumericFields(ByVal iType)

If iType=2 Or iType=3 Or iType=4 Or iType=5 Or iType=6 Then

IsNumberFields=True

Else

IsNumberFields=False

End If

End Function

Private Function IsTextFields(ByVal iType)

If iType=202 Then

IsTextFields=True

Else

IsTextFields=False

End If

End Function

Private Function IsDateTimeFields(ByVal iType)

If iType=7 Then

IsDateTimeFields=True

Else

IsDateTimeFields=False

End If

End Function

'/**********************************************************************************

'/* 函数名：判断OBJ对象是否是空值

'/**********************************************************************************

Private Function IsNothing(Obj)

If Not IsObject(Obj) Then

IsNothing=True

Exit Function

End If

If Obj Is Nothing Then

IsNothing=True

Exit Function

End If

If IsNull(Obj) Then

IsNothing=True

Exit Function

End If

IsNothing=False

End Function

End Class