NotesRegistration用于创建ft索引的Lotusscript函数

时间:2017-08-09 01:35:20

标签: lotus-notes lotusscript

我的主要目的是在网站上创建一个名为.nsf的用户,只有" admin"帐户可以为用户进行注册。

管理员帐户有权在下面调用网络代理附加照片设置

enter image description here

我有问题

1。 createftindex =邮件ftindex无法正常运行

enter image description here

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

0 个答案:

没有答案