Sendkeys

　まだ開設一週間くらいなのに、こんなサンプルばかり載せていると訪問者がいなくなってしまうのではないかと心配してしまうのですが、このエントリは息抜き程度に読んでもらえるとうれしいです。


　追加のサーバーは起動時にパスワードを聞かれるのでどうにかしたいと考えた事がありました。
IDファイルが作られたあとにサーバーIDのパスワードを解除すればいいだけの話なのですが、こんなWSHスクリプトを書いてみた事があります。

以下のようなVBSファイルをドミノのプログラムディレクトリに入れておくと、起動したら何も考えずに「password」と言うパスワードを送り込んでくれます。

StartServer.vbs
Dim WshShell
set WshShell = CreateObject("WScript.Shell")
WshShell.Run("nserver.exe")
WScript.Sleep(100)
WshShell.AppActivate("Lotus Domino Server")
WshShell.SendKeys("password")
WshShell.SendKeys("{Enter}")

　パスワードがテキストファイルに保存されることになるので、セキュリティ上は重大な問題があるので、実環境で使う人はいないと思うのですが何となくこの人間の操作まで代理してくれるような感じがするSendkeys メソッドと言うのはとても魅力的に映って色々遊んでいました。

こんな感じでノーツを起動して、データベースを一個開いてから閉じる、と言う簡易なテストツールに使うことも出来る！とか思ったりしました。

StartNotes.vbs
※　斜体にしたところは環境に応じて適切な値を入れて下さい。
Dim WshShell
set WshShell = CreateObject("WScript.Shell")
WshShell.Run("notes.exe")
WScript.Sleep(8000)
WshShell.AppActivate("Lotus Notes")
WshShell.SendKeys("password")
WshShell.SendKeys("{Enter}")
WScript.Sleep(4000)
WshShell.SendKeys("^o")
WshShell.SendKeys("%i")
WshShell.SendKeys("mailserver")
WshShell.SendKeys("{Enter}")
WshShell.SendKeys("%f")
WshShell.SendKeys("mail/xxxx.nsf")
WshShell.SendKeys("%o")
WScript.Sleep(10000)
WshShell.SendKeys("%(fx)")

Windowの文字とかオブジェクトを取ったりエラーハンドリングをして精度を高められる有償のテストツールみたいにはいかないのですが、ちょっとプログラムっぽくないノリでソフトウェアを動かしている感じが楽しくて色々触ってみたりしました。

とりあえず書いてみたけど、やっぱりNotes技術者の役には立たないですね。。。

NSDをVBSで実行する

NSD を実行するバッチファイルを作った事がある方は多いと思うのですが、どうしてもプログラムディレクトリやデータディレクトリの値を環境毎に書き換えないといけないのがあまり好きでなかったので、VBSで作ってみました。　データディレクトリとプログラムディレクトリの値をレジストリから取って実行します。これだと設定無しで動くので使いやすいかな、と思います。
　これだけでVBSを使うのは面白くないので、OSの判別コードも入れて、Windows XP/Vista でサポートされている、「nsd -detach」　に出来るようにしました。8.x 以降はデフォルトで入っているので入れても入れなくてもいいのですが、何かのバッチ処理でプログラムディレクトリやデータディレクトリの値を取ったり、OSの判別をするようなことはあるのではないかと思うので、他の目的でも使える部分は多いのではないかと思います。

注：
・　Lotus Notes 6.5.x 以降のクライアントで実行する事を想定しています。
　　それ以前のクライアントでは -detach がサポートされていません。
・　マルチユーザーでは実行できません。
　　（ただし、どっちもレジストリキーの問題なので、書き換えれば動くと思います）
・　実行後クライアントをクリーンアップしたい場合は、strOption = " -DumpAndKill" に書き換えてください。この場合はOS判別コードは要りません。

RunNSD.vbs
Function GetProgramDir()
  GetProgramDir = ""
  Dim objWshShell
  Set objWshShell = WScript.CreateObject("WScript.Shell")
  strValue = objWshShell.RegRead("HKLM\SOFTWARE\Lotus\Notes\Path")
  if Right(strValue,1) <> "\" Then
    strValue = strValue & "\"
  End if
  GetProgramDir = strValue 
End Function

Function GetDataDir()
  GetDataDir = ""
  Dim objWshShell
  Set objWshShell = WScript.CreateObject("WScript.Shell")
  strValue = objWshShell.RegRead("HKLM\SOFTWARE\Lotus\Notes\DataPath")
  if Right(strValue,1) <> "\" Then
    strValue = strValue & "\"
  End if
  GetDataDir = strValue 
End Function

Function IsWin2k()
 IsWin2k = False
 strComputer = "." 
 Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
 Set colOperatingSystems = objWMIService.ExecQuery _ 
     ("Select * from Win32_OperatingSystem") 
 For Each objOperatingSystem in colOperatingSystems 
     If Instr (objOperatingSystem.Caption, "Windows 2000") > 0 Then
 	IsWin2k = True
     End If
 Next 
End Function

Dim objWshShell
Dim strCmdLine
Set objWshShell = WScript.CreateObject("WScript.Shell")
NSDPath = GetProgramDir() & "nsd.exe"
objWshShell.CurrentDirectory = GetDataDir()

If Not isWin2k() Then
   strOption = " -detach"
End If

strCmdLine = NSDPath & strOption
objWshShell.Exec(strCmdLine)

If Err.Number <> 0 Then
  WScript.Echo "NSD 実行エラー: " & Err.Description
End If

個人アドレス帳のソート（続き）

前回のエントリでは個人アドレス帳のグループ文書を使ったソートを紹介させて頂きましたが、アプリケーション開発者の中では汎用的なものかどうかが気になった方もいるのではないかと思うので・・・

こんなことをしています、と言う意味で重要な処理だけ抜き出しておきます。
QuickSort() にリストを渡せばソートした結果をSortedArray と言うグローバル変数に返してくれるみたいですね。

Dim SortedArray As Variant
Public Function QuickSort(sArray As Variant)
	Dim sA() As String    
	Dim j As Long
	Dim bottom As Long
	Dim top As Long
	bottom = Lbound ( sArray )
	top = Ubound ( sArray )
	Redim sA( bottom To top ) As String     
	For j = bottom To top
		sA ( j ) = sArray ( j )
	Next
     ' DoQS does a QuickSort if the Sublist is longer than 10 elements
     ' Thus, when DoQS finishes, all elements are within 10 spots of their correct location.
     ' For lists that are close to being in order, an Insertion Sort is much faster than a QuickSort, so we
     ' run through the whole thing once doing an Insertion Sort to finish tidying up the order.
	Call DoQS( sA, bottom, top )
	Call DoInsertSort ( sA, bottom, top )
	SortedArray = sA
End Function
Sub DoQS( sA() As String, bottom As Long, top As Long )
     ' Called by QuickSort
     ' Uses Public variable sA  (array of string)
	Dim length As Long
	Dim i As Long
	Dim j As Long
	Dim Pivot As Long
	Dim PivotValue As String
	Dim t As String
	Dim LastSmall As Long
	length = top - bottom + 1
	
     ' Only do the QuickSort if the sublist is at least 10 items long
	If length > 10 Then
          ' Pivot is chosen approx. halfway through sublist.
          ' This gives us best speed if list is almost sorted already, and is no worse than any
          ' other choice if the list is in random order.
		Pivot = bottom + (length  2)   
		
          ' Move PivotValue out of the way
		PivotValue = sA( Pivot )
		sA ( Pivot ) = sA ( bottom )
		sA ( bottom ) = PivotValue
		
          ' LastSmall is the location of the last value smaller than PivotValue
		LastSmall = bottom
		For i = bottom + 1 To top 
			If sA ( i ) < PivotValue Then 
				LastSmall = LastSmall + 1
				t = sA ( i )
				sA ( i ) = sA ( LastSmall )
				sA ( LastSmall ) = t
			End If
		Next
		
          ' Move the PivotValue back
		t = sA ( LastSmall )
		sA ( LastSmall ) = sA ( bottom )
		sA ( bottom ) = t
		Pivot = LastSmall
		
          ' Now sort each side
		Call DoQS ( sA, bottom, Pivot - 1 )
		Call DoQS ( sA, Pivot + 1, top )
	End If
	
End Sub
Sub DoInsertSort ( sA() As String, Byval bottom As Long, Byval top As Long )	
	Dim i As Long
	Dim x As Long
	Dim v As String
	Dim Found As Integer
	For i = bottom+1 To top
		x = i
		v = sA (i )
		Do While (sA(x-1) > v)
			sA ( x ) = sA ( x-1 )
			x = x - 1
			If x=0 Then
				Exit Do
			End If
		Loop
		sA (x) = v
	Next
End Sub

Xpage を使ったサンプルアプリケーションを作るデモ

Designer Wiki にこんな記事が出ています。

Demonstration: Creating a simple XPages application

新規にブランクのデータベースを作るところから始めているので、一緒に作ってみるといい勉強になるんじゃないかと思います。
　英語でも重要な操作はポップアップ文字で説明とか出るのでかなり分かりやすいです。

似たような例として大川さんもXpages を利用した Typeaheadのサンプルを動画で紹介しているのでここで載せておきます。

ND Wiki : システム管理用エージェントのサンプル

昨日のDesigner無償化に関しては拍手の数などを見てもやはりよいニュースとして受け止めて頂けたようで何よりです（別に私が決定したわけでも、関係していたわけでも何でもないのですが・・・）

さて、今日はND Wiki で公開されていたこんな記事のお話です。
Useful agents for IBM Lotus Notes and Domino administrators (Lotus Notes And Domino Wiki)

エージェントは細かい動きは自分用にカスタマイズしたいものですのでなかなかしっくりくるものがあるかどうかは難しい部分もあるのですが、この文書では以下のようなエージェントがサンプルとして紹介されています。

もし興味があるものがあったら一度のぞいてみてください。


1. FolderReferencesが有効化されていない環境で選択文書がどのフォルダにいるかを確認する
2. "CommonUI"と言う名前のスクリプトライブラリを削除する
3. ユーザーにどのポリシーが適用されているかを確認する
4. ユーザー文書を選択して、ユーザーを異なる組織単位（OU)へ移動させる
5. ユーザー文書を選択して選択ユーザーのメールDBからカレンダープロフィールを削除する
6. 現在のユーザーの"Offline"と言う名前のロケーションの設定を変える
7. 設計のプロパティで、「データベースについて」文書と、「データベースの使い方」文書と、データベースアイコンの設計のプロパティで「更新時に再設計/設計の置換を禁止する」を外すエージェント

LotusScript: ファイルにある特定の文字列を置換するサンプル

今日は久しぶりにサンプルでも書いてみようかと思います。LotusScriptでファイルの編集をしようと思うと結構大変ですよね。このTechnoteではCSVを扱うサンプルを紹介していますが、テキストファイルを読み込むだけなのであまり複雑な処理はしていません。

LotusScript ではテキストファイルを開いたり書き込んだりすることが出来ますが、「読み込んだファイルの途中にある値を挿入したり、特定の行を削除する」と言う方法がちゃんと用意されていないのでファイルが扱いにくいのです。ヘルプにあるファイルを処理する例もあるファイルを読み込んで別のファイルに書き出す、と言うもので、開いたファイルを編集するようなものではありません。

実際編集が必要な場合はどうしているでしょうか？

とりあえず私はファイルを読み込んで適切な内容の一時ファイルを生成する⇒元のファイルを消して一時ファイルをリネームする　と言う原始的な方法でサンプルを書いてみました。なんか納得がいかないですよね。。

今日のサンプルでは、ここで紹介したスタンダード版の設定で<プログラムディレクトリ>\framework\rcp\plugin_customization.ini を書き換えると言うのがどうも煩雑なので設定ボタンを作ろうと思って作ったものです。
プログラムディレクトリの取得はここで使ったやつを流用しました。

実はVBSで似たような処理を書いたこともあるのですが、その時もいい方法が分からなくて、結局同じような方法で対応していたのでこうするしかないのかもしれません。。。

まとまりのない記事になってしまいましたが、是非優秀な開発者の方がもっと教育的なコードをどこかで紹介してもらうためのたたき台にでもなればなあ・・・・と思います。

注：　ファイル処理の関係上、元のファイル名 + .tmpと言う一時ファイルを生成しています。同名のファイルがあった場合はちゃんとハンドルしていません。。

Sub Click(Source As Button)
	Dim ses As New NotesSession	
	Dim datadir, configfile As String
	ProgDir = GetProgramDir()
	configfile = ProgDir & "framework\rcp\plugin_customization.ini "
	
	' com.ibm.notes.branding/enable.update.ui が見つかったらcom.ibm.notes.branding/enable.update.ui=true にする
	' 見つからなかったらcom.ibm.notes.branding/enable.update.ui=true をそのまま追加
	Call ReplaceEntryInTXT(configfile,"com.ibm.notes.branding/enable.update.ui","com.ibm.notes.branding/enable.update.ui=true")
End Sub
Sub ReplaceEntryInTXT(filepath As String, SrcStr As String, RepStr As String)
' この関数はテキストファイルをスキャンして、SrcStrで指定した文字列が見つかったらその行を RepStr で置き換えます
'またエントリが存在しなかった場合、最後にRepStr のエントリを加えます。
' RepStrが空文字（""）の場合、その行は削除されます。
	
	Dim find As Boolean
	Dim tmpfile,txt As String
	tmpfile = filepath & ".tmp"
	find = False
	filenum = Freefile()
	Open filepath For Input As filenum
	filenum2 = Freefile()
	Open tmpfile For Output As filenum2
	
	While Not Eof(filenum)
		Line Input #filenum , txt
		If (Instr(Lcase(txt), Lcase(SrcStr)) > 0) Then
			If Not (RepStr="") Then
				Print #filenum2, RepStr
			End If
			Find = True
		Else
			Print #filenum2, txt
		End If
	Wend
	
	If (find = False) Then
		If Not (RepStr="") Then
			Print #filenum2, RepStr
		End If
	End If
	
	Close filenum
	Close filenum2
	
	Kill filepath
	Filecopy tmpfile, filepath
	Kill tmpfile
End Sub
Function GetProgramDir() As String
	GetProgramDir = ""
	Set objWshShell = CreateObject("WScript.Shell")
	strValue = objWshShell.RegRead("HKLM\SOFTWARE\Lotus\Notes\Path")
	
	If Right(strValue,1) <> "\" Then
		strValue = strValue & "\"  
	End If
	
	GetProgramDir = strValue 
End Function

XPages のデモ

テクてくLotus のXPages勉強会が熱いなあ、といつも思っていたのですが、以下のサイトでここで使われたデモアプリケーションが公開されているみたいですね。


パートナー様製の XPages デモアプリケーション


ファイルをダウンロードしたりIBM製のものはオンラインからIDを使って入って動作を確認したりも出来るみたいです。そのまま使って改良してもいいし、勉強用に手を取ってもいいし、こういうのがあると、XPages もイメージしやすくていいですよね。

是非こういうアプリがもっと増えるといいなあ・・・・と思っています。