2025/02/02

作ってみよう:#29)スマート名刺管理 - インラインイメージを添付ファイルに変換 ①

リッチテキスト内の名刺画像が写真(= インラインイメージ)の場合、画像テータを添付ファイルに変換します。インラインイメージの操作は、通常の NotesRichText* クラスでは実現できません。そこで、今回も DXL を利用します。


インラインイメージを添付ファイルに変換

まずはこの処理のメイン関数 xConvPhoto2Attach を紹介します。

この関数はリッチテキスト内のインラインイメージを添付ファイルに変換する関数ですが、次の手順で処理を行います。

  1. リッチテキスト内からインラインイメージデータ(Base64)を文字列で取得
  2. リッチテキスト内のイメージデータを削除
  3. リッチテキストに添付ファイル(の参照)を作成
  4. 添付ファイルの実体を文書に追加
  5. 文書を保存(DXL 経由)

各手順はサブ関数により実現しています。

Private Function xConvPhoto2Attach(rndNameCard As NotesDocument, ByVal vsFld As String) As Boolean
   Dim sBase64 As String
   Dim sID As String
   Dim sTag As String
   Dim sName As String

   '名刺情報が保存された文書を取得(再取得)
   sID = rndNameCard.Noteid
   Set rndNameCard = Nothing '一旦文書開放
   Set rndNameCard = xndb.GetDocumentByID(sID)

   '① インラインイメージデータ(Base64)取得
   sBase64 = xGetDXL_FirstInlineImage64(rndNameCard, vsFld, sTag)
   sName = "NameCard." & sTag 'ファイル名

   'DXL の準備
   Dim dprs As NotesDOMParser
   Set dprs = xGetDOMParser(rndNameCard)

   'DOM ツリーのルートを取得
   Dim ddn As NotesDOMDocumentNode
   Set ddn = dprs.Document

   'リッチテキストの取得
   Dim denRT As NotesDOMElementNode
   Set denRT = xGetDXL_item(ddn, vsFld)

   'イメージデータのある段落を取得
   Dim denPar As NotesDOMElementNode
   Set denPar = xGetDXL_FirstNodeByName(denRT, "par")

   'インラインイメージを添付ファイルに変換
   '② 既存のコンテンツ(=インラインイメージ)を削除

   Call xConvP2A_DelImage(denPar)

   '③ 添付ファイル(=実体に対する参照)を追加
   Call xConvP2A_AddAttachRef(ddn, denPar, sName)

   '④ 添付ファイルの実体を追加
   Call xConvP2A_AddAttach(ddn, sName, sBase64)

   '⑤ 文書の保存(DXL 経由)
   If xSaveDXL_Update(dprs) Then
      '更新した文書を再取得
      sID = rndNameCard.Noteid
      Set rndNameCard = Nothing '一旦文書開放
      Set rndNameCard = xndb.GetDocumentByID(sID)
   End If
End Function

① のインラインイメージデータ(Base64)取得については既存の関数 xGetDXL_FirstInlineImage64 を利用しています。ただ、今回の処理では添付ファイルの拡張子を決定するために画像の形式が必要となることから、引数 sTag を追加しています(関数側の修正については次回)。


② 既存のコンテンツ(=インラインイメージ)を削除

添付ファイルとして保存する Base64 の文字列は ① で取得しました。よって、リッチテキスト内のインラインイメージは不要になります。そこで、リッチテキストから完全に削除します。 DXL で言うと、以下の赤枠の部分を削除することになります。

関数は次の通りです。引数には、インラインイメージが存在する段落 par ノードを指定します。処理は単純で、配下のノードがなくなるまで、順に消去しているだけです。

Private Function xConvP2A_DelImage(vdenPar As NotesDOMElementNode) As Boolean
   '配下ノード全削除で対応
   Dim dn As NotesDOMNode
   Set dn = vdenPar.FirstChild
   While Not(dn Is Nothing)
      If dn.IsNull Then
         Set dn = Nothing
      Else
         Call vdenPar.RemoveChild(dn)
         Set dn = vdenPar.FirstChild
      End If
   Wend
End Function


③ 添付ファイル(=実体に対する参照)を追加

削除した写真と同じ場所に添付ファイルを配置します。リッチテキスト内には、添付ファイルの実体ではなく、その参照(attachmentref ノード)を配置します。作成する DXL は下図のような構成となります。

この DXL を生成する関数は次の通りです。

Private Function xConvP2A_AddAttachRef(vddn As NotesDOMDocumentNode, vdenPar As NotesDOMElementNode, ByVal vsName As String) As Boolean
   Dim den As NotesDOMElementNode
   Dim dtn As NotesDOMTextNode

   'attachmentref ノード
   Dim denRef As NotesDOMElementNode
   Set den = vddn.CreateElementNode("attachmentref")
   Set denRef = vdenPar.Appendchild(den)

   Call denRef.SetAttribute("displayname", vsName)
   Call denRef.SetAttribute("name", vsName)

   'picture ノード
   Dim denPic As NotesDOMElementNode
   Set den = vddn.CreateElementNode("picture")
   Set denPic = denRef.Appendchild(den)

   Call denPic.SetAttribute("align", "baseline")
   Call denPic.SetAttribute("width", "76px")
   Call denPic.SetAttribute("height", "96px")

   'png ノード
   Dim denPNG As NotesDOMElementNode
   Set den = vddn.CreateElementNode("png")
   Set denPNG = denPic.AppendChild(den)

   'アイコン画像データ
   Set dtn = vddn.CreateTextNode(xcsIconImage)
   Call denPNG.AppendChild(dtn)

   'caption
   Dim denCap As NotesDOMElementNode
   Set den = vddn.CreateElementNode("caption")
   Set denCap = denPic.AppendChild(den)

   Call denCap.SetAttribute("position", "below")

   'caption 文字列
   Set dtn = vddn.CreateTextNode(vsName)
   Call denCap.AppendChild(dtn)
End Function

attachmentref ノードの役割として、リッチテキストに表示する添付ファイルアイコンの管理があります。今回は少し見栄えが良くなるよう、少し大きめの 76 x 96 ピクセルの PNG 画像をアイコンとします。アイコンの画像は、あらかじめ Base64 で変換し文字列定数 xcsIconImage に定義しています(後述)。

添付ファイルに表示されるファイル名は、画像の見出しと同じ機能を使用しています。上記関数では caption ノードを作成し、ファイル名をテキストノードにセット、見出しを ”イメージの下” に設定し、通常の添付ファイルと同等に表現しています。


④ 添付ファイルの実体を追加

添付ファイルは文書内で $FILE という特殊なフィールド内に格納されています。フィールドですので、ドキュメントノードに追加することとなります。作成する DXL は下図のようになります。

この処理を担当しているのが xConvP2A_AddAttach 関数です。

Private Function xConvP2A_AddAttach(vddn As NotesDOMDocumentNode, ByVal vsName As String, ByVal vsBase64 As String) As Boolean
   Dim den As NotesDOMElementNode
   Dim dtn As NotesDOMTextNode

   '$FILE フィールドとして追加(=ドキュメントノードに追加)
   Dim denDoc As NotesDOMElementNode
   Set denDoc = vddn.DocumentElement

   'item ノード
   Dim denItem As NotesDOMElementNode
   Set den = vddn.CreateElementNode("item")
   Set denItem = denDoc.AppendChild(den)

   Call denItem.SetAttribute("name", "$FILE")
   Call denItem.SetAttribute("seal", "true")
   Call denItem.SetAttribute("sign", "true")
   Call denItem.SetAttribute("sealed", "false")
   Call denItem.SetAttribute("summary", "true")
   Call denItem.SetAttribute("placeholder", "false")

   'object ノード
   Dim denObj As NotesDOMElementNode
   Set den = vddn.CreateElementNode("object")
   Set denObj = denItem.AppendChild(den)

   'file ノード
   Dim denFile As NotesDOMElementNode
   Set den = vddn.CreateElementNode("file")
   Set denFile = denObj.AppendChild(den)

   Call denFile.SetAttribute("name", vsName)
   Call denFile.SetAttribute("flags", "storedindoc")
   Call denFile.SetAttribute("encoding", "none")
   Call denFile.SetAttribute("hosttype", "msdos")
   Call denFile.SetAttribute("compression", "none")

   'created ノード
   Dim denDT As NotesDOMElementNode
   Set den = vddn.CreateElementNode("created")
   Set denDT = denFile.AppendChild(den)
   Set den = vddn.CreateElementNode("datetime")
   Set denDT = denDT.AppendChild(den)
   Call denDT.SetAttribute("dst", "false")
   Set dtn = vddn.CreateTextNode(xDateTime2ISO(Now))
   Call denDT.AppendChild(dtn)

   'modified ノード
   Set den = vddn.CreateElementNode("modified")
   Set denDT = denFile.AppendChild(den)
   Set den = vddn.CreateElementNode("datetime")
   Set denDT = denDT.AppendChild(den)
   Call denDT.SetAttribute("dst", "false")
   Set dtn = vddn.CreateTextNode(xDateTime2ISO(Now))
   Call denDT.AppendChild(dtn)

   'filedata ノード
   Dim denData As NotesDOMElementNode
   Set den = vddn.CreateElementNode("filedata")
   Set denData = denFile.AppendChild(den)

   'ファイルの実体
   Set dtn = vddn.CreateTextNode(vsBase64)
   Call denData.AppendChild(dtn)
End Function


⑤ 文書の保存(DXL 経由)

手順の最後は DXL 経由で文書を保存する関数です。今回はすでに存在する文書の更新しか行いませんので、専用の関数 xSaveDXL_Update を作成しました。

Private Function xSaveDXL_Update(vdprs As NotesDOMParser) As Boolean
   Dim dimp As NotesDXLImporter
   Dim nsOut As NotesStream
   Dim nd As NotesDocument
   Dim nrti As NotesRichTextItem

   Set nsOut = xns.CreateStream()
   Call vdprs.SetOutput(nsOut)
   Call vdprs.Serialize()

   On Error GoTo ErrProc

   'Import時リッチテキストを引数にするのが一番安定
   Set nd = xndb.CreateDocument
   Set nrti = nd.CreateRichTextItem("Body")
   Call nrti.AppendText(nsOut.ReadText)

   Set dimp = xns.CreateDXLImporter()
   dimp.DocumentImportOption = 5 '上書き保存
   Call dimp.Import(nrti, xndb)

   xSaveDXL_Update = True

ExitProc:
   Exit Function

ErrProc:
   xSaveDXL_Update = False
   MsgBox Error$
   Resume ExitProc
End Function

DocumentImportOption プロパティに 5 を指定している点がポイントですね。


関連関数

上記処理 ④ で添付ファイルの作成日(created ノード)と更新日(modified ノード)に現在時刻を指定している処理があります。DXL で日時を指定するためには、特別なフォーマット(ISO 8601)に変換する必要があります。このフォーマットについては過去の記事『DXL や JSON の日付値の変換』を参考にしてください。

今回は日時を文字列に変換する一方通行であること、例外処理は不要であることから、かなりの部分を固定化した単純な関数を作成しました。

Private Function xDateTime2ISO(vvDT As Variant) As String
   xDateTime2ISO = Format(vvDT, "yyyymmdd") & "T" & Format(vvDT, "hhnnss") & ",00+09"
End Function


添付ファイルのアイコン画像

③ の処理でアイコン画像にセットしている文字列を定義します。以下の画像ファイルを Base64 に変換したもので、あまりに長いので適当な位置で改行しています。

以下の宣言をスクリプトライブラリ lsReadNameCard の (Declarations) に追加します。

'変換後のアイコン画像(PNG 形式 & Base64 変換済み)
Private Const xcsIconImage = _
"iVBORw0KGgoAAAANSUhEUgAAAEwAAABgCAYAAAC3+ZRmAAAAAXNSR0IArs4c6QAAAARnQU1BAACx" & _
"jwv8YQUAAAAJcEhZcwAADsEAAA7BAbiRa+0AAAXySURBVHhe7ZqxbuNGFEXfBgkgsglAGW7EdBJs" & _
"F1IVgJVT5TeSD0i9CwRIkRQBAmzqfEDyG6kCAwGEdFZhG1JJNl57SpJFEOfe4ciWtJKsoUYAJc0B" & _
"ZJFvyVnq8r7heyTF4/F4PB7PCt6Y74+4urp6Mot7w8XFxRcnJyepWd0JawVLksSsNZ/hcKi/z87O" & _
"/j09Pf1Mr+yAT8z3QXB+fi53d3ef3t/f/2dCzjkowYgR7Q1EezAhpxycYMSI1oZo/5iQMw5SMGJE" & _
"+xKi3ZqQEw5WMGJEO/vw4cNbE9qagxaMULTb29tf4bQfTGgrDl4wYpz2M0T7zYRqcxSCESPadw8P" & _
"D1+bUC2ORjBC0W5ubv6E074yIWuOSjBinPYXLgTfmJAVRycYMReCP5Ce35rQxhylYMSk5+9Izx9N" & _
"aCOOVjBi0vMniPbehF7lqAUjRrR3mNO+N6G1HL1gxMxpv0C0dya0Ei+YwYj2Hun5twkt5eBuILrg" & _
"8vJypS4HI5grKPw6wXxKWuIFs8QLZokXzBIvmCVeMEu8YJZ4wSzxglniBbPEC2aJF8wSL5glXjBL" & _
"vGCWeMEs8YJZ4gWzxEowhc9wONa3cfnJxiNECh3PRmO9fOhYOyzCJ0l6MkgSSaUDFeu95T0aQ+Yi" & _
"M2v7Q+2UDPAJw0CKotTrOT4Ugc5TxnlknBWIjXS8yBjHdojlCk69Tp9jy7ZrIrUFoxx5XkgQtKoA" & _
"FOvHgXZeVsKHhdKpKmkqyaAjPToy5bZK+p1AwqiHeCxBp79yuyZiLRh/BuexazghFqRUFOt4GOJP" & _
"QN+9UEDVMIQDEWcql1G7Ci6w6XZNoPYcxmeWnV4fa/MiHTq1U3ITaLg8R3rBLXRmSz1+5EKy6XZN" & _
"YKeC0Y0Sx5jcMxkzhWNeIHQUORg8T/prt2sY/lWBBXiV9q8KOMQLZkktwfa1SneBtWD7XKW7wFqw" & _
"fa7SXbD1HLZPVboL/KRvydaC7VOV7oJ6gu1ple4CX+kv4Ct9x3jBLPGCWVJLMHZGI+T6LtojXmmb" & _
"/ATKWjD+jDLjrelICjVf0S/2mE3uOesem/VVEm2jyAT9YreL74l0+viWoOox02u9zSAOZSLduXUV" & _
"9SW9Zp+ZC1ax3wDLge5DVTrRcW5XoN16hMPKVoieNZVeFErU68LVqO0eR8JzhH+RFkoZlSq93Eeb" & _
"VgQdmUAE9rnT8RXG51j6tObqeawRdJoe2+JvdH6VzCEYzIXaNKgKVpM6iz3m4jpWcXB9fYBpq4fc" & _
"S6sfYvpQxrmdZskTKBKWObbrSquXSJhjPyxLPNBOh3bSkWxufA3GSrrtubFmj80Wa8HUI85b0NKl" & _
"qWLfyMp+A+jMIc42z6DABWS2D51l2RMoUj3Rq+LTv62Z7cYqnxufrBqrLlaC6fMMgYaw/vTApg9y" & _
"X0OpQgZRqR0QwhW7gCnN8flB7pmoW6wEoyNiOCJJBvqgIqRGkfOZ9+YwgfkAmPDET/tQFyg4rPof" & _
"doeVYPydQYsHVVkcLaUUJT1vDnKmx1xcj6JAsCgTODMsqzTWHafpQ+nYbW4+xhhMtTDW8Hqzkscc" & _
"my2+l1zA+VXy2PGCWeIFs8SJYKzy1RgT7RpYksy+vTgevUzM3H864fPyMWQpjpKF+zStr3QiGCtn" & _
"lhivwavi9M0f6Qwkm/AqVUgH+6eqetrEij0WxM1rVE3DSjD2q1Mn8ZyP6AS4pOpjR1U1b55PZnTQ" & _
"GmfEKDMUpGGrQiFLCJShqVfjMQRkxF117hIrwWbrLhTu+KFQKtDVlGZZv7gpXe2yCIUxxmyou4iV" & _
"YM+VOQRbLGLJsn5xU3gCeEeh6VgJRi9NG+4S7UzUfnEX2aZfTDF59aJcO7PIeLunmVhP+hQpe1TS" & _
"4o0pircEbRbTL64ihbgRJ3ekNJ0ZqQwXjh46JUR1JjfTbdaCsWdLy1jaLf6qeYct6xdnoQTT0kKy" & _
"a+l0OVdh8od4bbiL43EeVBHf/6/2TxFmf8h9tuk1XeF7yQV4Ynwv6RAvmCVrU9IsHh3rUnIlT09P" & _
"n5tFj8fj8XiOEZH/AW6rKKt4M8mjAAAAAElFTkSuQmCC"


次回の予告

ここまで対応するとスクリプトライブラリのエラーは次の 1 ヶ所となっているはずです。

今回の最初に記載した通り、作成済みの関数 xGetDXL_FirstInlineImage64 の引数 sTag が増えているからです。次回はこの関数の修正から作業を開始します。

Private Function xConvPhoto2Attach(rndNameCard As NotesDocument, ByVal vsFld As String) As Boolean
   Dim sBase64 As String
   Dim sID As String
   Dim sTag As String
   Dim sName As String

   '名刺情報が保存された文書を取得(再取得)
   sID = rndNameCard.Noteid
   Set rndNameCard = Nothing '一旦文書開放
   Set rndNameCard = xndb.GetDocumentByID(sID)

   'Base64 イメージデータ取得
   sBase64 = xGetDXL_FirstInlineImage64(rndNameCard, vsFld, sTag)
   sName = "NameCard." & sTag 'ファイル名

   'DXL の準備


前回 作ってみよう 次回


0 件のコメント:

コメントを投稿