深圳升蓝软件
数据库开发 .Net技术  |  ASP技术 PHP技术 JSP技术 应用技术类   
Hiblue Software

关于客户端用ASP参生报表(高级篇)


March 25,2004
上回曾贴一篇较简单的用ASP+RDS客户端参生报表
此回贴一篇较复杂的用ASP+RDS+组件客户端参生报表
错误说明:(若提示ActiveX 元件无法参生 RDS.DataSpace)
IE需设置安全选项
操作:菜单工具->INTERNET选项->安全性->自定义
设置:起始但ActiveX不标示为安全->开启   
原理说明:
    客户端直接用RDS产生RecordSet安全性不够,使用了
middle-tier Automation components 后可大大增加安全性!
请看下文:
编写注册元件:
ActiveX Dll project:iacrdsobj.vbp
Class Module name:RsOp

Public Function ReturnRs(strDB As Variant, strSQL As Variant) As ADODB.Recordset
        'Returns an ADODB recordset.
        On Error GoTo ehGetRecordset
        Dim cn As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Dim strConnect As String  
        strConnect = "Provider=SQLOLEDB;Server=server name ;uid=sa;pwd=; Database=" & strDB & ";"
        cn.Open strConnect
        'These are not listed in the typelib.
        rs.CursorLocation = adUseClient
        'Using the Unspecified parameters, an ADO/R recordset is returned.
        rs.Open strSQL, cn, adOpenUnspecified, adLockUnspecified, adCmdUnspecified
        Set ReturnRs = rs
      Exit Function
ehGetRecordset:
        Err.Raise Err.Number, Err.Source, Err.Description
      End Function
然后 MAKE iacrdsobj.dll
若有错,请设置VB菜单PROJECT-REFREENCE
增加 MicroSoft ActiveX Data Object 2.6 Library(当然数字要高一点)

然后 注册iacrdsobj.dll到数据库server(为安全,最好更改数据库uid最好不为sa)!
好,接下来看asp
long1.asp
<html>
<head>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
<title>client use rds produce excel report</title>
</head>
<body bgColor=skyblue topMargin=5 leftMargin="20" oncontextmenu="return false" rightMargin=0 bottomMargin="0">

<div align="center"><center>        
<table border="1" bgcolor="#ffe4b5" style="HEIGHT: 1px; TOP: 0px" bordercolor="#0000ff">
    <tr>
         <td align="middle" bgcolor="#ffffff" bordercolor="#000080">
         <font color="#000080" size="3">   
         client use rds produce excel report
         </font>
         </td>
    </tr>
</table>
</div>
<form action="long1.asp" method="post" name="myform">
<DIV align=left>
<input type="button" value="Query Data"   name="query"  language="vbscript" onclick="fun_excel(1)"  style="HEIGHT: 32px; WIDTH: 90px">
<input type="button" value="Clear Data"   name="Clear"  language="vbscript" onclick="fun_excel(2)"  style="HEIGHT: 32px; WIDTH: 90px">
<input type="button" value="Excel Report" name="report" language="vbscript" onclick="fun_excel(3)"  style="HEIGHT: 32px; WIDTH: 90px">
</div>
<DIV id="adddata"></div>
</form>
</body>
</html>
<script language="vbscript">
sub fun_excel(t)
    Dim rds,rs,df,ServerStr               
    dim strSQL,StrRs
    Dim xlApp, xlBook, xlSheet1
    ServerStr="http://Sql Server Name" 'the sql server name of register iacRDSObj.dll
'use rds to produce client recordset  
    set rds = CreateObject("RDS.DataSpace",ServerStr)
    'eg:set rds = CreateObject("RDS.DataSpace","http://iac_fa")  'iac_fa is the LAN sql server name
    'eg:set rds = CreateObject("RDS.DataSpace","http://10.150.254.102") '10.150.254.102 is the LAN sql server IP Address
'the register com
    Set df = rds.CreateObject("iacRDSObj.rsop", ServerStr)
'the query string of sql
    strSQL = "Select top 8 * from jobs order by job_id"
'the recordset
    Set rs = df.ReturnRs("pubs",strSQL)
    if t=1 then  
       if not rs.eof then
          StrRs="<table border=1><tr><td>job_id</td><td>job_desc</td><td>max_lvl</td><td>min_lvl</td></tr><tr><td>"+ rs.GetString(,,"</td><td>","</td></tr><tr><td>"," ") +"</td></tr></table>"   
          adddata.innerHTML=StrRs
          StrRs=""
       else
          msgbox "No data in the table!"  
       end if
    elseif t=2 then      
          StrRs=""
          adddata.innerHTML=StrRs
    elseif t=3 then      
       Set xlApp = CreateObject("EXCEL.APPLICATION")
       Set xlBook = xlApp.Workbooks.Add
       Set xlSheet1 = xlBook.Worksheets(1)
       xlSheet1.cells(1,1).value ="the job  table "
       xlSheet1.range("A1:D1").merge
       xlSheet1.cells(2,1).value = "job_id"
       xlSheet1.cells(2,2).value = "job_desc"
       xlSheet1.cells(2,3).value = "max_lvl"
       xlSheet1.cells(2,4).value = "min_lvl"
       cnt = 3
'adapt to office 97 and 2000
       do while not rs.eof
          xlSheet1.cells(cnt,1).value = rs("job_id")
          xlSheet1.cells(cnt,2).value = rs("job_desc")
          xlSheet1.cells(cnt,3).value = rs("max_lvl")
          xlSheet1.cells(cnt,4).value = rs("min_lvl")
          rs.movenext
          cnt = cint(cnt) + 1
       loop
       xlSheet1.Application.Visible = True
      
'adapt to office 2000 only
        'xlSheet1.Range("A3").CopyFromRecordset rs
        'xlSheet1.Application.Visible = True
    end if
    rs.close
    set rs=nothing
end sub
</script>

       
Copyright © 2001-2008 Shenzhen Hiblue Software Team All rights reserved