热点排行

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

类别：Asp 点击：0 评论：0 推荐：

<%
 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'专门应用于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,"<","&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://com.8s8s.com/it/it9247.htm

Copyright © 2004-2013 信息技术中文网 All rights reserved 版权所有

Powered by 信息技术中文网 Ver2.0