Lotus 插入与更新SQL数据库

最新推荐文章于 2016-03-15 00:12:47 发布

pgbiao

最新推荐文章于 2016-03-15 00:12:47 发布

阅读量1.2k

点赞数

CC 4.0 BY-SA版权

文章标签： sql lotus database application function 数据库

本文链接：https://blog.youkuaiyun.com/pgbiao/article/details/6456288

本文详细介绍了同步V1.0数据库配置的方法，包括初始化、终止、获取连接字符串、打开和关闭连接等关键步骤，以及如何通过SQL查询插入和更新任务数据。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

(Declarations)

Dim GSysSession As NotesSession
Dim GSysCdb As NotesDatabase'同步V1.0数据库
Dim GSysConfigView As NotesView'同步V1.0配置视图
Dim GSysConfigDoc As NotesDocument''同步V1.0配置文档
Dim GSysSqlConnect As Variant

Dim cdb As NotesDatabase

Dim GSysTaskTableName As String

Const adCmdText = &H0001

Const adCmdStoredProc = 4

Const adSmallInt = 2

Const adInteger = 3

Const adBoolean = 11

Const adVarChar = 200

Const adChar = 129

Const adDBTimeStamp = 135

Const adDouble = 5

Const adCurrency = 6

Const adDecimal=14

Const adParamInput = 1

Const adParamOutput = 2

Const adParamInputOutput = 3

Sub Initialize

Set GSysSession=New NotesSession
Set cdb=GSysSession.CurrentDatabase
Set GSysCdb=GSysSession.GetDatabase(cdb.Server,"config.nsf",False)
Set GSysConfigView=GSysCdb.GetView("VH_Config")
Set GSysConfigDoc=GSysConfigView.GetFirstDocument()
Set GSysSqlConnect=Nothing
GSysTaskTableName=GSysConfigDoc.F_SqlTaskTableName(0)

End Sub

Sub Terminate
Call CloseSqlConnect()
End Sub

Function GetSqlConnectString()
%REM
返回连接数据库字符串
%END REM
On Error Goto ErrHandler

Dim RetString As String
If GSysConfigDoc Is Nothing Then
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2"+",Function:GetSqlConnectString()"+",未获取到连接SQL的数据库配置"
Exit Function
End If
RetString=|Provider=SQLOLEDB;|
RetString=RetString & |Data Source=| & GSysConfigDoc.GetItemValue("F_SqlConnectString")(0) & |;|
RetString=RetString & |Uid=| & GSysConfigDoc.GetItemValue("F_SqlConnectName")(0) & |;|
RetString=RetString & |Pwd=| & GSysConfigDoc.GetItemValue("F_SqlConnectPassword")(0) & |;|
RetString=RetString & |Database=| & GSysConfigDoc.GetItemValue("F_SqlDatabaseName")(0)

GetSqlConnectString=RetString

Exit Function
ErrHandler:
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2_Task"+",Function:GetSqlConnectString()"+_
"Error:" & Cstr(Error) + ",Code:" & Cstr(Err) + ",Line:" & Cstr(Erl)
End Function

Function OpenSqlConnect() As Variant
%REM
创建数据连接对象实例
%END REM
On Error Goto ErrHandler
If GSysSqlConnect Is Nothing Then
  Dim SqlConnectString As String
  SqlConnectString=GetSqlConnectString()
  If SqlConnectString=""Then
   Exit Function
  End If
  Set GSysSqlConnect=CreateObject("ADODB.Connection")
  GSysSqlConnect.ConnectionString=SqlConnectString
  GSysSqlConnect.ConnectionTimeout=30
  GSysSqlConnect.Open
  Set OpenSqlConnect=GSysSqlConnect
End If
If GSysSqlConnect Is Nothing Then
  Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2"+",Function:OpenSqlConnect()"+",连接数据库失败!"
End If
Exit Function
ErrHandler:
Set OpenSqlConnect=Nothing
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2_Task"+",Function:OpenSqlConnect()"+_
"Error:" & Cstr(Error) + ",Code:" & Cstr(Err) + ",Line:" & Cstr(Erl)
End Function

Sub CloseSqlConnect()
%REM
创建数据连接对象实例
%END REM
On Error Goto ErrHandler
If Typename(GSysSqlConnect)="OBJECT" Then
  If Not(GSysSqlConnect Is Nothing) Then
   Call GSysSqlConnect.Close()
  End If
End If
Exit Sub
ErrHandler:
Exit Sub
End Sub

Function GetRecordsetBySql(Sql As String) As Variant
On Error Goto ErrHandler
Dim Recordset As Variant
Set Recordset=Nothing
Call OpenSqlConnect()
If OpenSqlConnect Is Nothing Then
Exit Function
End If
Set Recordset=CreateObject("ADODB.Recordset")
Call Recordset.open(Sql,GSysSqlConnect,1,1,1)
If Recordset.state<>1 Then
Exit Function
End If
Set GetRecordsetBySql=Recordset

Exit Function
ErrHandler:
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2_Task"+",Function:GetRecordsetBySql()"+_
"Error:" & Cstr(Error) + ",Code:" & Cstr(Err) + ",Line:" & Cstr(Erl)
End Function

Sub CloseRecordset(Recordset As Variant)
On Error Goto ErrorHandler
If Typename(Recordset)="OBJECT" Then
  If Not(Recordset Is Nothing) Then
   Call Recordset.close()
   Set Recordset=Nothing
  End If
End If
Exit Sub
ErrorHandler:
Exit Sub
End Sub

Function InsertTaskIntoSQL(taskDoc As NotesDocument)
%REM
插入数据到 SQL数据库
%END REM
On Error Goto ErrHandler
Call OpenSqlConnect()
If GSysSqlConnect Is Nothing Then
  Exit Function
End If
Dim SqlCommand As Variant
Dim RetRecoredSet As Variant
Dim defaultsql As String
Set SqlCommand=CreateObject("ADODB.command")
Set SqlCommand.ActiveConnection=GSysSqlConnect
SqlCommand.CommandType=adCmdText
defaultsql = "insert into "+GSysTaskTableName+" (Subject,DocumentUNID,F_Application,F_DocType,F_Show,F_From,F_Readers_0,F_URL,F_CreatTime,F_LastModify) values ( ?,?,?,?,?,?,?,?,?,?)"
SqlCommand.CommandText = defaultsql
'定义字段
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("Subject" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("DocumentUNID" ,adChar,adParamInputOutput,32))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Application" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_DocType" ,adInteger,adParamInputOutput,4))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Show" ,adBoolean,adParamInputOutput,1))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_From" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Readers_0" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_URL" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_CreatTime" ,adDBTimeStamp,adParamInputOutput,8))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_LastModify" ,adDBTimeStamp,adParamInputOutput,8))

'插入值
Dim arrReaders As Variant
Dim i As Integer
arrReaders=taskDoc.GetItemValue("F_Readers_0")
For i=0 To Ubound(arrReaders)
  SqlCommand.Parameters("Subject").value=taskDoc.Subject(0)
  SqlCommand.Parameters("DocumentUNID").value=taskDoc.UniversalID
  SqlCommand.Parameters("F_Application").value=taskDoc.F_DbTitle(0)
  SqlCommand.Parameters("F_DocType").Value=taskDoc.F_DOCTYPE(0)
  If taskDoc.F_Show(0)=1Then
   SqlCommand.Parameters("F_Show").Value=True
  Else
   SqlCommand.Parameters("F_Show").Value=False
  End If
  SqlCommand.Parameters("F_From").Value=taskDoc.F_FROM(0)
  SqlCommand.Parameters("F_Readers_0").Value=arrReaders(i)
  SqlCommand.Parameters("F_URL").Value=taskDoc.F_URL(0)
  SqlCommand.Parameters("F_CreatTime").Value=taskDoc.F_CREATETIME(0)
  SqlCommand.Parameters("F_LastModify").Value=taskDoc.LastModified

  SqlCommand.Execute
Next
Call CloseSqlCommand(SqlCommand)
Exit Function
ErrHandler:
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2_Task"+",Function:InsertTaskIntoSQL()"+_
"Error:" & Cstr(Error) + ",Code:" & Cstr(Err) + ",Line:" & Cstr(Erl)
End Function

Function UpdateTaskIntoSQL(taskDoc As NotesDocument)
%REM
更新数据到 SQL数据库
%END REM
On Error Goto ErrHandler
Call OpenSqlConnect()
If GSysSqlConnect Is Nothing Then
  Exit Function
End If

Dim SqlCommand As Variant
Dim RetRecoredSet As Variant
Dim defaultsql As String
Set SqlCommand=CreateObject("ADODB.command")
Set SqlCommand.ActiveConnection=GSysSqlConnect
SqlCommand.CommandType=adCmdText

'定义字段
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("Subject" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("DocumentUNID" ,adChar,adParamInputOutput,32))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Application" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_DocType" ,adInteger,adParamInputOutput,4))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Show" ,adBoolean,adParamInputOutput,1))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_From" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_Readers_0" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_URL" ,adVarChar,adParamInputOutput,255))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_CreatTime" ,adDBTimeStamp,adParamInputOutput,8))
Call SqlCommand.parameters.append(SqlCommand.CreateParameter("F_LastModify" ,adDBTimeStamp,adParamInputOutput,8))

Dim SearchSql As String
Dim arrReaders As Variant
Dim i As Integer
arrReaders=taskDoc.GetItemValue("F_Readers_0")
For i=0 To Ubound(arrReaders)
  '更新值
  SearchSql=|UPDATE | & GSysTaskTableName & | SET | & |Subject=?,DocumentUNID=?,F_Application=?,F_DocType=?,F_Show=?,F_From=?,F_Readers_0=?,F_URL=?,F_CreatTime=?,F_LastModify=?|
  SearchSql=SearchSql &| WHERE DocumentUNID='| & taskDoc.UniversalID & |' And F_Readers_0='| & arrReaders(i) & |'|
  SqlCommand.CommandText=SearchSql
  SqlCommand.Parameters("Subject").value=taskDoc.Subject(0)
  SqlCommand.Parameters("DocumentUNID").value=taskDoc.UniversalID
  SqlCommand.Parameters("F_Application").value=taskDoc.F_DbTitle(0)
  SqlCommand.Parameters("F_DocType").Value=taskDoc.F_DOCTYPE(0)
  If taskDoc.F_Show(0)=1Then
   SqlCommand.Parameters("F_Show").Value=True
  Else
   SqlCommand.Parameters("F_Show").Value=False
  End If
  SqlCommand.Parameters("F_From").Value=taskDoc.F_FROM(0)
  SqlCommand.Parameters("F_Readers_0").Value=arrReaders(i)
  SqlCommand.Parameters("F_URL").Value=taskDoc.F_URL(0)
  SqlCommand.Parameters("F_CreatTime").Value=taskDoc.F_CREATETIME(0)
  SqlCommand.Parameters("F_LastModify").Value=taskDoc.LastModified

  SqlCommand.Execute

Next

Call CloseSqlCommand(SqlCommand)

Exit Function
ErrHandler:
Msgbox "Server:"+cdb.Server+",Database:"+cdb.FilePath+"LotusScript:LS_K2_Task"+",Function:UpdateTaskIntoSQL()"+_
"Error:" & Cstr(Error) + ",Code:" & Cstr(Err) + ",Line:" & Cstr(Erl)
End Function

Sub CloseSqlCommand(SqlCommand As Variant)
On Error Goto ErrHandler
%REM
关闭数据连接对象实例
%END REM
If Typename(SqlCommand)="OBJECT" Then
  If Not(SqlCommand Is Nothing) Then
   Set SqlCommand=Nothing
  End If
End If
Exit Sub
ErrHandler:
Exit Sub
End Sub