2011年9月20日火曜日

LotusScriptでホットスポットを追加してみた

LotusScriptを使って、リッチテキストフィールドへホットスポットのURLリンク(リソースリンク)を追加することはできないものかと思案していましたが、ようやく解決できました。

先日の懇談室のスレではNotesクライアントの設定次第でホットスポットにならないことがありますが、こちらはたぶん大丈夫。

やり方はちょっとズルイかもしれません。

1. リッチテキストに追加するホットスポットの定義が書かれたxmlをDBへインポートして文書を作ります
2. ビューで選択した文書のリッチテキストフィールドへ1で作成した文書のリッチテキストフィールドを追加し、保存します
3. 1で作成した文書を削除します

ここでxmlをどのように記述すればよいの?というギモンが湧きます。

実際に手動でホットスポットを作成した文書を作っておき、NotesDXLExporterクラスを使ってXML形式のファイルへ書き出してみました。
書き出したXMLファイルから要らなそうな記述を削除したものが、下のコードの docxml = | から </document>| までの部分です。

Sub Initialize
 Dim ss As New NotesSession
 Dim db As NotesDatabase
 Dim dc As NotesDocumentCollection
 Dim doc As NotesDocument, tmpdoc As NotesDocument
 Dim rtitem As NotesRichTextItem
 Dim stream As NotesStream
 Dim importer As NotesDXLImporter
 Dim docxml As String
 
 Set db = ss.CurrentDatabase
 
 'xmlの内容はExportした文書を参考に。
 docxml = |







"http://www.google.co.jp"

検索サイトへのリンク




|
 
 '文書作成用のxmlをストリームへ書き込み、文書へ変換する
 Set stream = ss.CreateStream
 Call stream.WriteText( docxml )
 Set importer = ss.CreateDXLImporter( stream, db )
 importer.DocumentImportOption = 2 'DXLIMPORTOPTION_CREATE
 Call importer.Process
 
 '変換した文書のリッチテキストフィールドの内容を選択文書へ追加する
 nid = importer.GetFirstImportedNoteId
 Set tmpdoc = db.GetDocumentByID( nid ) '変換した文書
 Set dc = db.UnprocessedDocuments
 Set doc = dc.GetFirstDocument '選択文書
 Set rtitem = doc.GetFirstItem( "Body" ) 'ホットスポットを追加するフィールド
 Call rtitem.AppendRTItem( tmpdoc.GetFirstItem( "Body" ) )
 Call doc.Save( True, True )
 
 '変換した文書を削除する
 Call tmpdoc.Remove( False )
End Sub


xmlのうち、タグがホットスポット、タグがリンク先のURLで、タグがリンクとして表示する文言になります。

応用すればホットスポットボタンも追加できそううですね。

※Lotus Notes 8.0.1 Basic にて動作確認しました

2011年4月6日水曜日

編集者も他人が作成した文書を削除できないようにする

ACLで編集者アクセスを付与された人は他人が作成した文書を編集することはできますが、削除に関しては権限を別途付与しなければなりません。

編集者アクセスに削除権限を付与した場合、閲覧権限のある文書はすべて削除できてしまいますが、これを制限したいといった要望もあります。

そんなとき、削除の許可を判断するロジックをデータベーススクリプトにある QueryDocumentDelete イベントへ記述します。

以下の記述例では次のような判断を行い、削除を制限しています。
・管理者ロール[Admin]を付与されている場合、削除できる
・自身が(アイテム"CreatedBy"に設定されている)文書の作成者であれば削除できる
・複数の文書を選択した場合、ひとつでも他人が作成した文書があれば削除できない
Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
    Dim dc As NotesDocumentCollection
    Dim doc As NotesDocument
    Dim username$
    Dim dbadmin As Variant
    
    dbadmin = Evaluate(|@IsMember("[Admin]"; @UserRoles)|)
    If dbadmin(0) <> 0 Then Exit Sub
    username = Source.Database.Parent.UserName
    Set dc = Source.Documents
    If dc.count = 0 Then Exit Sub
    Set doc = dc.GetFirstDocument
    While Not doc Is Nothing
        If doc.HasItem( "CreatedBy" ) Then
            If username <> doc.GetItemValue( "CreatedBy" )( 0 ) Then
                Continue = False
                Exit Sub
            End If
        End If
        Set doc = dc.GetNextDocument( doc )
    Wend
End Sub

削除しようと選択した文書は NotesUIDatabase クラスの Documents プロパティから取得できます。
ビューから複数の文書を選択してDeleteキーを押した場合など、複数の文書が戻ることもありますので、戻り値は NotesDocumentCollection です。
文書の削除を続行させたい場合、Continue を True として処理を抜けます。
削除させたくない条件にひっかかったら、 Continue へ False を代入します。

削除できないことを Messagebox などで教えてあげるとより親切ですね。