2025/02/03

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

前回作業を開始した『インラインイメージを添付ファイルに変換』する作業の続きです。当たり前ですが、この作業はもとから添付ファイルとして貼り付けてある場合は不要となります。

当初作成したメイン関数 ReadNameCard において、リッチテキスト内の画像データを取得しているのは、以下の JSON を作成している部分でした。

Public Function ReadNameCard(vnd As NotesDocument) As Boolean
         ・・・
   '1. API リクエスト時に送信する JSON を作成
   Set jnavRequest = xMakeRequest(vnd)

   '2. API をコールし、結果の JSON を取得
   Set jnavResponce = xCallWebAPI(jnavRequest)

   '3. 結果の JSON 内から名刺情報部分だけの JSON を取得
   Set jnavNameCard = xGetNameCard(jnavResponce)

   '4. 名刺情報を文書に保存
   Call xSaveNameCard(jnavNameCard, vnd)
         ・・・
End Function

今回は、この関数から画像がインラインイメージだったのかを返すように修正し、その結果に応じて前回作成の関数をコールするか決定する仕様とします。


xMakeRequest 関数の修正

画像がインラインイメージの場合 True を返す引数 rbPhoto を追加します。実際の判定はサブ関数で行っていますので、その関数に引数をそのまま渡します。

Private Function xMakeRequest(vnd As NotesDocument, rbPhoto As Boolean) As NotesJSONNavigator
   Dim jnav As NotesJSONNavigator

   '送信する JSON(RequestBody)の準備
   Set jnav = xns.CreateJSONNavigator("")

   '1) model
   Call xMakeRequest_Model(jnav)

   '1) messages
   Call xMakeRequest_Message(jnav, vnd, rbPhoto)

   '1) response_format
   Call xMakeRequest_ResponseFormat(jnav)

   Set xMakeRequest = jnav
End Function


xMakeRequest_Message 関数の修正

この関数でも画像貼り付け形式の判定は行っていませんので、先の関数と同様の対応を行います。

Private Function xMakeRequest_Message(vjnav As NotesJSONNavigator, vnd As NotesDocument, rbPhoto As Boolean) As Boolean
         ・・・
   '3) image_url 名刺画像
   Set joCnt = jaCnt.AppendObject()
   Call joCnt.AppendElement("image_url", "type")

   Set jo = joCnt.Appendobject("image_url")
   s = "data:image/jpeg;base64,{" & xGetImage_Base64(vnd, "Body", rbPhoto) & "}"
   Call jo.AppendElement(s, "url")
End Function


xGetImage_Base64 関数の修正

この関数で添付ファイルかインラインイメージの判定を行っています。その結果に応じて戻り値、rbPhoto をセットするように調整します。

Private Function xGetImage_Base64(vnd As NotesDocument, ByVal vsFldName As String, rbPhoto As Boolean) As String
   Dim sTag As String
   rbPhoto = False


   '最初の添付ファイルを Base64 文字列で取得
   xGetImage_Base64 = xGetDXL_FirstAttachment64(vnd, "Body")

   If xGetImage_Base64 = "" Then
      '添付はない(= 最初のインラインイメージを取得)
      xGetImage_Base64 = xGetDXL_FirstInlineImage64(vnd, "Body", sTag)
      rbPhoto = True
   End If
End Function

また、インラインイメージの場合 xGetDXL_FirstInlineImage64 をコールしています。前回の記事で、この関数は画像形式を返す機能が必要となっていました。xGetImage_Base64 関数も、この新要件に合わせて、引数 sTag を追加します。


xGetDXL_FirstInlineImage64 関数の修正

やっと、前回から発生した新要件の回収です。関数の引数に画像形式を返す rsTag を追加します。

この関数は、リッチテキスト内のインラインイメージの画像データを Base64 の文字列を返す仕様でした。画像データの上位ノード名は、png、jpeg、gif となっており、この値はそのまま画像ファイルの拡張子として使用できます。以下のコードでは、sTag 変数にセットされているので、それを戻り値として返すように修正します。

Private Function xGetDXL_FirstInlineImage64(vnd As NotesDocument, ByVal vsFld As String, rsTag As String) As String
         ・・・
   '画像データの捜索
   If Not(denPct Is Nothing) Then
      ForAll sTag In asTag
         Set denImg = xGetDXL_FirstNodeByName(denPct, sTag)
         If Not(denImg Is Nothing) Then
            'エンコードされた画像データ取得
            Set dtn = denImg.FirstChild
            sB64 = dtn.NodeValue

            '戻り値セット
            xGetDXL_FirstInlineImage64 = sB64
            rsTag = sTag
            Exit ForAll
         End If
      End ForAll
   End If
End Function


ReadNameCard 関数の修正

いよいよメイン関数の修正です。

リクエストする JSON 作成時に名刺画像の貼り付け状態を取得する変数 bPhoto を新たに定義し、引数に追加します。この変数が True の場合、インラインイメージを添付ファイルに変換が必要となります。ReadNameCard 関数の最後で、前回作成の関数 xConvPhoto2Attach をコールさせています。

Public Function ReadNameCard(vnd As NotesDocument) As Boolean
   Dim jnavRequest As NotesJSONNavigator
   Dim jnavResponce As NotesJSONNavigator
   Dim jnavNameCard As NotesJSONNavigator
   Dim bPhoto As Boolean

   '1. API リクエスト時に送信する JSON を作成
   Set jnavRequest = xMakeRequest(vnd, bPhoto)
   'Call xSetRT(vnd, "JSON_Request", jnavRequest.Stringify)

   '2. API をコールし、結果の JSON を取得
   Set jnavResponce = xCallWebAPI(jnavRequest)
   Call xSetRT(vnd, "JSON_Responce", jnavResponce.Stringify)

   '3. 結果の JSON 内から名刺情報部分だけの JSON を取得
   Set jnavNameCard = xGetNameCard(jnavResponce)
   Call xSetRT(vnd, "JSON_NameCard", jnavNameCard.Stringify)

   '4. 名刺情報を文書に保存
   Call xSaveNameCard(jnavNameCard, vnd)

   '名刺管理フィールドセット
   vnd.ExchangeDate = Today
   vnd.Status = "3"
'3 = AI 問い合わせ完了

   '文書の保存
   Call vnd.Save(True, False)

   '5. 写真の場合、添付ファイルに変換
   If bPhoto Then
      'DXL でインラインイメージを添付ファイルに変換
      'DXL での文書保存、バックエンド文書再取得を含む

      Call xConvPhoto2Attach(vnd, "Body")
   End If
End Function

また、ノーツクライアント用と Nomad 用のエージェントで行っていた名刺管理フィールドのセットと文書の保存を ReadNameCard 関数移設します。

一連の処理で保存が複数回発生するのは構造上よくないと考えています。今回は、NotesDocument クラスの保存と DXL の保存を併用することから、複数回の保存が発生します。その状況をできる限りわかりやすくなるよう、保存処理を近くに配置してみました。


ReadNameCard エージェントの修正

最後に名刺読込処理エージェントの調整を行います。まずはノーツクライアント用である ReadNameCard エージェントです。

ReadNameCard 関数内に移設した処理をコメントアウト、もしくは、削除します(以下の赤字部分)。

Sub Initialize
         ・・・
   'AI で名刺を読み込み
   Call ReadNameCard(nd)

   '名刺管理フィールドセット
   'nd.ExchangeDate = Today
   'nd.Status = "3" '3 = AI 問い合わせ完了

   '文書の保存と画面の表示
   'Call nd.Save(True, False)

   Set nuid = nuiw.Editdocument(True, nd)
End Sub


ReadNameCard_OnServer エージェントの修正

続いて、Nomad 用のエージェントについても、同様の対応を行います。以下の赤字部分をコメントアウト、あるいは、削除します。

Sub Initialize
   Dim na As NotesAgent
   Dim nd As NotesDocument

   Set xns = New NotesSession
   Set xndb = xns.Currentdatabase
   Set na = xns.CurrentAgent

   '呼び出し元の文書を取得
   Set nd = xGetPramDoc(na)

   'AI で名刺を読み込み
   Call ReadNameCard(nd)

   '名刺管理管理フィールドセット
   'nd.ExchangeDate = Today
   'nd.Status = "3"

   '文書の保存(画面の表示は呼び出し元が担当)
   'Call nd.Save(True, False)

End Sub


動作検証

これで改造は完了です。

成功すると、カメラから貼り付けたインラインイメージの名刺画像は、[名刺読込]が完了すると添付ファイルに変換されます。

そして、この変換効果で[登録情報]タブの参照で、横スクロールは発生しなくなります。


前回 作ってみよう 次回


0 件のコメント:

コメントを投稿