我在开发过程总结的一套实现常用功能的函数

发表于:2007-06-30来源:作者:点击数: 标签:
% Option Explicit @#=================================================== public function MyNowNumber() MyNowNumber=year(now) month(NOw) day(NOw) hour(NOw) Minute(Now) Second(Now) end function public function sDataGrid(SqlStr,ConnStr,PageSize
<%
Option Explicit
@#===================================================
public function MyNowNumber()
MyNowNumber=year(now)& month(NOw) & day(NOw) & hour(NOw) & Minute(Now) & Second(Now)
end function

public function sDataGrid(SqlStr,ConnStr,PageSize,PageNum,beginField,EndField,IDField,HttpStr,PageInfo)@#以表格形式显示数据

@#这个函数本打算用来实现点击表头排序功能,可是后来总是随机性无故出错,所以就没在现用了,哪们高手可以看看


@#DataGrid功能:
@# 将数据以表格形式显出来,
@# 根据需要可能确定显示的字段,
@# 页号,每页显示的记录数
@# 复选框绑定的字段
@# 修改数据时所连接到的设定的网页,传递的参数名是Idfield

@#调用实例 call DataGrid("SELECT * FROM mater_bcode","Driver={SQL Server};uid=sa;pwd=passed;database=cthpdb;server=scb-web",10,20,2,50,0,"http://www.clkhome/mater_code1/tools/aaa.asp","Null")


@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#PageSize: 数据集每页的记录数,PageSize="MAX"时不分页
@#PageNum: 数据集中将要显示的页号
@#beginField:在记录集中开始显示的字段位置
@#EndField: 在记录集中结束显示的字段位置
@#IDField: 用于给复选框的value赋值的字段在记录集中的位置,可以用于提交到其它页,其它页做处理的依据
@# 如果IDField<0 or IDField> rs.fields.count或不是数字 则不显示复选框
@#HttpStr 修改记录时连接到的网页,传递的是IDField的值,如果 httpstr="0"则不显示修改连接
@#PageInfo 确定是否显示"第1页,共1页"的提示,PageInfo="Null"时不显示
@#返回值, 返回的是记录集的当前页号


on error resume next
dim conn,rs
@#if isnumeric(pageSize)then rs.pageSize=pageSize
set conn=server.CreateObject ("adodb.connection")
set rs=server.CreateObject ("adodb.recordset")
Conn.open Connstr
rs.Open sqlstr,conn,1,3
if err.number<>0 then
Response.Write writeinfo("<BR>DataGrid函数在运行出现了错误!<BR>错描述:" & err.Description & "<BR>")
DataGrid="Err"
exit function
end if
if rs.RecordCount<1 then
Response.Write "<font size=@#-1@# color=@##FF0000@#>&nbsp;没有数据...</font>"
DataGrid=0
exit function
end if

@#------------对参数据进行处理----------------------
@#----------确定如何显示字段-----------------
if not Isnumeric(beginField) or beginField<0 then
beginField=0@#确保开始显示的位置在合理范围内
else
if beginField>rs.Fields.Count-1 then beginField=rs.Fields.Count-1@#保证到少显示一个字段
if beginField<0 then beginField=0
end if
if not Isnumeric(EndField) then EndField=rs.Fields.Count-1
if EndField>rs.Fields.Count-1 then EndField=rs.Fields.Count-1
if EndField<=beginField or EndField<0 then EndField=beginField@#保证到少显示一个字段
@#----------复选框、修改链接的处理在成生表格时同步完成--------------

@#---------分页处理------------------
if Ucase(Trim(PageSize))="MAX" then
PageSize=rs.RecordCount
rs.pageSize=rs.RecordCount
PageNum=1
else
if not Isnumeric(PageSize) or PageSize<1 then PageSize=10
if PageSize>rs.recordcount then pageSize=rs.recordcount
rs.pageSize=pageSize
@#---------页号处理----------------
if Trim(Ucase(pageNum))="MAX" then PageNum=rs.PageCount
if not Isnumeric(PageNum) then PageNum=1
if PageNum<1 then PageNum=1
if cint(PageNum-rs.PageCount)>0 then PageNum=rs.PageCount
end if
Rs.AbsolutePage=PageNum

if err.number<>0 then
dbinfo="数据库连接错误"
DataGrid=0
exit function
else
if rs.RecordCount<1 then
Response.Write "没有找到记录"
DataGrid=0
exit function
else
if Ucase(trim(PageInfo))<>"NULL" then @#确定是显示页号信息
Response.Write "<font size=@#-1@# color=@##666666@#>第<font color=@##FF0000@#>" & PageNum & "</font>页,共<font color=@##FF0000@#>" & rs.PageCount & "</font>页"
end if
@#写入表头
Response.Write "<table width=@#100%@# border=@#0@# cellspacing=@#1@# cellpadding=@#0@# bgcolor=@##999999@#>"
Response.Write "<tr bgcolor=@##CCCCCC@#>"
Response.Write "<td width=@#1%@# align=@#center@#><b><font color=@##666666@# size=@#-1@#>序</font></b></td>"
dim i
for i=beginField to EndField
Response.Write "<td align=@#center@#><b><font color=@##666666@# size=@#-1@#>" & rs.Fields(i).Name & "</font></b></td>"
next
if Isnumeric(IDfield) then @#复选框及修改链接处理
if IDField>=0 and (IDField - rs.fields.count<=0) then
Response.Write "<td width=@#1%@# align=@#center@#><b><font color=@##666666@# size=@#-1@#>删</font></b></td>"
if trim(httpstr)<>"0" then Response.Write "<td width=@#1%@#><b><font color=@##666666@# size=@#-1@#>修</font></b></td>"
end if
end if
Response.Write "</tr>"
@#写入字段信息
dim RecordNum,FieldNum
for RecordNum=0 to PageSize-1 @#?????????????????
Response.Write "<tr bgcolor=@##FFFFFF@#>"
Response.Write "<td><font size=@#-1@#>" & RecordNum +1+(PageNum-1)*PageSize & "</font></td>"
for FieldNum=beginField to EndField @#写入字段值
@#response.write "<input type=@#text@# name=@#textfield@# value=@#" & Trim(rs.Fields(FieldNum).Value) & "@#>"
@#if Trim(rs.Fields(FieldNum).Value)="" or Isnull(rs.Fields(FieldNum).Value) then
@# Response.Write "<td>&nbsp;</td>"
@# else
Response.Write "<td><font size=@#-1@#><input type=@#text@# name=@#textfield@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px@# value=@#" & Trim(rs.Fields(FieldNum).Value) & "@#></font></td>"
@#end if
next
if Isnumeric(IDfield) then @#复选框处理
if IDField>=0 or (IDField - rs.fields.count<=0) then
Response.Write "<td><input type=@#checkbox@# name=@#IDfield@# value=@#"& rs.Fields(IDfield).Value &"@#></td>"
if trim(httpstr)<>"0" then Response.Write "<td><font size=@#-1@#><a href=@#" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"@#>改</a></font></td>"
end if
end if
Response.Write "</tr>"
rs.MoveNext
if rs.eof then exit for @#最后不到一整页时,也跳出
next
Response.Write "</table>"
end if
end if
rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear
DataGrid=PageNum
end function






public function DataGrid(SqlStr,ConnStr,PageSize,PageNum,beginField,EndField,IDField,HttpStr,PageInfo)@#以表格形式显示数据

@#DataGrid功能:
@# 将数据以表格形式显出来,
@# 根据需要可能确定显示的字段,
@# 页号,每页显示的记录数
@# 复选框绑定的字段
@# 修改数据时所连接到的设定的网页,传递的参数名是Idfield

@#调用实例 call DataGrid("SELECT * FROM mater_bcode","Driver={SQL Server};uid=sa;pwd=passed;database=cthpdb;server=scb-web",10,20,2,50,0,"http://www.clkhome/mater_code1/tools/aaa.asp","Null")


@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#PageSize: 数据集每页的记录数,PageSize="MAX"时不分页
@#PageNum: 数据集中将要显示的页号
@#beginField:在记录集中开始显示的字段位置
@#EndField: 在记录集中结束显示的字段位置
@#IDField: 用于给复选框的value赋值的字段在记录集中的位置,可以用于提交到其它页,其它页做处理的依据
@# 如果IDField<0 or IDField> rs.fields.count或不是数字 则不显示复选框
@#HttpStr 修改记录时连接到的网页,传递的是IDField的值,如果 httpstr="0"则不显示修改连接
@#PageInfo 确定是否显示"第1页,共1页"的提示,PageInfo="Null"时不显示
@#返回值, 返回的是记录集的当前页号


on error resume next
dim conn,rs
@#if isnumeric(pageSize)then rs.pageSize=pageSize
set conn=server.CreateObject ("adodb.connection")
set rs=server.CreateObject ("adodb.recordset")
Conn.open Connstr
rs.Open sqlstr,conn,1,3
if err.number<>0 then
Response.Write writeinfo("<BR>DataGrid函数在运行出现了错误!<BR>错描述:" & err.Description & "<BR>")
DataGrid="Err"
exit function
end if
if rs.RecordCount<1 then
Response.Write "<font size=@#-1@# color=@##FF0000@#>&nbsp;没有数据...</font>"
DataGrid=0
exit function
end if

@#------------对参数据进行处理----------------------
@#----------确定如何显示字段-----------------
if not Isnumeric(beginField) or beginField<0 then
beginField=0@#确保开始显示的位置在合理范围内
else
if beginField>rs.Fields.Count-1 then beginField=rs.Fields.Count-1@#保证到少显示一个字段
if beginField<0 then beginField=0
end if
if not Isnumeric(EndField) then EndField=rs.Fields.Count-1
if EndField>rs.Fields.Count-1 then EndField=rs.Fields.Count-1
if EndField<=beginField or EndField<0 then EndField=beginField@#保证到少显示一个字段
@#----------复选框、修改链接的处理在成生表格时同步完成--------------

@#---------分页处理------------------
if Ucase(Trim(PageSize))="MAX" then
PageSize=rs.RecordCount
rs.pageSize=rs.RecordCount
PageNum=1
else
if not Isnumeric(PageSize) or PageSize<1 then PageSize=10
if PageSize>rs.recordcount then pageSize=rs.recordcount
rs.pageSize=pageSize
@#---------页号处理----------------
if Trim(Ucase(pageNum))="MAX" then PageNum=rs.PageCount
if not Isnumeric(PageNum) then PageNum=1
if PageNum<1 then PageNum=1
if cint(PageNum-rs.PageCount)>0 then PageNum=rs.PageCount
end if
Rs.AbsolutePage=PageNum

if err.number<>0 then
dbinfo="数据库连接错误"
DataGrid=0
exit function
else
if rs.RecordCount<1 then
Response.Write "没有找到记录"
DataGrid=0
exit function
else
if Ucase(trim(PageInfo))<>"NULL" then @#确定是显示页号信息
Response.Write "<font size=@#-1@# color=@##666666@#>第<font color=@##FF0000@#>" & PageNum & "</font>页,共<font color=@##FF0000@#>" & rs.PageCount & "</font>页"
end if
@#写入表头
Response.Write "<table width=@#100%@# border=@#0@# cellspacing=@#1@# cellpadding=@#0@# bgcolor=@##999999@#>"
Response.Write "<tr bgcolor=@##CCCCCC@#>"
Response.Write "<td width=@#1%@# align=@#center@# onclick=@#form1.submit()@#><b><font color=@##666666@# size=@#-1@#>序</font></b></td>"
dim i
for i=beginField to EndField
Response.Write "<td align=@#center@#><b><font color=@##666666@# size=@#-1@#>" & rs.Fields(i).Name & "</font></b></td>"
next
if Isnumeric(IDfield) then @#复选框及修改链接处理
if IDField>=0 and (IDField - rs.fields.count<=0) then
Response.Write "<td width=@#1%@# align=@#center@#><b><font color=@##666666@# size=@#-1@#>删</font></b></td>"
if trim(httpstr)<>"0" then Response.Write "<td width=@#1%@#><b><font color=@##666666@# size=@#-1@#>修</font></b></td>"
end if
end if
Response.Write "</tr>"
@#写入字段信息
dim RecordNum,FieldNum
for RecordNum=0 to PageSize-1 @#?????????????????
Response.Write "<tr bgcolor=@##FFFFFF@#>"
Response.Write "<td><font size=@#-1@#>" & RecordNum +1+(PageNum-1)*PageSize & "</font></td>"
for FieldNum=beginField to EndField @#写入字段值
if Trim(rs.Fields(FieldNum).Value)="" or Isnull(rs.Fields(FieldNum).Value) then
Response.Write "<td>&nbsp;</td>"
else
Response.Write "<td><font size=@#-1@#>&nbsp;" & Trim(rs.Fields(FieldNum).Value) & "</font></td>"
end if
next
if Isnumeric(IDfield) then @#复选框处理
if IDField>=0 or (IDField - rs.fields.count<=0) then
Response.Write "<td><input type=@#checkbox@# name=@#IDfield@# value=@#"& rs.Fields(IDfield).Value &"@#></td>"
if trim(httpstr)<>"0" then Response.Write "<td><font size=@#-1@#><a href=@#" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"@#>改</a></font></td>"
end if
end if
Response.Write "</tr>"
rs.MoveNext
if rs.eof then exit for @#最后不到一整页时,也跳出
next
Response.Write "</table>"
end if
end if
rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear
DataGrid=PageNum
end function
@#=========================================================================================================================================================
public function DoubleDataGrid(SqlStr,ConnStr,PageSize,PageNum,beginField,EndField,IDField,HttpStr,SSqlStr,SbeginField,SEndField,RelationFieldStr,ForeignFieldNum,AddWhere,OrderByStr)@#主从表格式显示数据
@#DoubleDataGrid功能:
@# 将数据以表格形式显出来,
@# 根据需要可能确定显示的字段,
@# 页号,每页显示的记录数
@# 复选框绑定的字段
@# 修改数据时所连接到的设定的网页,传递的参数名是Idfield

@#调用实例 page=DoubleDataGrid("SELECT * FROM mater_bcode","DSN=clkdb;UID=sa;PWD=passed",10,20,2,50,"Null","http://www.clkhome/mater_code1/tools/aaa.asp","SELECT price AS 价格, Num AS 数量, MaterDate AS 日期 FROM mater_price",0,"max","mater_id",0,"y","NUll")



@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#PageSize: 数据集每页的记录数
@#PageNum: 数据集中将要显示的页号
@#beginField:在记录集中开始显示的字段位置
@#EndField: 在记录集中结束显示的字段位置
@#IDField: 用于给复选框的value赋值的字段在记录集中的位置,可以用于提交到其它页,其它页做处理的依据
@# 如果IDField<0 or IDField> rs.fields.count或不是数字 则不显示复选框
@#HttpStr 修改记录时连接到的网页,传递的是IDField的值,如果 httpstr="0"则不显示修改连接


@#SSqlStr: 从表的SQl语句,不能句括Order by 子句,因为要通过类似于 "where 子表.字段=主表.字段"的方式将两个表联系起来,
@# 而where必须在ordey by子句这前使用,才能符合sql语法
@#SbeginField: 从表中在记录集中开始显示的字段位置
@#SEndField: 从表中在记录集中结束显示的字段位置
@#RelationFieldStr: 从表中,与主表的关联的字段名,使用方式如 Where RelationFieldStr= @#ABC@#
@#ForeignFieldNum: 主表中,与从表关联的字段在主表记录是中的位置,
@# 之所以用以位置(index)而不直接写确定的值,是因为当主表的记录集movenext后,相应的值要变以
@# 生成对应的从表记录集,使用方式如 Where RelationFieldStr= Rs(ForeignFieldNum)
@#AddWhere: 确定将SSqlStr与生成的关联字符串("where 子表.字段=主表.字段")连接时是用 "Where "还是"And"
@# AddWhere<>"Null"时用"where" AddWhere="Null"时用"and"
@#OrderByStr: 从表的SQl语句的OrderByStr子句
@#返回值, 返回的是记录集的当前页号


on error resume next
dim conn,rs
set conn=server.CreateObject ("adodb.connection")
set rs=server.CreateObject ("adodb.recordset")
Conn.open Connstr
rs.Open sqlstr,conn,1,3

if err.number <>0 then
Response.Write "<BR>DoubleDataGrid函数出错错误:<BR>" &err.Description
exit function
end if

if rs.RecordCount<1 then
Response.Write "<font size=@#-1@# color=@##FF0000@#>&nbsp;没有数据...</font>"
DoubleDataGrid=0
exit function
end if

@#------------对参数据进行处理----------------------
@#----------确定如何显示字段-----------------
if not Isnumeric(beginField) or beginField<0 then
beginField=0@#确保开始显示的位置在合理范围内
else
if beginField>rs.Fields.Count-2 then beginField=rs.Fields.Count-2@#保证到少显示一个字段
if beginField<0 then beginField=0
end if
if not Isnumeric(EndField) then EndField=rs.Fields.Count-1
if EndField>rs.Fields.Count-1 then EndField=rs.Fields.Count-1
if EndField<=beginField or EndField<0 then EndField=beginField-1@#保证到少显示一个字段
@#----------复选框、修改链接的处理在成生表格时同步完成--------------

@#---------分页处理------------------
if Ucase(Trim(PageSize))="MAX" then
PageSize=rs.RecordCount
rs.pageSize=rs.RecordCount
PageNum=1
else
if not Isnumeric(PageSize) or PageSize<1 then PageSize=10
if PageSize>rs.recordcount then pageSize=rs.recordcount
rs.pageSize=pageSize
@#---------页号处理----------------
if Trim(Ucase(pageNum))="MAX" then PageNum=rs.PageCount
if not Isnumeric(PageNum) then PageNum=1
if PageNum<1 then PageNum=1
if cint(PageNum-rs.PageCount)>0 then PageNum=rs.PageCount
end if
Rs.AbsolutePage=PageNum
if err.number<>0 then
dbinfo="数据库连接错误"
DoubleDataGrid=0
exit function
else
if rs.RecordCount<1 then
Response.Write "没有找到记录"
DoubleDataGrid=0
exit function
else
Response.Write "<font size=@#-1@# color=@##666666@#>第<font color=@##FF0000@#>" & PageNum & "</font>页,共<font color=@##FF0000@#>" & rs.PageCount & "</font>页"
@#写入表头
Response.Write "<table width=@#100%@# border=@#0@# cellspacing=@#1@# cellpadding=@#0@# bgcolor=@##999999@#>"
Response.Write "<tr bgcolor=@##CCCCCC@#>"
Response.Write "<td width=@#1%@# align=@#center@#><b><font color=@##666666@# size=@#-1@#>序</font></b></td>"
dim i
for i=beginField to EndField
Response.Write "<td align=@#center@#><b><font color=@##666666@# size=@#-1@#>" & rs.Fields(i).Name & "</font></b></td>"
next
if Isnumeric(IDfield) then @#复选框及修改链接处理
if IDField>=0 and (IDField - rs.fields.count<=0) then
Response.Write "<td width=@#1%@#align=@#center@#><b><font color=@##666666@# size=@#-1@#>删</font></b></td>"
if trim(httpstr)<>"0" then Response.Write "<td width=@#1%@#><b><font color=@##666666@# size=@#-1@#>修</font></b></td>"
end if
end if
Response.Write "</tr>"
@#写入字段信息
dim RecordNum,FieldNum,SWhere,SSSql
for RecordNum=0 to PageSize-1 @#?????????????????
Response.Write "<tr bgcolor=@##FFFFFF@#>"
Response.Write "<td><font size=@#-1@#>" & RecordNum +1+(PageNum-1)*PageSize & "</font></td>"
for FieldNum=beginField to EndField @#写入字段值
if Trim(rs.Fields(FieldNum).Value)="" or Isnull(rs.Fields(FieldNum).Value) then
Response.Write "<td>&nbsp;</td>"
else
Response.Write "<td><font size=@#-1@#>&nbsp;" & trim(rs.Fields(FieldNum).Value) & "</font></td>"
end if
next
if Isnumeric(IDfield) then @#复选框处理
if IDField>=0 or (IDField - rs.fields.count<=0) then
Response.Write "<td><input type=@#checkbox@# name=@#IDfield@# value=@#"& rs.Fields(IDfield).Value &"@#></td>"
if trim(httpstr)<>"0" then Response.Write "<td><font size=@#-1@#><a href=@#" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"@#>改</a></font></td>"
end if
end if
Response.Write "</tr>"
@#----写入从表
Response.Write "<tr bgcolor=@##FFFFFF@#>"
Response.Write "<tD colspan=@#2@#>&nbsp;"
Response.Write "</tD>"
@#保证从表的长度比主表少一格
Response.Write "<tD colspan=@#" & rs.fields.count-beginField-1 & "@#>"
SWhere=""@#每次生成新的从表的sql语句新清空临时变量
@#确定主表的记录集中与从表相关的字段位置,生成开相应的关联字符串
if not IsNumeric(ForeignFieldNum) then ForeignFieldNum=0
if ForeignFieldNum<0 or ForeignFieldNum>rs.fields.count-1 then ForeignFieldNum=0

@#SWhere=" " & RelationFieldStr & "=@#" & rs(ForeignFieldNum).value &"@#" 对于sql_server最好用这句进行连接,这一句更灵活,可对用于字符型和数值型,(日期型没试过)
SWhere=" " & RelationFieldStr & "=" & rs(ForeignFieldNum).value@#专门应用于aclearcase/" target="_blank" >ccess,因为是对于access来说数值型字段不能加"@#",这句只对数值型的字段才有效

if Ucase(Trim(AddWhere)) <> "NULL" then
SWhere=" Where " & SWhere
else
SWhere=" and " & SWhere
end if
SSSql=SSqlStr & SWhere
if Ucase(Trim(OrderByStr))<>"NULL" then SSSqlStr=SSqlStr & OrderByStr
Call DataGrid(SSSql,ConnStr,"Max",1,SbeginField,SEndField,"NUll","NULL","NULL")
Response.Write "</tD>"
Response.Write "</tr>"

rs.MoveNext
if rs.eof then exit for @#最后不到一整页时,也跳出
next
Response.Write "</table>"
end if
end if

rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear
DoubleDataGrid=PageNum
end function
@#=========================================================================================================================================================
Public Function InputForm(SqlStr,ConnStr,YesAdd,beginField,EndField,IdField,CorIDStr,CorSize)

@#InputForm功能:根据connstr和sqlstr生成数据输入表单,可用于添加新记录,或修改当前记录

@#调用实例 call inputForm("SELECT * FROM mater_bcode","Driver={SQL Server};uid=sa;pwd=passed;database=cthpdb;server=scb-web",1,"NUll",5)


@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#YesAdd: 确定生成的输入表单是用于添加新记录还是修改现有记录
@# YesAdd=1 时是添加新记录,则输入框为空
@# YesAdd=0 时是修改现有记录,则用被修改前的记录内容填充输入框
@#beginField:在记录集中开始显示的字段位置
@#EndField: 在记录集中结束显示的字段位置
@#IDField: 当inputform被用作修改的输入界面时,往往需要一个id字段来确定是哪条记录将被修改
@# 如果IDField<0 or IDField> rs.fields.count或不是数字,则视为不确定。
@#CorIDStr: 控件的ID字符串@#CorIDStr="Null"时 CorIDStr="fieldValue"
@#注意:为了变于在客户端进行输入值的合法性检验,将每个文本框的id以"CorIDStr + i 的形式确定,例如"fieldValue0"
@#CorSize: 输入表格中,文本框的长度,之所以用这个参数据是为方便网页的布局,CorSize不是数值时,CorSize默认为40

On error resume next
Dim rs,conn
set conn=server.CreateObject ("Adodb.Connection")
conn.open ConnStr
set rs=server.CreateObject ("Adodb.recordset")
rs.open SqlStr,conn,1,3

if err.number<>0 then
Response.Write "出现错误:" & err.Description
exit function
end if


@#--------参数处理------------------------------------------
@#-------处理YesAdd,如果YesAdd不是数字则默认为添加新记录
if Ucase(Trim(YesAdd))="YES" then yesadd=1 @#添加新记录
if Ucase(Trim(YesAdd))="NO" then yesadd=0 @#修改记录
if not IsNumeric(yesadd) then yesadd=1

if Ucase(Trim(CorIDStr))="NULL" then CorIDStr="fieldValue"@#控件的ID字符串,
@#这样可以解决的在一个页面同调用两次InputForm函数时控件ID相同的问题
if not ISnumeric(CorSize) then CorSize="40"@# 控件宽度

@#----------确定如何显示字段-----------------
if not Isnumeric(beginField) or beginField<0 then
beginField=0@#确保开始显示的位置在合理范围内
else
if beginField=>rs.Fields.Count -1 then beginField=rs.Fields.Count -1@#保证到少显示一个字段
end if

if Ucase(Trim(EndField))="MAX" then EndField=rs.Fields.Count-1
if not Isnumeric(EndField) or EndField<=beginField then @#not Isnumeric(EndField)用于防止输入的是无效字符串
EndField=rs.Fields.Count-1
end if

if rs.RecordCount<0 then
Response.Write "取数据时出错!"
exit function
else
@#----写入隐藏的id字段
if yesadd=0 and IDField>=0 and (IDField - rs.fields.count<=0) and rs.recordcount>0 then Response.Write "<input type=@#hidden@# name=@#fieldValue@# id=@#IDField@# value=@#" & rs.Fields(IdField).value & "@#>"@#写入隐藏的id字段
Response.Write "<table width=@#75%@# border=@#0@# bgcolor=@##999999@# cellspacing=@#1@#>"
@#----生成表格
dim i
for i=beginField to EndField
Response.Write "<tr>"
Response.Write "<td bgcolor=@##CCCCCC@#><b><font color=@##666666@# size=@#-1@#>" & rs.Fields(i).Name & "</font></b></td>"
if yesadd=1 or rs.recordcount=0 then@#如果不是修改现有记录则输入框为空
if rs.Fields(i).type=201 or rs.Fields(i).type=202 or rs.Fields(i).type=201 then @#适用于sql_server
@#if rs.Fields(i).type=201 or rs.Fields(i).type=203 then@#适用于access
Response.Write "<td bgcolor=@##FFFFFF@#><textarea type=@#text@# name=@#fieldValue@# id=@#" & CorIDStr & i & "@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 1px@# rows=@#5@# cols=@#" & CorSize & "@#></textarea ></td>"
else
Response.Write "<td bgcolor=@##FFFFFF@#><input type=@#text@# name=@#fieldValue@# id=@#" & CorIDStr & i & "@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px@# size=@#" & CorSize & "@#></td>"
end if
else@#如果是修改则将原来的值写入输入框
if rs.Fields(i).type=201 or rs.Fields(i).type=202 or rs.Fields(i).type=201 then@# 适用于sql_server
@#if rs.Fields(i).type=201 or rs.Fields(i).type=203 then@#适用于access
Response.Write "<td bgcolor=@##FFFFFF@#><textarea type=@#text@# name=@#fieldValue@# id=@#" & CorIDStr & i & "@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 1px@# rows=@#5@# cols=@#" & CorSize & "@#>" & rs(i).value & "</textarea ></td>"
else
Response.Write "<td bgcolor=@##FFFFFF@#><input type=@#text@# name=@#fieldValue@# id=@#" & CorIDStr & i & "@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px@# size=@#" & CorSize & "@# value=@#" & rs(i).value & "@#></td>"
end if
end if
Response.Write "</tr>"
next
Response.Write "</table>"
end if
rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear
End Function

@#===================================================

public function ExecuteSQl(SqlStr,ConnStr)

@#ExecuteSql功能:用于执行一条sql语句 如deldte、update

@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#返回值
@#如果返回 "0"是执行成功,否则返回错误号而ExecuteSQlput不同,ExecuteSQl返回@#ERR@#

on error resume next
Dim rs,conn
set conn=server.CreateObject ("Adodb.Connection")
conn.open ConnStr
if err.number <> 0 then
response.write Writeinfo( "<BR>ExecuteSQl出现错误:<BR>" & err.Description & "<BR>")
ExecuteSQl=err.number
exit function
else
conn.Execute sqlstr
if err.number <>0 then
response.write Writeinfo( "<BR>ExecuteSQl出现错误:<BR>" & err.Description & "<BR>")
ExecuteSQl=err.number
end if
end if
conn.close
set conn=nothing
ExecuteSQl=err.number
End function

public function ExecuteSqlPut(SqlStr,ConnStr)

@#ExecuteSql功能:用于执行一条sql语句,
@# 同ExecuteSql不同的是可以有一个返回值。
@# 这个函数主要用于select sum(字段名)、select avg(字段名)之类的sql语句。

@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串

@#返回值
@# 如是返回字符串"ERR"则表示出错、 这一点与ExecuteSql不同

On error resume next
Dim rs,conn
set conn=server.CreateObject ("Adodb.Connection")
set rs=server.CreateObject ("Adodb.recordset")
conn.open ConnStr
if err.number <>0 then
response.write writeinfo("<br>ExecuteSqlPut函数出现错误:<br>" & err.Description)
ExecuteSqlPut="Err"
else
rs=conn.execute(sqlstr)
if err.number <>0 then
response.write writeinfo("<BR>ExecuteSqlPut函数运行,出现错误:" & err.Description )
ExecuteSqlPut="Err"
else
ExecuteSqlPut=rs(0)
end if
end if
@#rs.close
set rs=nothing
Conn.close
set conn=nothing
End function


@#==============================================
@#用于替换数据库不能保存的字符
public function MyReplace(InputStr) @#对单个字符进行轮换
InputStr=Replace(InputStr,"<","&lt")
InputStr=Replace(InputStr,">","&gt")
InputStr=Replace(InputStr,"@#","@#@#")
InputStr=Replace(InputStr,vbCrLf,"<BR>")
MyReplace=Replace(InputStr,chr(20),"&nbsp;")
end function

public function ReMyReplace(InputStr) @#对单个字符进行还原
InputStr=Replace(InputStr,"&lt","<")
InputStr=Replace(InputStr,"&gt",">")
InputStr=Replace(InputStr,"@#@#","@#")
InputStr=Replace(InputStr,"<BR>",vbCrLf)
ReMyReplace=Replace(InputStr,"&nbsp;",chr(20))
end function

public function MyReplaceS(InputStr,Active)@#对字符数组进行转换或还原
@#参数说明
@#InputStr 是将要被转换或还原的数组
@#Active 用于确定是进行转换还是还原
@# Active=1时转换成可以在表格中直接显示的超文本格式
@# Active=0时还原成文本文件格式
dim i
if active=1 then
for i=0 to ubound(InputStr)
InputStr(i)=MyReplace(InputStr(i))
next
else
for i=0 to ubound(InputStr)
InputStr(i)=ReMyReplace(InputStr(i))
next
end if
MyReplaceS=InputStr
end function

public function MyTrimS(InputStrS)@#对字符数组中的每个元素去左右空格
dim i
for i=0 to ubound(InputStrs)
InputStrS(i)=Trim(InputStrS(i))
next
MyTrimS=InputStrS
end function
@#=============================================

public function MyTestValue(MyValues)
@#将数据Valuse的所有元素的值都写在网上,以便查看从其它网页传过来的数组的值
@#参数据说明:
@# vaules:待检测的数组
@#返回值:
@# 如是没有出错返回数组的长度
@# 有错返回“-1”
on error resume next
dim i,ValuesLen
ValuesLen=ubound(MyValues)
for i=0 to ValuesLen
response.write i & " " & MyValues(i) & "<br>"
next

if err.number=0 then
MyTestValue= ubound(MyValues)
else
Response.Write "<BR>MyTestValue 函数运行时发生错误:" & err.Description
MyTestValue=-1
end if
end function


public function ShowUpdateSQl(SqlStr,ConnStr,beginField,EndField,FieldArrayName,ArrayBeginNum,TableName,SqlType)
@#ShowUpdateSQl函数功能:根据传入的sql语句,快速生成部分"Update"语句.
@#当一条update语句中含有10个或更多的字段时,这个函数将会起到很多作用,不但可以快速后成语句,
@#而且可以减少错误的发生.
@#参数说明
@#sqlstr: 将要查询的sql语句
@#connstr: 数据库连接字符串
@#beginField:在记录集中开始显示的字段位置
@#EndField: 在记录集中结束显示的字段位置
@#FieldArrayName:生成update语句时,存入值的数组名
@#TableName:被查询的表名,之所以用这个参数是为使函数生成的update语更完整些.
@#SqlType: 确定ShowUpdateSQl函数返回是update语句还是insert语句
@# SqlType="update"时生成update语句,
@# SqlType=其它值时生成insert语句
@#调用实例
@# response.write ShowUpdateSQl("select * from abc","Driver={SQL Server};uid=sa;pwd=passed;database=cthpdb;server=scb-web",1,"Max","fieldValue","abc")
@#返回的结果: update abc set a=@#fieldValue(0)@#,b=@#fieldValue(1)@#,c=@#fieldValue(2)

on error resume next
dim conn,rs
set conn=server.CreateObject ("adodb.connection")
set rs=server.CreateObject ("adodb.recordset")
Conn.open Connstr
rs.Open sqlstr,conn,1,3
if err.number <>0 then
response.write writeinfo("<BR>ShowUpdateSQl函数运行时出现错误!<BR>错误信息:" & err.Description)
ShowUpdateSQl=err.number
exit function
end if
@#----------确定如何显示字段-----------------
if not Isnumeric(beginField) or beginField<0 then
beginField=0@#确保开始显示的位置在合理范围内
else
if beginField>rs.Fields.Count-2 then beginField=rs.Fields.Count-2@#保证到少显示一个字段
if beginField<0 then beginField=0
end if
if not Isnumeric(EndField) then EndField=rs.Fields.Count-1
if EndField>rs.Fields.Count-1 or EndField<=beginField or EndField<0 then EndField=rs.Fields.Count-1
if not isnumeric(ArrayBeginNum) then ArrayBeginNum=0 @#确定数组的下限是数字
dim i,TempSql
if UCase(trim(SqlType))="UPDATE" then
TempSql="&quot;update " & TableName & " set "
for i=beginField to EndField
TempSql=TempSql & rs(i).name & "=@#&quot; & " & FieldArrayName & "(" & ArrayBeginNum & ") & &quot;@#,"
ArrayBeginNum=ArrayBeginNum+1
next
@#去掉最后一个","和空格
TempSql=left(TempSql,len(TempSql)-1) & "&quot;"
else
dim ValuesStr
TempSql="&quot;Insert " & TableName & " ("
ValuesStr=" Values ("
for i=beginField to EndField
TempSql=TempSql & rs(i).name & ","
ValuesStr=ValuesStr & "@#&quot; & " & FieldArrayName & "(" & ArrayBeginNum & ")" & " & &quot;@#,"
ArrayBeginNum=ArrayBeginNum+1
next
TempSql=left(TempSql,len(TempSql)-1) & ")" & ValuesStr
TempSql=left(TempSql,len(TempSql)-1) &")&quot;"
end if
if err.number=0 then
ShowUpdateSQl="<BR>" & TempSql & "<BR><font size=@#-1@# color=@##FF0000@#>注意现在生的sql语句是没有&quot;where&quot; 子句的,<BR>这样的SQl语句及奇危险的,特别是在生成&quot;UPData&quot;语句时,应特别注意!!!!!</font><br>"
else
response.write "<br>&quot; ShowUpdateSQl&quot; 函数出错!将返回&quot; -1 &quot; <br>"
ShowUpdateSQl=-1
end if
rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear


end function
@#=========================================================================================================================================================
public function WriteInfo(InfoStr)
@#Response.Write "<font size=@#-1@# color=@##FF0000@#>&nbsp;" & InfoStr & "</font>"
WriteInfo="<font size=@#-1@# color=@##FF0000@#>&nbsp;" & InfoStr & "</font>"
end function



public function MySelectMenu(SqlStr,ConnStr,SelName,SelID,SeledValue,EventStr)

@#MySelectMenu函数功能是根据sqlstr的记录集生成并填充一个下拉列表框
@#根据传入的SQL语句生成记录后,每条记录的第一项是下拉列表的每个元素的
@#value,每条记录的第一项是下拉列表的每个元素的text
@#参数说明:
@#SqlStr:生成记录集的sql语句
@#ConnStr:与数据库联接的字符串
@#SelName:下拉列表框的名字
@#SelID:下拉列表框的id
@#SeledValue:下拉列表框的默认选项的值,如果ucase(trim(SelID))="NULL"则选中默认第一项即"----请选择----"
@# 如果ucase(trim(SelID))="MYFIRST"则是记录集rs的第一条记录的第一个字段
@#EventStr: 下接列表的事件描述字符串如果EventStr="NUll"则表示不发生任何事件

@#返回值:
@# MySelectMenu的返回值为下拉列表的默认选项的值,注意MySelectMenu并不一定SeledValuebn 也可能是-1

@#调用实例:
@# selsql="select user_code,user_name from inter_user"
@# Response.Write "<td bgcolor=@##FFFFFF@#>"
@# call MySelectMenu(selsql,ConnStr,"fieldValue","fieldValue" & i,"NULL")
@# Response.Write "</td>"
@#上面的代码是将在表格的一个格中放置一个填充好的下拉列表.


on error resume next
Dim rs,conn
set conn=server.CreateObject ("Adodb.Connection")
conn.open ConnStr
set rs=server.CreateObject ("Adodb.recordset")
rs.open SqlStr,conn,1,3

if err.number<>0 then
Response.Write "MySelectMenu函数在运行时出现错误:<BR>" & err.Description
MySelectMenu=-1
exit function
end if

@#与下拉列表控件相关参数处理
if ucase(trim(EventStr))="NULL" then EventStr=""
if ucase(trim(SelID))="NULL" then SelID=SelName@#ID的默认为与name相同
response.write "<select name=@#" & SelName & "@# id=@#" & SelID & "@# style=@# border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 1px@# " & EventStr &">"
if Ucase(Trim(SeledValue))="NULL" then @#如果指定下拉列表的没有默认值则,则它的默认值为第一项
response.write "<option value=@#-1@# selected>----请选择----</option>"
MySelectMenu=-1
else@#好象没有什么意义,
@#response.write "<option value=@#-1@#>----请选择----</option>"
end if
if rs.recordcount>0 then
dim i
for i=0 to rs.recordcount
if i=0 and Ucase(Trim(SeledValue))="MYFIRST" then @#Ucase(Trim(SeledValue))="MYFIRST"表示下拉列表的默认选定值是----请选择----后的第一个可用项.
response.write "<option value=@#" & rs(0) & "@#selected>" & rs(1) & "</option>"
MySelectMenu=rs(0)
else
if Trim(rs(0))=Trim(SeledValue) then@#注意如果数据库的结果是经过转换可能会没有一样的值
response.write "<option value=@#" & rs(0) & "@#selected>" & rs(1) & "</option>"
MySelectMenu=rs(0)
else
response.write "<option value=@#" & rs(0) & "@# >" & rs(1) & "</option>"
end if
end if
rs.movenext
next
end if
response.write "</select>"
if MySelectMenu="" then MySelectMenu=-1
rs.Close
conn.Close
set rs=nothing
set conn=nothing
Err.Clear
end function




public function AspAlert(InfoStr)
@#aspalert函数功能是在客户端弹出一个消息框


@#参数说明:
@# infostr 是将要弹出的信息文本

@#调用实例: call aspalert("成功!")

Response.Write "<script language=@#JavaScript@#>"
Response.Write "alert(@#" & InfoStr & "@#);"
Response.Write "</script>"
end function

public function AspLocation(HttpStr)@#用于在客户端窗体的转向
@#如是直接用response.redirect无法使AspAlert弹出对话框

@#参数说明:
@# HttpStr 将要转向到的网址
@#
@#调用实例:
@# dim HttpStr
@# HttpStr="http://www.clkhome/mater_code1/class/Super_Class/addnew.asp"
@# call AspLocation(httpstr)

Response.Write "<script language=@#JavaScript@#>"
Response.Write "window.location.href=@#" & HttpStr &"@#;"
Response.Write "</script>"
end function

public function AspBack(BackStep)@#用于在客户端窗本后退
@#如是直接用response.redirect无法使用AspAlert弹出对话框

@#参数说明:
@# BackStep 窗本后退的步数
@#
@#调用实例:
@#call AspBack(-2)@#回退两步

@#-----参数处理------
if not isnumeric(BackStep) then BackStep=-1

Response.Write "<script language=@#JavaScript@#>"
Response.Write "window.history.back(" & BackStep & ");"
Response.Write "</script>"
end function



@#================================================================================
@#下面是几个调用的例子

@#dim sqlstr,constr
@#constr="DSN=clkdb;UID=sa;PWD=passed"
@#这里用的是odbc数据源,用到其它机器上时,注意要修改这里才能正常运行
@#constr1="Driver={SQL Server};uid=sa;pwd=passed;database=cthpdb;server=sab"
@#sqlstr=trim(request("sqlstr"))

@#------显示表格
@#call DataGrid("SELECT * FROM mater_bcode",constr,10,20,2,50,0,"http://www.clkhome/mater_code1/tools/aaa.asp")
@#Response.Write DataGrid("SELECT * FROM mater_bcode",constr,10,20,2,7,0,"0")

@#------输入表格
@#call inputForm("SELECT id AS id, mete_sort_name AS 大类名称, mete_class_code AS 大类代码 FROM meterial_vigo",constr,0,0,"max",0)

@#全文完
@#=============================================

原文转自:http://www.ltesting.net