打开vb，新建Activex控件，工程名称为WebDb，类模块名称为GetInfomation
引用”Microsoft Activex Data Object 2.6 Library ”
Private Conn As ADODB.Connection
Private Rs As ADODB.Recordset
‘作用:判断数据库是否正确连结
'自己可以更改连接串
Public Function GetConn()
Conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=Northwind;Data Source=yang"
If Err.Number <> 0 Then
GetConn = False
Else
GetConn = True
End If
End Function
‘根据输入的雇员ID,得到雇员的名称
Public Function GetEmployeeName(strEmployeeID As Integer) As String
Dim strSql As String
Set rs = New ADODB.Recordset
strSql = "select LastName+firstname from employees where EmployeeID=" & strEmployeeID
rs.Open strSql, Conn, adOpenStatic, adLockOptimistic
If rs.EOF Then
GetEmployeeName = ""
Else
GetEmployeeName = rs.Fields(0)
End If
rs.Close
End Function
‘返回所有的雇员列表
Public Function GetEmployeeList() As ADODB.Recordset
Dim strSql As String
Set rs = New ADODB.Recordset
strSql = "select EmployeeID,LastName,FirstName,Title,TitleOfCourtesy,BirthDate,HireDate,Address,City from employees"
rs.CursorLocation = adUseClient
rs.Open strSql, Conn, adOpenStatic
Set GetEmployeeList = rs
'rs.Close
End Function
我们进行测试
新建ASP页面，”TestWebDb1.asp”。主要用来测试GetEmployeeList()方法
<HEAD>
<!- 测试页 ->
<!- 功能：测试组件 ->
<!- 作者：龙卷风.NET ->
<%
Dim strTopic
Dim strTitle
Dim strContents
Dim DataQuery
Dim Rs
Dim Myself
Myself=Request.ServerVariables("script_name")
Set DataQuery=Server.CreateObject("WebDb.GetInfomation")
Set Rs=Server.CreateObject("adodb.recordset")
%>
<TITLE>
数据组件测试页
</TITLE>
<H1><CENTER>欢迎使用数据组件(www.ourfly.com)</CENTER></H1>
<%
Dim Flag
Flag=DataQuery.GetConn()
If Flag=false then
ResPonse.Write "数据库没有连结,请检查"
ResPonse.End
End if
Set Rs=DataQuery.GetEmployeeList()
if rs.eof then
Response.write "没有数据,请查询"
Response.end
end if
Rs.PageSize =3
Page= CLng(Request.QueryString ("Page"))
If Page < 1 Then Page = 1
If Page > Rs.PageCount Then Page = Rs.PageCount
Response.Write "<CENTER><TABLE BORDER=1 cellspacing=0 cellpadding=2>"
Response.Write "<tr BGCOLOR=silver align=center>"
Response.Write "<td>EmployeeID</TD>"
Response.Write "<td>LastName</td>"
Response.Write "<td>FirstName</td>"
Response.Write "<td>Title</a></td>"
Response.Write "<td>TitleOfCourtesy</a></td>"
Response.Write "<td>BirthDate</td>"
Response.Write "<td>HireDate</td>"
Response.Write "<td>Address</td>"
Response.Write "<td>City</td>"
Response.Write "</tr>"
Rs.AbsolutePage = Page
For iPage = 1 To Rs.PageSize
Response.Write "<TR align=right>"
for i=0 to Rs.fields.count-1
Response.Write "<td>"&Rs.fields.item(i)&"</td>"
next
Response.Write "</TR>"
Rs.MoveNext
If Rs.EOF Then Exit For
next
Response.Write "</TABLE></CENTER>"
%>
<Form name="myform" method="get">
<%If Page <> 1 Then%>
<A HREF="<%=Myself%>?Page=1">第一页</A>
<A HREF="<%=Myself%>?Page=<%=(Page-1)%>">上一页</A>
<%End If%>
<%If Page <> Rs.PageCount Then%>
<A HREF="<%=Myself%>?Page=<%=(Page+1)%>">下一页</A>
<A HREF="<%=Myself%>?Page=<%=Rs.PageCount%>">最后的一页</A>
<%End If%>
页次:<FONT COLOR="Red"><%=Page%>/<%=Rs.PageCount%></FONT>
</Form>
<%
Rs.close
%>
新建ASP页面，”TestWebDb2.asp”。主要用来测试GetEmployeeName()方法
这个页面相对简单一些
<HEAD>
<!- 测试页 ->
<!- 功能：测试组件 ->
<!- 作者：龙卷风.NET ->
<%
Dim DataQuery
Dim strID
Dim strResult
Set DataQuery=Server.CreateObject("WebDb.GetInfomation")
%>
<TITLE>
数据组件测试页
</TITLE>
<H1><CENTER>欢迎使用数据组件(www.ourfly.com)</CENTER></H1>
<%
If Len(Request.QueryString("ID")) > 0 Then
strID = Request.QueryString("ID")
Dim Flag
Flag=DataQuery.GetConn()
If Flag=false then
ResPonse.Write "数据库没有连结,请检查"
ResPonse.End
End if
strResult=DataQuery.GetEmployeeName(cint(strID))
if strResult="" then
Response.Write "对不起,没有这个编号,请查询"
Response.End
else
ResPonse.Write strResult
end if
End If
%>
<FORM NAME="MyForm">
<INPUT TYPE=TEXTBOX NAME="EmpID" SIZE=40><P>
<INPUT LANGUAGE="VBScript"
TYPE="BUTTON"
VALUE="Search"
ONCLICK="window.location.href = 'TestWebDb2.asp?ID=' _
+ MyForm.EmpID.Value">
</FORM>
</HEAD>
一些想法:数据库连结如果放到组件里，如果要修改数据库连结，则要重新编译组件，可能会由此引发一些问题(但是推荐这种，毕竟数据库名和服务器名不会经常改)
如果数据库连结放到ASP页面，可以通过属性传值到组件中，但是安全性会降低。
真是……
一个完整的数据封装的、带分页的例子
打开vb6,新建Activex Dll工程。工程名修改为fCom,类名修改为fZ8
引用“Microsoft Active Server Pages Object”，”Microsoft Activex Data Object 2.7 Library”对象库。
创建两个组件事件：OnStartPage以及OnEndPage
在事件OnStartPage中创建类ScriptingContent的一个引用。
实例化类ScriptingContent。
代码如下：
Option Explicit
'**************************************************
'作者:龙卷风
'功能:简单的可以定制的，完全封装的组件
'时间:2005-01-01
'**************************************************
'对象的声明
Dim MyResponse As Response
Dim MyRequest As Request
Dim myApplication As Application
Dim myServer As Server
Dim mySession As Session
'私有变量
Private mPageSize As Long
Private mstrSql As String
'当组件被创建的时候会触发这个事件
Public Sub OnStartPage(myScriptingContent As ScriptingContext)
'进行对象的实例化
Set MyResponse = myScriptingContent.Response
Set MyRequest = myScriptingContent.Request
Set myServer = myScriptingContent.Server
Set myApplication = myScriptingContent.Application
Set mySession = myScriptingContent.Session
End Sub
'当组件被销毁的时候触发这个事件
Public Sub OnEndPage()
'销毁对象
Set MyResponse = Nothing
Set MyRequest = Nothing
Set myServer = Nothing
Set myApplication = Nothing
Set mySession = Nothing
End Sub
‘显示Table
Public Function ShowTable()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i As Integer
Dim j As Integer
Dim intPage As Integer
Dim intPageCount As Integer
Dim strScriptName As String
Dim intPos As Integer
Dim intFieldCount As Integer
'得到路径
strScriptName = MyRequest.ServerVariables("Script_Name")
intPos = InStrRev(strScriptName, "/")
If intPos <> 0 Then
strScriptName = Mid(strScriptName, intPos + 1)
End If
If IsEmpty(MyRequest("page")) Then
intPage = 1
Else
intPage = CInt(MyRequest("page"))
End If
On Error GoTo err
conn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=Northwind;Data Source=www.ajaxstu.com"
rs.Open mstrSql, conn, adOpenStatic, adLockReadOnly
'得到记录数
intFieldCount = rs.Fields.Count
'输出表格
MyResponse.Write "<table border=1 cellspacing=0 cellpadding=2>"
If Not rs.EOF Then
rs.PageSize = mPageSize
rs.AbsolutePage = intPage
'得到页数
intPageCount = rs.PageCount
'处理分页
If intPage < 1 Then intPage = 1
If intPage > intPageCount Then intPage = intPageCount
'输出表头
MyResponse.Write "<tr>"
For i = 0 To intFieldCount - 1
MyResponse.Write "<th>" & rs(i).Name & "</th>"
Next
MyResponse.Write "</tr>"
'输出内容
For i = 1 To mPageSize
If rs.EOF Then
Exit For
End If
MyResponse.Write "<tr>"
For j = 0 To intFieldCount - 1
MyResponse.Write "<td>" & rs.Fields(j).Value & "</td>"
Next
MyResponse.Write "</tr>"
rs.MoveNext
Next
'输出分页
MyResponse.Write "<tr>"
If intPage <> 1 Then
MyResponse.Write "<a href=" & strScriptName & "?page=1>[第一页]</a>"
MyResponse.Write "<a href=" & strScriptName & "?page=" & intPage - 1 & " >[上一页]</a>"
End If
If intPage <> intPageCount Then
MyResponse.Write "<a href=" & strScriptName & "?page=" & intPage + 1 & ">[下一页]</a>"
MyResponse.Write "<a href=" & strScriptName & "?page=" & intPageCount & ">[最后一页]</a>"
End If
MyResponse.Write "页次:<FONT COLOR='Red'>" & intPage & "/ " & intPageCount & "</FONT>"
MyResponse.Write "</tr>"
End If
MyResponse.Write "</table>"
'释放资源
If Not rs Is Nothing Then
If rs.State = 1 Then
rs.Close
End If
Set rs = Nothing
End If
If Not conn Is Nothing Then
If conn.State = 1 Then
conn.Close
End If
Set conn = Nothing
End If
Exit Function
err:
MyResponse.Write err.Number & err.Description
If Not rs Is Nothing Then
If rs.State = 1 Then
rs.Close
End If
Set rs = Nothing
End If
If Not conn Is Nothing Then
If conn.State = 1 Then
conn.Close
End If
Set conn = Nothing
End If
End Function
‘定义属性
Public Property Get ShowPageSize() As Variant
ShowPageSize = mPageSize
End Property
Public Property Let ShowPageSize(ByVal vNewValue As Variant)
mPageSize = vNewValue
End Property
Public Property Get strSQL() As Variant
strSQL = mstrSql
End Property
Public Property Let strSQL(ByVal vNewValue As Variant)
mstrSql = vNewValue
End Property
编译成Dll文件,系统自动会注册。
否则就手工注册 Regsvr32 f:\test\fcom.dll
测试
打开visual interdev6.0,生成一个fz8.asp文件
<%@ Language=VBScript %>
<HTML>
<BODY>
<%
dim obj
set obj=server.CreateObject("fcom.fz8")
‘每页显示的记录数
obj.ShowPageSize=10
‘显示的sql语句
obj.strSQL="select customerid,companyname,contactname,contacttitle,address from customers"
obj.ShowTable()
%>
</BODY>
</HTML>
配置好虚拟目录，在ie中执行fc8.asp文件，可以看到
