<% 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'> 没有数据...</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> </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'> 没有数据...</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' οnclick='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> </td>" else Response.Write "<td><font size='-1'> " & 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'> 没有数据...</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> </td>" else Response.Write "<td><font size='-1'> " & 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'> " 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'专门应用于access,因为是对于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,"<","<") InputStr=Replace(InputStr,">",">") InputStr=Replace(InputStr,"'","''") InputStr=Replace(InputStr,vbCrLf,"<BR>") MyReplace=Replace(InputStr,chr(20)," ") end function public function ReMyReplace(InputStr) '对单个字符进行还原 InputStr=Replace(InputStr,"<","<") InputStr=Replace(InputStr,">",">") InputStr=Replace(InputStr,"''","'") InputStr=Replace(InputStr,"<BR>",vbCrLf) ReMyReplace=Replace(InputStr," ",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=""update " & TableName & " set " for i=beginField to EndField TempSql=TempSql & rs(i).name & "='" & " & FieldArrayName & "(" & ArrayBeginNum & ") & "'," ArrayBeginNum=ArrayBeginNum+1 next '去掉最后一个","和空格 TempSql=left(TempSql,len(TempSql)-1) & """ else dim ValuesStr TempSql=""Insert " & TableName & " (" ValuesStr=" Values (" for i=beginField to EndField TempSql=TempSql & rs(i).name & "," ValuesStr=ValuesStr & "'" & " & FieldArrayName & "(" & ArrayBeginNum & ")" & " & "'," ArrayBeginNum=ArrayBeginNum+1 next TempSql=left(TempSql,len(TempSql)-1) & ")" & ValuesStr TempSql=left(TempSql,len(TempSql)-1) &")"" end if if err.number=0 then ShowUpdateSQl="<BR>" & TempSql & "<BR><font size='-1' color='#FF0000'>注意现在生的sql语句是没有"where" 子句的,<BR>这样的SQl语句及奇危险的,特别是在生成"UPData"语句时,应特别注意!!!!!</font><br>" else response.write "<br>" ShowUpdateSQl" 函数出错!将返回" -1 " <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'> " & InfoStr & "</font>" WriteInfo="<font size='-1' color='#FF0000'> " & 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)
'全文完'================================================================================
