LotusScript实现自动切换用户ID

Sub Initialize
%REM 切换用户ID
本程序的作用是：
1、从指定的目录中搜索所有ID文件，
2、然后提供用户选择
3、再从注册用户时保存在names.nsf数据库中的密码进行校对看是否相同。
4、再通过用户选择的ID文件更换操作员ID

本程序有以下缺陷：
1、取得特殊指定目录下的ID文件
2、无法判断获得的ID文件是用户ID，还是Server.id,cert.id
3、用户密码需要保存在names.nsf中，首先进行密码核对，造成安全泄露。
但不这样做，无法截获用户输入密码错误，程序不好处理。
4、因此仅适合单机用户。
%END REM

' 首先搜索指定目录下的所有ID文件

Dim ss As New notessession

xx = ss.UserNameList

IDPath = ss.GetEnvironmentString("Directory",True)
IDFileAll = IDPath+"*.id"
'没有方法遍历所有目录，所以假定所有ID文件在此目录下

fileName = Dir(IDFileAll, 0)
num = 0
Do While fileName <> ""
num = num + 1
fileName = Dir()
Loop

If num = 0 Then Exit Sub '没有找到ID文件就退出程序

Redim ids(1 To num) 
num = 1
fileName = Dir(IDFileAll, 0)
Do While fileName <> ""
ids(num) = Left(filename,Instr(1,filename,".")-1)
num = num + 1
fileName = Dir()
Loop

Dim uiw As New notesuiworkspace
IDuser = uiw.Prompt( PROMPT_OKCANCELLIST,"更换操作员","请选择一个操作员:","",ids)
If IDuser = "" Then Exit Sub

' 从names.nsf中获取密码 
Dim ndb As notesdatabase
Set ndb = ss.getdatabase("","names.nsf")
Dim nvi As notesview
Set nvi = ndb.getview("People")
Dim pdoc As notesdocument
Set pdoc = nvi.getdocumentbykey(IDuser)
pass = pdoc.comment(0)

For i = 1 To 3
IDpass = uiw.Prompt( PROMPT_PASSWORD,"输入密码","请输入您的密码：")
If pass = IDpass Then Exit For 
Next
If pass <> IDpass Then Exit Sub

Dim idfile As String
idfile = IDPath+""+IDuser+".id"

Dim newreg As New NotesRegistration 

Call newreg.SwitchToID( idfile,pass )

Messagebox "当前操作员是："+IDuser,64,"更换成功"
Exit Sub

End Sub