在LOTUS中利用ADO连结后端数据库.doc

在LOTUS中利用ADO连结后端数据库目前，绝大多数的数据库参考书都介绍了ODBC（Open DataBase Connectivity，开放式数据库连接）的手动设定方法，或者介绍了如何在程序代码中进行 ODBC 设定。但这两种方法都有一定的局限性：不是需要为每一位User设定 ODBC 数据来源，不然就是得编写复杂的更改操作系统机码文件的程序，显得既麻烦又不符合专业软件的要求。本期智颉分享报将利用 ADO（ActiveX Data Objects）建立一无须设定数据源的大型数据库连接方法(以SQL Server为例)。后续之智颉分享报将持续介绍ADO各组件之参数与使用方法,敬请期待。本期之程序范例，先让各位会员体验一下Notes跟ADO结合之用法与方便性，相关参数说明部份会在后续几期之智颉分享报中介绍。本范例为连结Microsoft SQL Server 7.0或Microsoft SQL Server 2000的NorthWind数据库,连接之Table为Suppliers数据表,建立方法如下:1.在数据库中建立一套表,套表名称为”testform”，字段如下(所有字段皆为文字型态)： 2.在套表中建立下列四个按钮,按钮程序分别为如下： ADO=SQL Server 查询数据Sub Click(Source As Button) Dim ws As New NotesUIWorkspace Dim uidoc As NotesUIDocument Dim Conn As Variant Dim EmpRS As Variant Dim DBConStr As String Dim SQLCmd As String Dim NewUser As Variant Dim AllUsers() Dim p As Integer ADO Constants Const adStateOpen = 1 Const adCmdText = 1 Const adOpenStatic = 3 Const adLockOptimistic = 3 Set uidoc=ws.CurrentDocument On Error Goto ErrorHandler Connection String (Use DSN-Less connection string) DBConStr = Provider=SQLOLEDB.1;Persist Security Info=True & _ ;Data Source=;User Id=sa;Password=password;Connect Timeout = 10; & _ Initial Catalog=Northwind; Create and Open Connection Object Set Conn = CreateObject(ADODB.Connection) Conn.Open DBConStr Sql Command SQLCmd = select * from Suppliers Create and Open Employee Recordset Object Set EmpRS=CreateObject(ADODB.Recordset) EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText Show the resulting data EmpRS.MoveFirst p=0 While(Not EmpRS.EOF) Redim Preserve AllUsers(p) AllUsers(p) = EmpRS.Fields(CompanyName).Value EmpRS.MoveNext p=p+1 Wend SelectUser = ws.Prompt(PROMPT_OKCANCELLIST, 选择供货商, 请选择欲查询之供货商名称:, AllUsers(0), AllUsers) If Trim(SelectUser)= Then Goto ProgEnd End If NewUser=Evaluate(|ReplaceSubString(|+Trim(SelectUser)+|;)|) SQLCmd =select * from Suppliers where CompanyName=+Trim(NewUser(0)+ EmpRS.Close EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText Show the resulting data EmpRS.MoveFirst If Not (EmpRS.EOF) Then 公司名称 Call uidoc.FieldSetText(CompanyName,EmpRS(CompanyName).Value) 联络人姓名 If Isnull(EmpRS(ContactName).value) Then Call uidoc.FieldSetText(ContactName,) Else Call uidoc.FieldSetText(ContactName,EmpRS(ContactName).Value) End If 联络人职称 If Isnull(EmpRS(ContactTitle).value) Then Call uidoc.FieldSetText(ContactTitle,) Else Call uidoc.FieldSetText(ContactTitle,EmpRS(ContactTitle).Value) End If 地址 If Isnull(EmpRS(Address).value) Then Call uidoc.FieldSetText(Address,) Else Call uidoc.FieldSetText(Address,EmpRS(Address).Value) End If 城市 If Isnull(EmpRS(City).value) Then Call uidoc.FieldSetText(City,) Else Call uidoc.FieldSetText(City,EmpRS(City).Value) End If 地区 If Isnull(EmpRS(Region).value) Then Call uidoc.FieldSetText(Region,) Else Call uidoc.FieldSetText(Region,EmpRS(Region).Value) End If 邮政编码 If Isnull(EmpRS(PostalCode).value) Then Call uidoc.FieldSetText(PostalCode,) Else Call uidoc.FieldSetText(PostalCode,EmpRS(PostalCode).Value) End If 国家Top If Isnull(EmpRS(Country).value) Then Call uidoc.FieldSetText(Country,) Else Call uidoc.FieldSetText(Country,EmpRS(Country).Value) End If 电话号码 If Isnull(EmpRS(Phone).value) Then Call uidoc.FieldSetText(Phone,) Else Call uidoc.FieldSetText(Phone,EmpRS(Phone).Value) End If 传真号码 If Isnull(EmpRS(Fax).value) Then Call uidoc.FieldSetText(Fax,) Else Call uidoc.FieldSetText(Fax,EmpRS(Fax).Value) End If 公司网页 If Isnull(EmpRS(HomePage).value) Then Call uidoc.FieldSetText(HomePage,) Else Call uidoc.FieldSetText(HomePage,EmpRS(HomePage).Value) End If Call uidoc.Refresh Else Messagebox 查无资料! End IfProgEnd: Clean up EmpRS.Close Conn.Close Set EmpRS=Nothing Set Conn=Nothing Exit Sub ErrorHandler: Clean up If Not EmpRS Is Nothing Then If EmpRS.State = adStateOpen Then EmpRS.Close End If Set EmpRS = Nothing If Not Conn Is Nothing Then If Conn.State = adStateOpen Then Conn.CloseEnd If Set Conn = Nothing End SubADO=SQLServer 新增资料Sub Click(Source As Button) Dim ws As New NotesUIWorkspace Dim uidoc As NotesUIDocument Dim Conn As Variant Dim EmpRS As Variant Dim DBConStr As String Dim SQLCmd As String Dim AllUsers As String ADO Constants Const adStateOpen = 1 Const adCmdText = 1 Const adCmdTable = 2 Const adOpenStatic = 3 Const adLockOptimistic = 3 Set uidoc=ws.CurrentDocument On Error Goto ErrorHandler Connection String (Use DSN-Less connection string) DBConStr = Provider=SQLOLEDB.1;Persist Security Info=True & _ ;Data Source=;User Id=sa;Password=password;Connect Timeout = 10; & _ Initial Catalog=Northwind; Create and Open Connection Object Set Conn = CreateObject(ADODB.Connection) Conn.Open DBConStr Create and Open Employee Recordset Object Set EmpRS=CreateObject(ADODB.Recordset) EmpRS.CursorType=1 EmpRS.LockType=3 EmpRS.Open Suppliers,Conn,1,3,adCmdTable EmpRS.AddNew If Trim(uidoc.FieldGetText(CompanyName)= Then 字段验证 Messagebox 请务必填写公司名称! Else EmpRS(CompanyName).value=uidoc.FieldGetText(CompanyName) EmpRS(ContactName).value=uidoc.FieldGetText(ContactName) EmpRS(ContactTitle).value=uidoc.FieldGetText(ContactTitle) EmpRS(Address).value=uidoc.FieldGetText(Address) EmpRS(City).value=uidoc.FieldGetText(City) EmpRS(Region).value=uidoc.FieldGetText(Region) EmpRS(PostalCode).value=uidoc.FieldGetText(PostalCode) EmpRS(Country).value=uidoc.FieldGetText(Country) EmpRS(Phone).value=uidoc.FieldGetText(Phone) EmpRS(Fax).value=uidoc.FieldGetText(Fax) EmpRS(HomePage).value=uidoc.FieldGetText(HomePage) EmpRS.Update End If Clean up EmpRS.Close Conn.Close Set EmpRS=Nothing Set Conn=Nothing Exit Sub ErrorHandler: Clean up If Not EmpRS Is Nothing Then If EmpRS.State = adStateOpen Then EmpRS.Close End If Set EmpRS = Nothing If Not Conn Is Nothing Then If Conn.State = adStateOpen Then Conn.Close End If Set Conn = Nothing End SubADO=SQL Server 删除数据Sub Click(Source As Button) Dim ws As New NotesUIWorkspace Dim uidoc As NotesUIDocument Dim Conn As Variant Dim EmpRS As Variant Dim DBConStr As String Dim SQLCmd As String Dim NewUser As Variant Dim AllUsers() Dim p As Integer ADO Constants Const adStateOpen = 1 Const adCmdText = 1 Const adOpenStatic = 3 Const adLockOptimistic = 3 Set uidoc=ws.CurrentDocumentOn Error Goto ErrorHandlerTop Connection String (Use DSN-Less connection string) DBConStr = Provider=SQLOLEDB.1;Persist Security Info=True & _ ;Data Source=;User Id=sa;Password=password;Connect Timeout = 10; & _ Initial Catalog=Northwind; Create and Open Connection Object Set Conn = CreateObject(ADODB.Connection) Conn.Open DBConStr Sql Command SQLCmd = select * from Suppliers Create and Open Employee Recordset Object Set EmpRS=CreateObject(ADODB.Recordset) EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText Show the resulting data EmpRS.MoveFirst p=0 While(Not EmpRS.EOF) Redim Preserve AllUsers(p) AllUsers(p) = EmpRS.Fields(CompanyName).Value EmpRS.MoveNextp=p+1 Wend SelectUser = ws.Prompt(PROMPT_OKCANCELLIST, 选择供货商, 请选择欲删除之供货商名称:, AllUsers(0), AllUsers) If Trim(SelectUser)= Then Exit Sub End If NewUser=Evaluate(|ReplaceSubString(|+Trim(SelectUser)+|;)|) SQLCmd =select * from Suppliers where CompanyName=+Trim(NewUser(0)+ EmpRS.Close EmpRS.Open SQLCmd,Conn,adOpenStatic,adLockOptimistic,adCmdText Show the resulting data EmpRS.MoveFirst If Not (EmpRS.EOF) Then YN=Messagebox(确认要删除该笔数据吗?,36,确认) If YN6 Then Goto ProgEnd End If EmpRS.Delete EmpRS.Update Else Messagebox 查无资料!End IfProgEnd: Clean up EmpRS.Close Conn.Close Set EmpRS=Nothing Set Conn=Nothing Exit Sub ErrorHandler: Clean up If Not EmpRS Is Nothing Then If EmpRS.State = adStateOpen Then EmpRS.Close End If Set EmpRS = Nothing If Not Conn Is Nothing Then If Conn.State = adStateOpen Then Conn.Close End If Set Conn = Nothing End Sub清除画面所有字段Sub Click(Source As Button) Dim w