fc2ブログ

申請書と基幹システムの連携

基幹システムは RedHat4.5 に WebSphere V6.1 + Oracle10g、クライアントは Windows2000 に IE6。Dominoは8.5 x64、クライアントは 6.56。
基幹システムはベンダーが開発、Notesは自社開発。これが当社の環境です。

ベンダーはNotes開発未経験、基幹システムの自社開発は保守の絡みでダメ。そんなで承認済みのNotes申請書の内容を基幹システムへ連携できていません。連携する方法は CSV吸い上げやバッチプログラム・・・1文書に対して1レコードを追加なら他愛もないのですが、1トランザクションのテーブル数が多いのも手付かずの理由にあります。まぁ開発予算が全くないのが一番の理由で、ベンダーも相手してくれないのは当然です。

とうに諦めていた折、今年始めにコメントスパムの被害を受けたときに自社開発でできる連携方法を思い付きました。それは基幹システムの入力画面の項目にNotes文書をセットする方法で、サンプルとしてNotesフォームの項目内容をGoogle の検索キー項目にセットしてみます。

(1) フォームを用意して項目とボタンを追加。
転送

(2) ボタンのClickイベントに下記のLotusScriptを記述。
Declare Function SetForegroundWindow Lib "user32" (Byval hWnd As Long) As Long
Declare Function IsIconic Lib "user32" (Byval hWnd As Long) As Long
Declare Function ShowWindowAsync Lib "user32" (Byval hWnd As Long, Byval nCmdShow As Long) As Long
Const SW_RESTORE& = 9

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim ShellApp As Variant
  Dim Windows As Variant
  Dim IExplore As Variant
  Dim IExplores() As Variant
  Dim TITLES() As String
  Dim TITLE As Variant
  Dim t As Integer
  Dim e As Integer
  Dim i As Integer
  Dim hWnd As Long
  
  Set UIDocument = UIWorkspace.CurrentDocument
  Set ShellApp = CreateObject("Shell.Application")
  Set Windows = ShellApp.Windows()
  For i = Windows.Count To 1 Step -1
    Set IExplore = Windows.Item(Windows.Count - i)
    If Instr(Strconv(IExplore.FullName, 2), "iexplore.exe") > 0 Then
      If Left(IExplore.Document.URL, 23) = "http://www.google.co.jp" Then
        Redim Preserve IExplores(e)
        Set IExplores(e) = IExplore
        e = e + 1
      End If
    End If
  Next
  If e = 1 Then
    t = 0
  Elseif e > 1 Then
    Redim TITLES(e - 1)
    For i = 0 To e - 1
      TITLES(i) = i + 1 & "番目"
    Next
    TITLE = UIWorkspace.Prompt(4, "転送", "Googleが複数開かれています。転送する画面を選択してください。", , TITLES)
    If Isempty(TITLE) Then
      Exit Sub
    End If
    t = Arraygetindex(TITLES, TITLE)
  Else
    Msgbox "Googleを開いてください。", 0 + 48, "転送"
    Exit Sub
  End If
  IExplores(t).Document.GetElementsByName("q")(0).Value  = UIDocument.FieldGetText("KEY")
  Msgbox "Googleへ転送しました。", 0 + 64, "転送"
  hWnd = IExplores(t).hWnd
  If IsIconic(hWnd) Then
    Call ShowWindowAsync(hWnd, SW_RESTORE)
  End If
  SetForegroundWindow hWnd
End Sub

IEでGoogleを開き、作ったフォームを実行すると
転送

機械を修理するために部品購入の申請書があります。承認になった後で機械の廃棄が決まり結局購入しない場合もあり、基幹システムに取り込む前にワンクッション意思入れが必要になります。そのような場合、いわゆるコピペ連携も悪くはないのではと思っています。

森と水のエコクイズ2010
森と水のエコクイズ2010
スポンサーサイト



テーマ : プログラミング
ジャンル : コンピュータ

ブラウザからNotesクライアントへ

会社の基幹システムはWebでクライアントはIE。DominoはNotesクライアントを使用しています。基幹システム画面の商品名をクリックすると、該当するDominoDBの文書を開くようにという要望あり、以前に書いた 「ブラウザからNotesクライアントへ」 のようにしましたが、もっと簡単な方法がありました。

(1) Dominoサーバー名は "srv"。

(2) DB名は "sample.nsf"。

このデータベースを開くリンクは下記の通り。
<a href="#" onclick="(new ActiveXObject('WScript.Shell')).run('notes://srv/sample.nsf')">商品情報はこちら</a>

以前はブラウザが残ってしまう問題がありましたが、Shell からキックすれば問題なし。

森と水のエコクイズ2010
森と水のエコクイズ2010

テーマ : プログラミング
ジャンル : コンピュータ

正規表現でスパムコメント撃退

ここ最近、ホームページのお問い合わせにコメントスパムが入り込み、あらよという間に世界各地から1日何百件となってしまいました。入ってくる内容はこんなのです。
comment2, <a href="http://atyrausuarnasy.cn/2008-06/2007-dodge-truck-review">2007 dodge truck review</a>, [url="http://atyrausuarnasy.cn/2008-06/2007-dodge-truck-review"]2007 dodge truck review[/url], http://atyrausuarnasy.cn/2008-06/2007-dodge-truck-review 2007 dodge truck review, 37878,

入力チェックで引っ掛けるしかないのですが、入力内容の全角(日本語)有無は海外にも拠点があるため不可。そこで QuerySaveエージェントでお問い合わせ内容欄にURL(http://またはhttps://)が2個以上あれば入力エラーページに飛ばすことにしました。

お問い合わせ用DB名は"contact.nsf"。このDB内に下記を実施しました。

(1) ホームページお問い合わせ用の"contact"フォームのWebQuerySaveイベントに下記を記述する。
@Command([ToolsRunMacro]; "contact")

(2) http://またはhttps://が2個以上あったときに表示する"err"ページを用意する。このページにどのようなメッセージにすればよいのか悩んだ挙句、書いた内容はこんなのにしました。
スパム対策のため、URL(http://~)の複数書き込みはできません。
お手数ですが、戻るボタンより入力フォームにお戻りください。
You cannot input plural URL.
Please go back to the previous page by pressing the back button.

(3) "contact"エージェントに下記のスクリプトを記述。
Sub Initialize
  Dim Session As New NotesSession
  Dim Document As NotesDocument
  Dim EMail As NotesDocument
  Dim Body As NotesRichTextItem
  Dim Regex As Variant
  Dim Matches As Variant
  
  Set Document = Session.DocumentContext
  Set Regex = CreateObject("VBScript.RegExp")
  Regex.Pattern = "http://|https://"
  Regex.Ignorecase = False
  Regex.Global = True
  Set Matches = Regex.Execute(Document.GetFirstItem("MEMO").Text)
  if Matches.Count > 1 Then
    Document.SaveOptions = 0
    Print "[/domino/contact.nsf/err?OpenPage]"
  Else
    Document.SaveOptions = 1
    Print "[/contact.nsf/contact?OpenPage]"
    Set EMail = New NotesDocument(Session.CurrentDatabase)
    Set Body = New NotesRichTextItem(EMail, "Body")
    EMail.Form = "Memo"
    EMail.SendTo = Document.EMAIL(0)
    EMail.Subject = "「お問い合わせ」受付完了のお知らせ"
    Call Body.AppendText("このたびはホームページをご利用いただきありがとうございました。")
    Call Body.AddNewLine(1)
    Call Body.AppendText("おって担当者よりご連絡させていただきます。")
    Call EMail.Send(False)
  End If
End Sub

これで大半は撃退できましたが、それでもURLを一つだけにして入り込んでくるものが発生。数少ないので Document.REMOTE_ADDR(0) = "xxx.xxx.xxx.xxx" ならば入力エラーページと直指定で死滅しました。

正規表現のプログラムですが、LotusScriptのみで行う場合は "http://"の出現数をInstrでループさせてカウントするしかありません。"http://"を探すだけなので正規表現でなくても・・・ですが、プロパティで出現数を取得できて簡単なので今回もVBScript RegExpを使ってみました。LotusScriptから他言語ですがVBScriptでは
Dim Regex As Variant
Dim Matches As Variant

Set Regex = CreateObject("VBScript.RegExp")
Regex.Pattern = "http://|https://"
Regex.Ignorecase = False
Regex.Global = True
Set Matches = Regex.Execute("スパムコメント https://xxxx http://xxx http://xxx")
Msgbox Matches.Count

JavaScriptでは
Dim ScriptControl As Variant

Set ScriptControl = CreateObject("ScriptControl")
ScriptControl.Language = "JScript"
ScriptControl.ExecuteStatement "s = 'スパムコメント https://xxxx http://xxx http://xxx'.match(/http:\/\/|https:\/\//ig); i = s == null ? 0 : s.length;"
Msgbox ScriptControl.Eval("i")

LS2J(Java)では
Dim JSession As New JAVASESSION
Dim JClass As JavaClass
Dim JPattern As JavaObject
Dim JMatcher As JavaObject
Dim i As Long

Set JClass = JSession.GetClass("java/util/regex/Pattern")
Set JPattern = JClass.compile("http:\/\/|https:\/\/")
Set JMatcher = JPattern.matcher("スパムコメント https://xxxx http://xxx http://xxx")
While JMatcher.find()
  i = i + 1
Wend
Msgbox i

LS2Jですが、私のPC Windows2000 + Notes6.5では "LS2J Error: Threw java.lang.ClassNotFoundException: java.util.regex.Pattern"とエラーになり駄目。別のPC WindowsXP + Notes8.5 では動きました。java/lang/Integer など問題なく原因わかりませんでした。

個人的にはWindows環境下もあり、正規表現ではVBScriptを採用しています。ところでDomino8.5になるとLotusScriptに正規表現は用意されている?更にはコメントスパムよりもスパムメールが頭痛の種、Domino8.5に新たな対策方法ある?

テーマ : プログラミング
ジャンル : コンピュータ

ビュー列の色

下記の画面は、基幹システムよりLEIで集計転送している部門毎の月別修理状況の照会画面(フォーム)です。部門+年月をキーにして、埋め込みビューで単一カテゴリの表示しています。
ビュー列のバックグランドカラーに当初色が付いてなく、点検実施済みを青、その月に点検できなかったものを黄色、今現在も点検していないものを赤色に変えたくいろいろ試してみました。

照会画面


まず色値を空にしてみると前の列の色が生きてしまいダメ。
ビュー


次に白にしてみると当然1行置きの色が白になってしまいダメ。
ビュー


最後に上手くいったのが、-1:-1:-1。
ビュー


話し変わって、ビューの使い勝手が良くならないものかなぁ。理想は(下記の画像は作り物)
 ・ 以前にも書いた列の合計で%対応(進捗率や前年比など)
 ・ 列ヘッダにhtmlで言うcolspan(Excelのセル結合)対応
理想のビュー
 ・ 列固定(Excelのウィンドウ枠固定)
理想のビュー
などささやかなものです。そうすれば何でもかんでも書き出してExcelにならないと思うのですが。

テーマ : プログラミング
ジャンル : コンピュータ

Notesクライアントで郵便番号検索(続き)

前回のNotesクライアントで郵便番号検索 にハンドリングを入れたソースです。

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim XMLHttp As Variant
  Dim ScriptControl As Variant
  Dim Regex As Variant
  
  Set UIDocument = UIWorkspace.CurrentDocument
  Set Regex = CreateObject("VBScript.RegExp")
  Regex.Ignorecase = False
  Regex.Global = True
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{4}$"
  Call UIDocument.FieldSetText("YUBIN_NO", Strconv(Trim(UIDocument.FieldGetText("YUBIN_NO")), 8))
  If Regex.Test(UIDocument.FieldGetText("YUBIN_NO")) Then
    Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
    Call XMLHttp.Open("GET", "http://zip.ricollab.jp/" & UIDocument.FieldGetText("YUBIN_NO") & ".json", False)
    Call XMLHttp.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
    Call XMLHttp.Send(Null)
    If XMLHttp.ReadyState = 4 And XMLHttp.Status = 200 Then
      Set ScriptControl = CreateObject("ScriptControl")
      ScriptControl.Language = "JScript"
      Call UIDocument.FieldSetText("ZYUSYO", ScriptControl.Eval("(" + _
      XMLHttp.ResponseText + "['address']['prefecture']" + ") + (" + _
      XMLHttp.ResponseText + "['address']['city']" + ") + (" + _
      XMLHttp.ResponseText + "['address']['town']" + ")"))
      Call UIDocument.GotoField("ZYUSYO")
    Else
      Call UIDocument.GotoField("YUBIN_NO")
      Msgbox "住所を取得できませんでした。", 48, UIDocument.WindowTitle
    End If
  Else
    Call UIDocument.GotoField("YUBIN_NO")
    Msgbox "郵便番号は9999999または999-9999の形式で入力して下さい。", 48, UIDocument.WindowTitle
  End If
End Sub

郵便番号のチェックはLikeではなく、VBScript.RegExpで正規表現を使っています。ちなみに当社クライアント環境は6.5(Windows2000)。必ず7桁必須でなく、例えば3桁入れて実行して複数の住所をNotesUIWorkspace.PromptのOKCANCELLISTで選択できればいいなぁと思いましたが、ここでタイムアップ。どなたか是非お願いします。

こちらのチャレンジも是非!

クイズ よりぬき!サントリー2009
クイズ よりぬき!サントリー2009


更に追記ですが、このブログを社内のおっくんが見て、隣の席からメールをくれました。
実行した画面とソースは下記の通り、素晴らしい!

郵便番号検索

Sub Click(Source As Button)
  Dim UIWorkspace As New NotesUIWorkspace
  Dim UIDocument As NotesUIDocument
  Dim XMLHttp As Variant
  Dim ScriptControl As Variant
  Dim Regex As Variant
  Dim i As Long
  Dim x As Long
  Dim r As Long
  Dim Results() As String
  Dim Selected As String
  Dim IsFull   As Boolean

  Set UIDocument = UIWorkspace.CurrentDocument
  Set Regex = CreateObject("VBScript.RegExp")
  Regex.Ignorecase = False
  Regex.Global = True
  Call UIDocument.FieldSetText("YUBIN_NO", Strconv(Trim(UIDocument.FieldGetText("YUBIN_NO")), 8))
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{4}$"
  IsFull = Regex.Test(UIDocument.FieldGetText("YUBIN_NO"))
  Regex.Pattern = "^[0-9]{3}[\-]?[0-9]{0,4}$"
  If Regex.Test(UIDocument.FieldGetText("YUBIN_NO")) Then
    Call UIDocument.FieldClear("ZYUSYO")
    Set XMLHttp = CreateObject("MSXML2.XMLHTTP")
    Call XMLHttp.Open("GET", "http://zip.ricollab.jp/" & UIDocument.FieldGetText("YUBIN_NO") & ".json?count=100", False)
    Call XMLHttp.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded; charset=UTF-8")
    Call XMLHttp.Send(Null)
    If XMLHttp.ReadyState = 4 And XMLHttp.Status = 200 Then
      Set ScriptControl = CreateObject("ScriptControl")
      ScriptControl.Language = "JScript"
      If IsFull Then
        Call UIDocument.FieldSetText("ZYUSYO", ScriptControl.Eval("(" + _
        XMLHttp.ResponseText + "['address']['prefecture']" + ") + (" + _
        XMLHttp.ResponseText + "['address']['city']" + ") + (" + _
        XMLHttp.ResponseText + "['address']['town']" + ")"))
      Else
        x = ScriptControl.Eval("(" & XMLHttp.ResponseText & "['result']).length")
        For i = 0 To x - 1
          Redim Preserve Results(r)
          Results(r) = ScriptControl.Eval("(" & XMLHttp.ResponseText & "['result'][" & i & "].zipcode) + ' ' + " & _
          "(" & XMLHttp.ResponseText & "['result'][" & i & "].address)")
          r = r + 1
        Next
        If r > 0 Then
          Selected = UIWorkspace.Prompt(4, UIDocument.FieldGetText("YUBIN_NO") & " の検索結果: " & x & " 件(最大 100件まで)", "住所を選択してください。", , Results)
          If Len(Selected) > 0 Then
            Call UIDocument.FieldSetText("ZYUSYO", Mid(Selected, 9))
          End If
        Else
          Msgbox "該当する住所が見つかりませんでした。", 48, UIDocument.WindowTitle
        End If
      End If
    Else
      Call UIDocument.GotoField("YUBIN_NO")
      Msgbox "住所を取得できませんでした。", 48, UIDocument.WindowTitle
    End If
  Else
    Call UIDocument.GotoField("YUBIN_NO")
    Msgbox "郵便番号は 3桁以上入力してください。", 48, UIDocument.WindowTitle
  End If
End Sub

彼曰く、「ソース長くて汚いので、ブログへのコメントは勘弁してください。関数を追加して連想配列等で取れるかなと思ったのですがうまくいきませんでした。VBA では普通に取得できたので、方法はあると思うのですが・・・。」とのこと。
何故、ここでVBAとLotusScriptで違いがでるのか私もわかりません。

Set ScriptControl = CreateObject("ScriptControl")
ScriptControl.Language = "JScript"
FuncExp = "function jsonParse(s) { return eval('(' + s + ')'); }"
ScriptControl.AddCode("function jsonParse(s) { return eval('(' + s + ')'); }")
Set JSON = ScriptControl.Run("jsonParse", XMLHttp.ResponseText)
Msgbox JSON.address.town

テーマ : プログラミング
ジャンル : コンピュータ

プロフィール

ピヨパパ

Author:ピヨパパ
静岡市のエンドユーザーSE。
最近はDominoの開発ばかりでうんざり。
是非気軽にコメントして下さい。

FC2カウンター
最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる