上回曾贴一篇较简单的用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
1<html>
2<head>
3<meta content="text/html; charset=utf-8" http-equiv="Content-Type"/>
4<title>client use rds produce excel report</title>
5</head>
6<body bgcolor="skyblue" bottommargin="0" leftmargin="20" oncontextmenu="return false" rightmargin="0" topmargin="5">
7<div align="center"><center>
8<table bgcolor="#ffe4b5" border="1" bordercolor="#0000ff" style="HEIGHT: 1px; TOP: 0px">
9<tr>
10<td align="middle" bgcolor="#ffffff" bordercolor="#000080">
11<font color="#000080" size="3">
12client use rds produce excel report
13</font>
14</td>
15</tr>
16</table>
17</center></div>
18<form action="long1.asp" method="post" name="myform">
19<div align="left">
20<input language="vbscript" name="query" onclick="fun_excel(1)" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Query Data"/>
21<input language="vbscript" name="Clear" onclick="fun_excel(2)" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Clear Data"/>
22<input language="vbscript" name="report" onclick="fun_excel(3)" style="HEIGHT: 32px; WIDTH: 90px" type="button" value="Excel Report"/>
23</div>
24<div id="adddata"></div>
25</form>
26</body>
27</html>
1<script language="vbscript">
2sub fun_excel(t)
3Dim rds,rs,df,ServerStr
4dim strSQL,StrRs
5Dim xlApp, xlBook, xlSheet1
6ServerStr="http://Sql Server Name" 'the sql server name of register iacRDSObj.dll
7'use rds to produce client recordset
8set rds = CreateObject("RDS.DataSpace",ServerStr)
9'eg:set rds = CreateObject("RDS.DataSpace","http://iac_fa") 'iac_fa is the LAN sql server name
10'eg:set rds = CreateObject("RDS.DataSpace","http://10.150.254.102") '10.150.254.102 is the LAN sql server IP Address
11'the register com
12Set df = rds.CreateObject("iacRDSObj.rsop", ServerStr)
13'the query string of sql
14strSQL = "Select top 8 * from jobs order by job_id"
15'the recordset
16Set rs = df.ReturnRs("pubs",strSQL)
17if t=1 then
18if not rs.eof then
19StrRs="<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>"
20adddata.innerHTML=StrRs
21StrRs=""
22else
23msgbox "No data in the table!"
24end if
25elseif t=2 then
26StrRs=""
27adddata.innerHTML=StrRs
28elseif t=3 then
29Set xlApp = CreateObject("EXCEL.APPLICATION")
30Set xlBook = xlApp.Workbooks.Add
31Set xlSheet1 = xlBook.Worksheets(1)
32xlSheet1.cells(1,1).value ="the job table "
33xlSheet1.range("A1:D1").merge
34xlSheet1.cells(2,1).value = "job_id"
35xlSheet1.cells(2,2).value = "job_desc"
36xlSheet1.cells(2,3).value = "max_lvl"
37xlSheet1.cells(2,4).value = "min_lvl"
38cnt = 3
39'adapt to office 97 and 2000
40do while not rs.eof
41xlSheet1.cells(cnt,1).value = rs("job_id")
42xlSheet1.cells(cnt,2).value = rs("job_desc")
43xlSheet1.cells(cnt,3).value = rs("max_lvl")
44xlSheet1.cells(cnt,4).value = rs("min_lvl")
45rs.movenext
46cnt = cint(cnt) + 1
47loop
48xlSheet1.Application.Visible = True
49
50'adapt to office 2000 only
51'xlSheet1.Range("A3").CopyFromRecordset rs
52'xlSheet1.Application.Visible = True
53end if
54rs.close
55set rs=nothing
56end sub
57</script>