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

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(" DataGrid函数在运行出现了错误! 错描述:" & err.Description & " ")

DataGrid="Err"

exit function

end if

if rs.RecordCount<1 then

Response.Write " 没有数据..."

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 "第" & PageNum & "页，共" & rs.PageCount & "页"

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'>序</td>"

dim i

for i=beginField to EndField

Response.Write "<td align='center'>" & rs.Fields(i).Name & "</td>"

if Isnumeric(IDfield) then '复选框及修改链接处理

if IDField>=0 and (IDField - rs.fields.count<=0) then

Response.Write "<td width='1%' align='center'>删</td>"

if trim(httpstr)<>"0" then Response.Write "<td width='1%'>修</td>"

end if

Response.Write "</tr>"

'写入字段信息

dim RecordNum,FieldNum

for RecordNum=0 to PageSize-1 '？？？？？？？？？？？？？？？？？

Response.Write "<tr bgcolor='#FFFFFF'>"

Response.Write "<td>" & RecordNum +1+(PageNum-1)*PageSize & "</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><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) & "'></td>"

'end if

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><a href='" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"'>改</a></td>"

end if

Response.Write "</tr>"

rs.MoveNext

if rs.eof then exit for '最后不到一整页时，也跳出

Response.Write "</table>"

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(" DataGrid函数在运行出现了错误! 错描述:" & err.Description & " ")

DataGrid="Err"

exit function

end if

if rs.RecordCount<1 then

Response.Write " 没有数据..."

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 "第" & PageNum & "页，共" & rs.PageCount & "页"

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()'>序</td>"

dim i

for i=beginField to EndField

Response.Write "<td align='center'>" & rs.Fields(i).Name & "</td>"

if Isnumeric(IDfield) then '复选框及修改链接处理

if IDField>=0 and (IDField - rs.fields.count<=0) then

Response.Write "<td width='1%' align='center'>删</td>"

if trim(httpstr)<>"0" then Response.Write "<td width='1%'>修</td>"

end if

Response.Write "</tr>"

'写入字段信息

dim RecordNum,FieldNum

for RecordNum=0 to PageSize-1 '？？？？？？？？？？？？？？？？？

Response.Write "<tr bgcolor='#FFFFFF'>"

Response.Write "<td>" & RecordNum +1+(PageNum-1)*PageSize & "</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> " & Trim(rs.Fields(FieldNum).Value) & "</td>"

end if

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><a href='" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"'>改</a></td>"

end if

Response.Write "</tr>"

rs.MoveNext

if rs.eof then exit for '最后不到一整页时，也跳出

Response.Write "</table>"

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 " DoubleDataGrid函数出错错误: " &err.Description

exit function

end if

if rs.RecordCount<1 then

Response.Write " 没有数据..."

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 "第" & PageNum & "页，共" & rs.PageCount & "页"

'写入表头

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'>序</td>"

dim i

for i=beginField to EndField

Response.Write "<td align='center'>" & rs.Fields(i).Name & "</td>"

if Isnumeric(IDfield) then '复选框及修改链接处理

if IDField>=0 and (IDField - rs.fields.count<=0) then

Response.Write "<td width='1%'align='center'>删</td>"

if trim(httpstr)<>"0" then Response.Write "<td width='1%'>修</td>"

end if

Response.Write "</tr>"

'写入字段信息

dim RecordNum,FieldNum,SWhere,SSSql

for RecordNum=0 to PageSize-1 '？？？？？？？？？？？？？？？？？

Response.Write "<tr bgcolor='#FFFFFF'>"

Response.Write "<td>" & RecordNum +1+(PageNum-1)*PageSize & "</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> " & trim(rs.Fields(FieldNum).Value) & "</td>"

end if

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><a href='" & httpstr & "?IDField="& rs.Fields(IDfield).Value &"'>改</a></td>"

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 '最后不到一整页时，也跳出

Response.Write "</table>"

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'>" & rs.Fields(i).Name & "</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

else

end if

Response.Write "</tr>"

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( " ExecuteSQl出现错误: " & err.Description & " ")

ExecuteSQl=err.number

exit function

else

conn.Execute sqlstr

if err.number <>0 then

response.write Writeinfo( " ExecuteSQl出现错误: " & err.Description & " ")

ExecuteSQl=err.number

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(" ExecuteSqlPut函数出现错误: " & err.Description)

ExecuteSqlPut="Err"

else

rs=conn.execute(sqlstr)

if err.number <>0 then

response.write writeinfo(" ExecuteSqlPut函数运行,出现错误:" & err.Description )

ExecuteSqlPut="Err"

else

ExecuteSqlPut=rs(0)

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," ")

MyReplace=Replace(InputStr,chr(20)," ")

end function

public function ReMyReplace(InputStr) '对单个字符进行还原

InputStr=Replace(InputStr,"&lt","<")

InputStr=Replace(InputStr,"&gt",">")

InputStr=Replace(InputStr,"''","'")

InputStr=Replace(InputStr," ",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))

else

for i=0 to ubound(InputStr)

InputStr(i)=ReMyReplace(InputStr(i))

end if

MyReplaceS=InputStr

end function

public function MyTrimS(InputStrS)'对字符数组中的每个元素去左右空格

dim i

for i=0 to ubound(InputStrs)

InputStrS(i)=Trim(InputStrS(i))

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) & " "

if err.number=0 then

MyTestValue= ubound(MyValues)

else

Response.Write " 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(" ShowUpdateSQl函数运行时出现错误! 错误信息:" & 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

'去掉最后一个","和空格

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

TempSql=left(TempSql,len(TempSql)-1) & ")" & ValuesStr

TempSql=left(TempSql,len(TempSql)-1) &")""

end if

if err.number=0 then

ShowUpdateSQl=" " & TempSql & " 注意现在生的sql语句是没有"where" 子句的, 这样的SQl语句及奇危险的,特别是在生成"UPData"语句时,应特别注意!!!!! "

else

response.write " " ShowUpdateSQl" 函数出错!将返回" -1 " "

ShowUpdateSQl=-1

end if

rs.Close

conn.Close

set rs=nothing

set conn=nothing

Err.Clear

end function

'=========================================================================================================================================================

public function WriteInfo(InfoStr)

'Response.Write " " & InfoStr & ""

WriteInfo=" " & InfoStr & ""

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函数在运行时出现错误: " & 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

rs.movenext

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)

'全文完

'================================================================================