スポンサーサイト
上記の広告は１ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
新しい記事を書く事で広告が消せます。
Notes/Domino のサポートをしていて、気が付いたことや共有したい事があったらメモしてみます。
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
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
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
