我的主要目的是在网站上创建一个名为.nsf的用户,只有" admin"帐户可以为用户进行注册。
管理员帐户有权在下面调用网络代理附加照片设置
我有问题
1。 createftindex =邮件ftindex无法正常运行
2。分组 =可以添加两个组吗?例如[Everyone]组和[software]组
我的编码部分是否错误?
reg.Mailcreateftindex =真
reg.Grouplist ="每个人"
Option Public
Option Declare
Sub Initialize
' this agent use on [register] button locate on [request form] xpages
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpath As String
Dim userID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0) ' full path of cert id
certpasswd = depdoc.IdPassword(0) ' Cert id password(password)
OU = "" 'depdoc.Dept(0) ' Application (department to register)
lastname= doc.Name(0) ' current document selected mail (person)
firstname = "" ' [din't used]
middleinit = "" ' [din't used]
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id" ' user path
' id cannot have . in between for example, test1.Apple
' remove "." replace with empty and remove the empty space
userID = remapChr(doc.SelectMail(0))
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+userID ' Mail\Person
userpasswd= depdoc.UserPassword(0) ' User password
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr '"CN=ServerOne/O=dev"
reg.CreateMailDb = True '
reg.CertifierIDFile = certid '"C:\IBM\Domino\data\office.id"
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1 ' password strength
reg.IsNorthAmerican = True
reg.OrgUnit = OU ' "" empty ..will just follow certid registration
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.StoreIDInAddressBook = True
reg.MailInternetAddress = internetpath '"desmond@devsv1.pcs.com.my"
reg.Shortname=userID ' 'Set shortname []
reg.Mailowneraccess =2 ' '[editor access]
reg.Mailcreateftindex=True ' '[Indexing]
reg.Mailaclmanager ="LocalDomainAdmins" ' 'Add LocalDomainAdmins into mail acl
reg.Grouplist="Everyone" ' 'Everyone
Call reg.RegisterNewUser(lastname, _ ' last name
usridpath, _ '"C:\IBM\Domino\data\ +name+.id" ' file to be created
mailsvr, _ '"CN=ServerOne/O=dev" ' mail server
firstname, _ ' ' first name
middleInit, _ ' ' middle initial
certpasswd, _ '"office" ' certifier password
"", _ ' location field
"", _ ' comment field
mailfile, _ '"mail\person.nsf" ' mail file
"", _ ' Forwarding domain
userpasswd, _ '"password", _ ' user password
NOTES_DESKTOP_CLIENT) ' user type
' call name nsf and open for edit for forcing user must change password first time
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(userID,True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Call docUser.Save( True, True, True )
Print "Please wait ...... Registration in progress"
End Sub
Function remapChr (oldString)
' to replace all special character with a empty space after that trim to remove all special character in system
Dim oldChr, newChr, newString As String
oldChr = {! "" # $ % & ' ( ) * + , - . / : ; = > ? @ [ \ ] ^ _}
newChr = " {"
oldChr = Split(oldChr, " ")
newChr = Split(newChr, " ")
newString = Trim(Replace(LCase(oldString), oldChr, newChr))
remapChr = newString
End Function