ASP模仿asp.net的DataGrid

自动生成表格，自动完成删除，编辑、填加、分页功能，自定义样式表头样式

代码用两个类来实现

一开始考虑得太多，功能想得太强大，通用性越强，asp类跑起来越慢，做到后来没兴趣，还有很多功能没有完成，如字段类型验证，显示图片、控件等，帖出代码供大这一起学习研究，有兴趣的可以将这些功能加上

示例：

set a = new DataGrid
'a.Connstr="Provider=SQLOLEDB.1;User ID=sa;Password=servser;Initial Catalog=temp_blue;Data Source=server;Connect Timeout=30;Auto Translate=True;Packet Size=4096;"
a.Connstr="Provider=Microsoft.Jet.OLEDB.4.0;"&" Data Source="&server.mappath("test.mdb") '连接ACCSS字符串
a.SQLString="select * from table1" '生成datagrid所显示的记录集的sql语句
a.isAddnew = 1 '是否可以填加新记录
a.Table = "table1" 'datagrid控制的主表
a.UniqueField = "ID" '标志字段，所有记录不重复整型即可
a.PagePosition = "down" '分页显示位置，up上面，down下面 updown上下 ,其它为不显示
a.pagesize = 5 '每页显示记录数
a.Pagenumber = 10 '显示页数

a.BorderColor="#ff0000" '默认为效果图显示

a.BackGround="#00ff00" '默认为效果图显示

a.BorderWidth=1 默认为1

a.
set b1 = new column
b1.Field = "id" '此列所绑定的数据库字段
b1.Title = "标志" '标题
b1.Align = "center" ' 对齐方式
a.AddColumn(b1) '把此列插入到datagrid
set b2 = new column
b2.Field="firstname"
b2.Title="姓"
a.AddColumn(b2)

set b3 = new column
b3.Field = "lastname"
b3.Title = "名"
a.AddColumn(b3)

set b4 = new column
b4.Field = "logintimes"
b4.Title = "登陆次数"
b4.ReadOnly = true '设为只读，不会出现在编辑框中和新增记录中
a.AddColumn(b4)

set b5 = new column
b5.Title="编辑"
b5.Columntype ="edit" '编辑列
b5.EditCommandText = "编辑" '编辑按钮文本
a.AddColumn(b5)

set b6 = new column
b6.align = "center"
b6.Width = 200
b6.Columntype = "delete"
b6.DeleteCommandText = "删除按钮"
b6.Title ="删除"
a.AddColumn(b6)
a.CreateGrid()

set b1 = nothing
set b2 = nothing
set b3 = nothing
set b4 = nothing
set b5 = nothing
set b6 = nothing

类文件如下：

<%Class DataGrid
Private pages
Private strSQLString
Public Connstr
Private Columns
Private index
Private strUniqueField,strTable
Private rs
Private strCellspacing,strCellpadding,strCssClass
Private strBorderColorDark,strBorderColorLight,strBackGroundColor
Private intBorderWidth
Private strHeadStyle,strHeadBackgroudColor
Private strStyle,strAlternateStyle
Private UniqueKey,dg_action,currPage
Private actionURL,pageURL,operationURL,formURL
Public PagePosition,Pagesize,Pagenumber

Public isAddnew

Private Sub Class_Initialize()
set Columns = Server.CreateObject("Scripting.Dictionary")
index = 0
Pagesize = 10
Pagenumber = 10
PagePosition = "updown"
strSQLString = Session("DSN")
uniquekey = Request("uniquekey")
dg_action = Request("dg_action")
currPage = Request("Page")
actionURL = Request.ServerVariables("Script_name") & "?page=" & currPage
if dg_action= "edit" then formURL = actionURL& "&dg_action=update&uniquekey="&uniquekey
operationURL = Request.ServerVariables("Script_name") & "?page=" & currPage& "&uniquekey=" & uniquekey
pageURL = Request.ServerVariables("Script_name")&"?1=1"
if currPage = "" or isnull(currPage) then currPage = 1

strBorderColorDark ="#f7f7f7"
strBorderColorLight = "#cccccc"
strBackgroundColor = "#f7f7f7"
strHeadBackgroudColor = "#F2F2F2"
intBorderWidth = 1
strAlternateStyle ="bgcolor=#f6f6f6"
isAddnew = 1
Set rs = Server.CreateObject("Adodb.Recordset")

End Sub

Private Sub Class_Terminate()
rs.close
set rs = nothing
set Columns = nothing
End Sub

Public Property Get SQLString()
SQLString = strSQLString
End Property

Public Property Let SQLString(Value)
strSQLString = Value
End Property


Public Property Let Style(Value)
strStyle = Value()
End Property

Public Property Get Style()
Style = strStyle
End Property

Public Property Let UniqueField(Value)
strUniqueField = lcase(Value)
End Property

Public Property Get UniqueField()
UniqueField = strUniqueField
End Property

Public Property Let Table(Value)
strTable = lcase(Value)
End Property

Public Property Get Table()
Table = strTable
End Property

Public Property Let DbConn(Value)
strConn = Value
End Property

Public Property Get Version()
Version = "1.0"
End Property

Public Property Let Cellspacing(Value)
strcellspacing = Value
End Property

Public Property Get Cellspacing()
Cellspacing = strcellspacing
End Property

Public Property Let cellpadding(Value)
strcellpadding = Value
End Property

Public Property Get cellpadding()
cellpadding = strCellspacing
End Property


Public Property Let CssClass(Value)
strCssClass = Value
End Property

Public Property Get CssClass()
CssClass = strCssClass
End Property

Public Property Let BorderColor(value)
strBorderColorDark = value
End Property

Public Property Get BorderColor()
BorderColor = strBorderColorDark
End Property

Public Property Let BackGround(value)
strBorderColorDark = value
strBackgroundColor = value
End Property

Public Property Get BackGround()
BackGround = strBorderColorLight
End Property

Public Property Let BorderWidth(value)
intBorderWidth = value
End Property

Public Property Get BorderWidth()
BorderWidth = intBorderWidth
End Property

Public Property Get nColumns(intIndex)
nkeys = Columns.Keys
nItems = Columns.Items
for i = 0 to Columns.Count - 1
if intIndex = nkeys(i) then
set tmp = nItems(i)
end if
next
set nColumns = tmp
End Property

Private Function page(totalpage,pagenumber,thisPage)
MinPage = thisPage - pagenumber/2
if MinPage <= 0 then MinPage = 1
'if MinPage + pagenumber/2 > totalpage then Maxpage = totalpage else Maxpage = MinPage + pagenumber
for i = MinPage to MinPage + pagenumber -1
if i <= totalpage then
if cint(thisPage)<> cint(i) then
strtemp = strtemp & "<a href="&pageURL&"&page=" & i &">" & i & "</a> "
else
strtemp = strtemp & i&" "
end if
else
page = strtemp
Exit Function
end if
Next
page = strtemp
End Function

Public Sub CreateGrid()
nkeys = Columns.Keys
nItems = Columns.Items
If dg_action="update" then
dim strsql
strsql = "update "& table & " set "
dim j
j=0
For i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
if j <> 0 then strsql = strsql & ","
Select case nItems(i).DataType
Case "text"
strsql= strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
Case "number","int","bigint","tinyint"
strsql= strsql & nItems(i).field & "=" & Request(nItems(i).field) & " "
Case "date","time","datetime"
strsql= strsql & nItems(i).field & "=convert(datetime,'" & Request(nItems(i).field)&"',102) "
Case else
strsql= strsql & nItems(i).field & "='" & Request(nItems(i).field)&"' "
End select
j=j+1
End if

Next
strsql = strsql & " where " & UniqueField &" = "& uniquekey
set rst = Server.CreateObject("adodb.recordset")
rst.Open strsql,connstr
'rst.Close
set rst = nothing
set strsql = nothing
End if

If dg_action="delete" then
strsql = ""
strsql = "delete from " & table & " where " & UniqueField &" = "& uniquekey
response.Write strsql
set rst = Server.CreateObject("adodb.recordset")
rst.Open strsql,connstr
'rst.Close
set rst = nothing
End if

IF dg_action = "addnew" and isAddnew = 1 then
'dim strsql
set rst = Server.CreateObject("adodb.recordset")
rst.open table,connstr,1,3,2
rst.addnew
j=0
For i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
if j <> 0 then strsql = strsql & ","
Select case nItems(i).DataType
Case "text"
rst(nItems(i).field) = Request(nItems(i).field)
Case "number","int","bigint","tinyint"
rst(nItems(i).field) = Request(nItems(i).field)
Case "date","time","datetime"
rst(nItems(i).field) = Request(nItems(i).field)
Case else
rst(nItems(i).field) = Request(nItems(i).field)
End select
j=j+1
End if
Next
rst.update
set rst = nothing
End if


rs.Open strSQLString,connstr,1,1

strTable= "<table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolorlight=" & strbordercolorlight & "class=" &cssclass & " cellspacing=0>" '加样式
strTable = strTable & "<form action=" & formURL & " name=""gridform"" method=post>"
if PagePosition="up" or PagePosition="updown" then strTable = strTable & "<tr><td colspan="& index &">"& page(rs.PageCount,Pagenumber,currPage )&"</td></tr>"
strTable = strTable & "<tr bgcolor=" & strHeadBackgroudColor & ">"
for i = 0 to index - 1
if nItems(i).Title<>"" then
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & nItems(i).Title &"</td>"
else
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs.Fields(i).Item.Name &"</td>"
end if

Next
strTable = strTable & "</tr>"
if cint(currPage) > cint(rs.PageCount) then currPage = rs.PageCount
intPage = Pagesize
rs.PageSize = pagesize
rs.AbsolutePage = currPage

do while not rs.eof and intPage > 0
intPage = intPage - 1
dbuniquekey = rs(uniquefield)
If intPage mod 2 then
strTable = strTable & "<tr>"
Else
strTable = strTable & "<tr "& strAlternateStyle &">"
End if
'response.Write len(dg_action)>0 and int(dbuniquekey) = int(uniquekey)
if dg_action ="edit" and int(dbuniquekey) = int(uniquekey) then
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &""" value=""" & rs(nItems(i).field) &"""></td>"
else
Select case lcase(nItems(i).Columntype)
Case "label"
strTable = strTable & "<td "& nItems(i).HTMLstr &">" & rs(nItems(i).field) &"</td>"
Case "radio"

Case "image"

Case "checkbox"

Case "textbox"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=text name=""" & rs.Fields(i).Name &""" value=" & rs(nItems(i).field) &"></td>"
Case "link"

Case "edit"
if UniqueField="" then ErrorMsg="UniqueField not set"
if dg_action = "edit" then
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href=""JavaScript:document.gridform.submit()"">"&nItems(i).UpdateCommandText&"</a> <a href="&actionURL&">"&nItems(i).CancelCommandText&"</a></td>"
else
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href="&actionURL&"&dg_action=edit&uniquekey=" & rs(UniqueField) &">"&nItems(i).EditCommandText&"</a></td>"
end if
Case "delete"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td "&nItems(i).HTMLstr &"><a href="&actionURL&"&dg_action=delete&uniquekey=" & rs(UniqueField) &">"&nItems(i).DeleteCommandText&"</a></td>"
Case "update"

Case else
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs(nItems(i).field) & "</td>"
End select
end if

Next
else
for i = 0 to index - 1
select case lcase(nItems(i).Columntype)
Case "label"
strTable = strTable & "<td " & nItems(i).HTMLstr & ">" & rs(nItems(i).field) &"</td>"
Case "radio"

Case "image"

Case "checkbox"

Case "textbox"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=text value=" & rs(nItems(i).field) &"></td>"
Case "link"

Case "edit"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td " & nItems(i).HTMLstr & "><a href=" & actionURL & "&dg_action=edit&uniquekey=" & rs(UniqueField) & ">" & nItems(i).EditCommandText & "</a></td>"
Case "delete"
if UniqueField="" then ErrorMsg="UniqueField not set"
strTable = strTable & "<td " & nItems(i).HTMLstr &"><a href=" & actionURL & "&dg_action=delete&uniquekey=" & rs(UniqueField) &">" & nItems(i).DeleteCommandText&"</a></td>"
Case "update"

Case else
strTable = strTable & "<td " & nItems(i).HTMLstr &">" & rs(nItems(i).Field) & "</td>"
End select
Next
End if


'End if
rs.movenext
strTable = strTable & "</tr>"& vbcrlf
loop

if PagePosition="down" or PagePosition="updown" then strTable = strTable & "<tr><td colspan="& index &">"& page(rs.PageCount,Pagenumber,currPage )
'strTable =strTable&"<tr>"
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
'strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &"""></td>"
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &">&nbsp;</td>"
end if
next
strTable =strTable&"</tr>"

strTable = strTable & "</form></table>"
If isAddnew = 1 then
strTable = strTable & "<form action=""?dg_action=addnew"" name=""dgridadd"" method=""post""><table border=" & intBorderWidth & " bordercolordark=" & strBorderColorDark & " bordercolorlight=" & strbordercolorlight & " cellspacing=0><tr>"
for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &">" & rs.Fields(nItems(i).field).Name &"</td>"
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &">"&nItems(i).Title&"</td>"
end if
next
strTable = strTable & "<td rowspan=2><a href=""JavaScript:document.dgridadd.submit()"">New</a></td></tr><tr>"

for i = 0 to index - 1
if nItems(i).Columntype<>"edit" and nItems(i).Columntype <> "delete" and not nItems(i).readonly and nItems(i).field<>uniquefield then
strTable = strTable & "<td " & nItems(i).HTMLstr &"><input type=Text name=""" & rs.Fields(nItems(i).field).Name &"""></td>" & vbcrlf
else
'strTable = strTable & "<td " & nItems(i).HTMLstr &">&nbsp;</td>"
end if
next
strTable = strTable &"</tr></table></form>"
End if
Response.Write strTable

End Sub

Public Sub AddColumn(cColumn)
'set tem = new Column
'tem = cColumn
'response.Write cColumn.ColumnHTMLstr
Columns.Add index,cColumn
index = index + 1
'Columns.Items(i)
End Sub

End Class

Class Column
Private strType
Private strAlign
Private strStyle
Private ColumnText
Private intWidth
Private intHight
Private strfield
Private strTitle
Private strEvent
Private strCssClass
Private strText
Private strEditCommandText,strUpdateCommandText,strCancelCommandText,strDeleteCommandText
Private strRegExp
Private strReadOnly
Private strDataType
Public MaxValue,MinValue,MaxLength,MinLength,IsEmpty,IsChar,IsNumber,isCharNumber,isDate,isEmail


Private Sub Class_Initialize()

ColumnType = "Text"
strEditCommandText = "EDIT"
strUpdateCommandText = "UPDATE"
strCancelCommandText = "CANCEL"
strDeleteCommandText = "DELETE"

End Sub

Private Sub Class_Terminate()

End Sub

Public Property Let Columntype(Value)
strType = lcase(Value)
End Property

Public Property Get Columntype()
ColumnType = strType
End Property

Public Property Let Para(Value)
Para = Value
End Property


Public Property Let ParaLink(Value)
ParaLink = Replace(Value,"{0}",Para)
End Property

Public Property Let ControlName(Value)
ControlName = Value
End Property

Public Property Let Style(Value)
strStyle = Value
End Property

Public Property Let Eventstr(Value)
strEvent = Value
End Property

Public Property Let Align(Value)
strAlign = Value
End Property

Public Property Get Align()
Align = strAlign
End Property

Public Property Get Eventstr()
Eventstr = strEvent
End Property

Public Property Let Width(Value)
intWidth = Value
End Property

Public Property Let Field(Value)
strField = lcase(Value)
End Property

Public Property Get Field()
Field = strField
End Property

Public Property Let Title(Value)
if value="" then strTitle = strField else strTitle = Value
End Property

Public Property Get Title()
if strTitle="" then Title = strField else Title = strTitle
End Property

Public Property Let CssClass(Value)
strCssClass = Value
End Property

Public Property Get CssClass()
CssClass = strCssClass
End Property

Public Property Let DataType(Value)
strDataType = lcase(Value)
End Property

Public Property Get DataType()
DataType = strDataType
End Property

Public Property Let Text(Value)
select case value
case ""
strText = strType
case null
strText = strType
case else
strText = Value
end select
End Property

Public Property Get Text()
Text = strText
End Property

Public Property Let ReadOnly(Value)
if value="" or isnull(value) then strReadOnly = False else strReadOnly = value
End Property

Public Property Get ReadOnly()
ReadOnly = strReadOnly
End Property

Public Property Let EditCommandText(Value)
strEditCommandText = Value
End Property

Public Property Get EditCommandText()
EditCommandText = strEditCommandText
End Property


Public Property Let UpdateCommandText(Value)
strUpdateCommandText = Value
End Property

Public Property Get UpdateCommandText()
UpdateCommandText = strUpdateCommandText
End Property


Public Property Let CancelCommandText(Value)
strCancelCommandText = Value
End Property

Public Property Get CancelCommandText()
CancelCommandText = strCancelCommandText
End Property



Public Property Let DeleteCommandText(Value)
strDeleteCommandText = Value
End Property

Public Property Get DeleteCommandText()
DeleteCommandText = strDeleteCommandText
End Property

Public Property Let RegExp(Value)
strRegExp = Value
End Property

Public Property Get RegExp()
RegExp = strRegExp
End Property

Public Property Get HTMLstr()
tempstr = ""
if intWidth <> "" then tempstr = tempstr & " width=""" & intWidth & """"
if intHeight <> "" then tempstr = tempstr & " height =""" & intHeight & """"
if strStyle <> "" then tempstr = tempstr & " style=""" & strStyle & """"
if strEvent <> "" then tempstr = tempstr & " " & strEvent
if strAlign <> "" then tempstr = tempstr & " align=""" & strAlign & """"
HTMLstr = tempstr

End Property
End Class
%>