Lotus 插入与更新SQL数据库

(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