lotus.txt

lotus一些程序例子的代码.如:天气预报刷新

1. 当然先创建一个数据库，建立基本的Form,View,Outline等。这些在我们这篇文章中就不详细讲了。

2. 现在是重点了，创建一个代理 "Get Weather"，下面是他的LotusScript代码:

Sub Initialize
 
 Dim s As New NotesSession
 Dim db As NotesDatabase
 Set db = s.CurrentDatabase
 Dim R As String
 
 Dim t As Integer
 Dim c As Integer
 Dim i As Integer
 Redim key(1)
 
 Redim Cg(3)   ' Category标志定义
 Cg(0)="China"
 Cg(1)="China"
 Cg(2)="World"
 Cg(3)="World"
 
 Redim WebAdd(3)  ' 天气预报的网址可以是多个网址
 WebAdd(0)="http://weather.china.org.cn/english/forecast/china_city_24_c.html"
 WebAdd(1)="http://weather.china.org.cn/english/forecast/china_city_48_c.html"
 WebAdd(2)="http://weather.china.org.cn/english/forecast/world_city_24_c.html"
 WebAdd(3)="http://weather.china.org.cn/english/forecast/world_city_48_c.html"
 
 Redim Pd(3)    ' Period标识
 Pd(0)="0"
 Pd(1)="1"
 Pd(2)="0"
 Pd(3)="1"
 
 Dim post As Variant
 Dim AItem As NotesItem
 Set xml=CreateObject("Microsoft.XMLHTTP")
 For t=0 To Ubound(WebAdd)
  Redim Weath(6,0)          ' 二维数组用于保存天气数据
  Call xml.open("Get",WebAdd(t),False)
  Call xml.setrequestheader("content-length",1)
  Call xml.setrequestheader("content-type","application/x-www-form-urlencoded")
  Call xml.send(post)
  R=xml.responseText      '获得的网页以Text的形式保存到一个String
  
  R=Strright(R,"<tbody>")
  R=Strleft(R,"</table>")
%REM
  Set mail=New NotesDocument(db)
  mail.form="Memo"
  Set rt=New NotesRichTextItem(mail,"Body")
  Call rt.appendtext(R)
  Call mail.send(False,"Yang Li")
  Exit Sub
%END REM
  c=0
  i=0
  While Len(R)>50                ' 两个循环把各个城市的天气数据分离出来
   R=Strright(R,|<td valign="middle" align="center"><div align="center">|)
   Weath(i,c)=Strleft(R,"</div>")
   For i=1 To 6
    R=Strright(R,|<div align="center">|)
    Weath(i,c)=Strleft(R,"</div>")
   Next
   i=0
   c=c+1
   Redim Preserve Weath(6,c)
  Wend
  c=c-1
  Redim Preserve Weath(6,c)
  
  Dim view As NotesView
  Dim doc As NotesDocument
  Set view=db.GetView("WeaLookup")
  
  For i=0 To c      ' OK 我们要开始创建/更新Notes的文档了
   key(0)=Weath(0,i)
   key(1)=Pd(t)
   Set doc=view.GetDocumentByKey(key)     ' 根据城市名和时期来查找
   If  Not doc Is Nothing Then
    doc.Period=Pd(t)                                             ' if found, updata it
    doc.Category=Cg(t)
    doc.Language="Eng"
    doc.UpdateTime=Now
    doc.DayStatus=Weath(1,i)
    doc.DayWind=Weath(2,i)
    doc.DayTemp=Weath(3,i)
    doc.EveStatus=Weath(4,i)
    doc.EveWind=Weath(5,i)
    doc.EveTemp=Weath(6,i)
    Set AItem=doc.GetFirstItem("DocAuthors")
    If Not AItem Is Nothing Then 
     Call AItem.Remove
    End If
    Set AItem=New NotesItem(doc,"DocAuthors","$WUX_ALL",AUTHORS)
    Call doc.save(True,True)
   Else
    Set ndoc =New NotesDocument(db)                   ' if not found, create a new one
    ndoc.form="Weather"
    ndoc.Period=Pd(t)
    ndoc.Category=Cg(t)
    ndoc.Language="Eng"
    ndoc.UpdateTime=Now
    ndoc.CityName=Weath(0,i)
    ndoc.DayStatus=Weath(1,i)
    ndoc.DayWind=Weath(2,i)
    ndoc.DayTemp=Weath(3,i)
    ndoc.EveStatus=Weath(4,i)
    ndoc.EveWind=Weath(5,i)
    ndoc.EveTemp=Weath(6,i)
    Set AItem=New NotesItem(ndoc,"DocAuthors","$WUX_ALL",AUTHORS)
    Call ndoc.save(True,True)
   End If
  Next
 Next
End Sub


1。订阅Action
Sub Click(Source As Button)

Dim Adoc As NotesDocument
 Dim doc As NotesDocument
 Redim Key(1)
 Redim BNames(0)
 Dim i As Integer
 Dim t As Integer
 
 Set doc=s.DocumentContext
 If doc Is Nothing Then
  Msgbox "You should select 24Hour document, not just city name."
  Exit Sub
 End If
 Set db=s.CurrentDatabase
 Set view=db.GetView("WeaLookup")
 Key(0)=doc.CityName(0)
 Key(1)="0"
 t=0
 Set Adoc=view.GetDocumentByKey(Key)
 If Adoc.BookNames(0)<>"" Then
  For i=0 To Ubound(Adoc.BookNames)
   If Adoc.BookNames(i)=s.CommonUserName Then
    Msgbox "You already book this Weather Forecast."
    Exit Sub
   End If
   If Adoc.BookNames(i)<>"" Then
    BNames(t)=Adoc.BookNames(i)
    t=t+1
    Redim Preserve BNames(t)
   End If
  Next
  BNames(t)=s.CommonUserName
  Adoc.BookNames=BNames
 Else
  Adoc.BookNames=s.CommonUserName
 End If
 Call Adoc.Save(True,True)
 Msgbox "Book Weather Forecast for ["+key(0)+"] completed."+Chr(10)+_
 "Weather information will send to your mailbox every morning."
End Sub

2。撤销订阅Action
Sub Click(Source As Button)
 Dim s As New  NotesSession
 Dim db As NotesDatabase
 Dim view As NotesView
 Dim Adoc As NotesDocument
 Dim doc As NotesDocument
 Redim Key(1)
 Redim BNames(0)
 Dim i As Integer
 Dim t As Integer
 Dim found As Boolean
 
 Set doc=s.DocumentContext
 If doc Is Nothing Then
  Msgbox "You should select 24Hour document, not just city name."
  Exit Sub
 End If
 Set db=s.CurrentDatabase
 Set view=db.GetView("WeaLookup")
 Key(0)=doc.CityName(0)
 Key(1)="0"
 Set Adoc=view.GetDocumentByKey(Key)
 t=0
 found=False
 If Adoc.BookNames(0)<>"" Then
  For i=0 To Ubound(Adoc.BookNames)
   If Adoc.BookNames(i)<>s.CommonUserName Then
    BNames(t)=Adoc.BookNames(i)
    t=t+1
    Redim Preserve BNames(t)
   Else
    found=True
   End If
  Next
  If found Then
   Adoc.BookNames=BNames
   Call Adoc.Save(True,True)
   Msgbox "Cancel Weather Forecast for ["+key(0)+"] successed"
  Else
   Msgbox "You did not Subscribe Weather Forecast for ["+key(0)+"] before."
  End If
 Else
  Msgbox "You did not Subscribe Weather Forecast for ["+key(0)+"] before."
 End If
 
End Sub

3. 定时代理agent
Sub Initialize
 Dim s As New NotesSession
 Dim db As NotesDatabase
 Dim mview As NotesView
 Dim wview As NotesView
 Dim dc As NotesDocumentCollection
 Dim doc As NotesDocument
 Dim wdoc As NotesDocument
 Dim pdoc As NotesDocument
 Dim Tseed As NotesItem
 Dim rtnav As NotesRichTextNavigator
 Dim rtt As NotesRichTextTable
 Dim richStyle As NotesRichTextStyle
 Set richStyle = s.CreateRichTextStyle
 
 
 Set db=s.CurrentDatabase
 Set mview=db.GetView("WeaMail")
 Set wview=db.GetView("WeaLookup")
 Set pdoc=db.GetProfileDocument("Profile")
 Set doc=mview.GetFirstDocument
 While Not doc Is Nothing
  Set dc=wview.GetAllDocumentsByKey(doc.CityName(0))
  Set wdoc=dc.GetFirstDocument
  
  Set mail=New NotesDocument(db)
  mail.form="Memo"
  mail.subject="Weather Forecast for ["+doc.CityName(0)+"] CHS"
  mail.principal="ASAP Weather Forecast Service"
  Set rt=New NotesRichTextItem(mail,"Body")
  richStyle.Bold = True
  richStyle.NotesColor = COLOR_BLUE
  richStyle.FontSize = 10
  Call rt.AppendStyle(richStyle)
  Call rt.appendtext("City Name: ")
  Call rt.appendtext(doc.CityName(0))
  Call rt.addnewline(1)
  richStyle.Bold = False
  richStyle.NotesColor = COLOR_BLACK
  richStyle.FontSize = 9
  Call rt.AppendStyle(richStyle)
  Set Tseed = pdoc.GetFirstItem( "WeaForecastTable" )
  Call rt.appendrtitem(Tseed)
  Set rtnav = rt.CreateNavigator
  If Not rtnav.FindFirstElement(RTELEM_TYPE_TABLE) Then
   Messagebox "Body item does not contain a table,",, "Error"
   Exit Sub
  End If
  Set rtt = rtnav.GetElement
  Call rtt.AddRow(dc.count-1)
  Call rtnav.FindfirstElement(RTELEM_TYPE_TABLECELL)
  For t=1 To 8       '这里设定跳过的表头的列数
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
  Next
  
  While Not wdoc Is Nothing
   Call rt.BeginInsert(rtnav)
   
   
   
   Call rt.appendtext(wdoc.PTime1(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.DayStatus(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.DayWind(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.DayTemp(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.PTime2(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.EveStatus(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.EveWind(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   Call rt.BeginInsert(rtnav)
   Call rt.appendtext(wdoc.EveTemp(0))
   Call rt.EndInsert
   Call rtnav.FindNextElement(RTELEM_TYPE_TABLECELL)
   
   Set wdoc=dc.GetNextDocument(wdoc)
  Wend
  Call mail.send(False,doc.BookNames)
  Set doc=mview.GetNextDocument(doc)
 Wend
 
End Sub