学步园

因为某些原因，单位需要上公文系统，实现公文到达时可以发送即时通知。在没有LotusMinder的前提下，加上一直都在用RTX，只好开发Lotus和RTX的互通接口。

好在Lotus和RTX的VB API文档还是比较全面的，定义好的界面元素如下：

界面中Lotus服务器地址和RTX地址不用多说，收发员账号在本例中默认考虑为RTX和Lotus的是一样的，这个在发送RTX通知和自动登录公文系统地址时会用到。收发员密码也是用来发送一个自动登录公文系统的链接所用到的。公文系统地址是从一个<Form>标签中提取出来的，可以实现自动登录，在后面加上收发员账号和密码可以实现自动登录。界面下方的计时器可以实现循环检测，只要设置好Interval即可，单位为毫秒。

本例包含一个窗体和一个模块，这个模块是用来处理配置信息的，这样不用每次都输入相关的服务器信息和账号信息等。模块定义了两个Function：GetPrivateProfileStringByKeyName和WritePrivateProfileStringByKeyName一个是用来保存配置，一个用来在初始化窗体时读取配置。模块代码会在最后附上。

全局声明部分

Dim Session As New NotesSession
Dim DomDir As New NotesDatabase
Dim DomView As New NotesView
Dim Domdoc As New NotesDocument
Dim inifile As String
Dim RootObj As RTXSAPIRootObj '声明一个RTXSAPIRootObj变量

Load事件：

Set RootObj = CreateObject("RTXSAPIRootObj.RTXSAPIRootObj") ' 创建根对象

Set Session = CreateObject("Lotus.NotesSession")
Session.Initialize ("password")

    inifile = "setting"
    If Dir(inifile, vbDirectory) = "" Then MkDir inifile '如果目录不存在，则创建目录
    inifile = inifile & "\setting.ini"
    '读取配置信息到对话框中
    lotusaddr.Text = GetPrivateStringValue("Lotus", "lotusaddr", inifile)
    RTXaddr.Text = GetPrivateStringValue("RTX", "RTXaddr", inifile)
    Receiver.Text = GetPrivateStringValue("Lotus", "Receiver", inifile)
    pass.Text = GetPrivateStringValue("Lotus", "pass", inifile)
    Gwaddr.Text = GetPrivateStringValue("Lotus", "Gwaddr", inifile)

Start按钮点击事件

'写入配置文件
    WritePrivateProfileStringByKeyName& "Lotus", "lotusaddr", lotusaddr.Text, inifile
    WritePrivateProfileStringByKeyName& "Lotus", "Receiver", Receiver.Text, inifile
    WritePrivateProfileStringByKeyName& "RTX", "RTXaddr", RTXaddr.Text, inifile
    WritePrivateProfileStringByKeyName& "Lotus", "pass", pass.Text, inifile
    WritePrivateProfileStringByKeyName& "Lotus", "Gwaddr", Gwaddr.Text, inifile
    
    
    Timer1.Enabled = True
    Stopcmd.Enabled = True
    FOAclick.Enabled = False

Stop按钮点击事件

'禁用开始按钮
FOAclick.Enabled = True
'禁用本按钮
Stopcmd.Enabled = False
'开始循环检测
Timer1.Enabled = False

计时器代码

Set DomDir = Session.GetDatabase(lotusaddr.Text, "app\TransCenter.nsf")
Set DomView = DomDir.GetView("P1.待收公文")
counts = DomView.RowLines
If counts > 0 Then
RTX_Sender ("[共有" & counts & "个公文待您接收|" & Gwaddr.Text & "&username=" & Receiver & "&password=" & pass.Text & "]")
End If

其中，RTX_Sender功能代码会在后面给出，内容为一个带链接的提示。

RTX_Sender功能代码

Private Sub RTX_Sender(MsgStr As String)
RootObj.ServerIP = RTXaddr.Text '设置服务器IP
RootObj.ServerPort = "8006" ' 设置服务器端口，默认为8006

On Error Resume Next
RootObj.SendNotify Receiver.Text, "FOA公文处理提示", 0, MsgStr
If (Err.Number <> 0) Then
MsgBox "发送失败" & MsgStr
End If
End Sub

另外还有一个模块代码：

Option Explicit

Declare Function GetPrivateProfileStringByKeyName& Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName$, ByVal lpszKey$, ByVal lpszDefault$, ByVal lpszReturnBuffer$, ByVal cchReturnBuffer&, ByVal lpszFile$)
Declare Function WritePrivateProfileStringByKeyName& Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String)
Private rtn As String
Private success As String

Function GetPrivateStringValue(section$, Key$, File) As String
Dim KeyValue$
Dim characters As Long
    If Dir(File) = "" Then Exit Function
    KeyValue$ = String$(FileLen(File), 0)
    characters = GetPrivateProfileStringByKeyName(section$, Key$, "", KeyValue$, Len(KeyValue$) - 1, File)
    If characters > 1 Then
        KeyValue$ = StrConv(LeftB(StrConv(KeyValue$, vbFromUnicode), characters), vbUnicode)
    End If
    GetPrivateStringValue = Replace(KeyValue$, Chr(0), "")
End Function