chubobo
15-02-06, 12:53 PM
如体，附我BS下注册用户的程序。
Sub Initialize
Dim session As NotesSession
Dim db As NotesDatabase
Dim namesdb As NotesDatabase
Dim note,doc As NotesDocument
Dim view As NotesView
Dim newreg As New notesregistration
Set session = New NotesSession
Set db = session.CurrentDatabase
Set note = session.DocumentContext
Dim certidfile,certpw As String
Dim message , driver , MyServer,path ,faile As String
Dim boxType As Long
Dim paths As String
Dim ll As String
Dim answer As Integer
On Error Goto ErrorHandler
'//该名字是否已被占用
Set namesdb=session.GetDatabase("","names.nsf")
Set view = namesdb.getview("($Users)")
Set doc=view.getdocumentbykey(note.LastName(0),True)
If Not doc Is Nothing Then
Print |<script>window.alert("对不起，您输入的简称已经有人使用！")</script>|
Print |<script>window.history.back()</script>|
Exit Sub
Else
Set doc=view.getdocumentbykey(note.ChineseName(0),True)
If Not doc Is Nothing Then
Print |<script>window.alert("对不起，您输入的中文名已经有人使用！")</script>|
Print |<script>window.history.back()</script>|
Exit Sub
End If
End If
length% = 2
certidfile =session.GetEnvironmentstring("CertifierIDFile",True)
certpw = "password"
Shortname=note.lastname(0)
Lastname=note.ChineseName(0)
newreg.IDType =ID_HIERARCHICAL
newreg.Expiration = Cdat("2100-12-31")
newreg.MinPasswordLength = length%
newreg.IsNorthAmerican = False
newreg.CertifierIDFile = certidfile
newreg.RegistrationServer = db.Server
newreg.CreateMailDb = True
newreg.StoreIDInAddressBook = False
newreg.Updateaddressbook =True
newreg.ShortName=Shortname
MailFile = "Mail\"+Shortname+".nsf"
Firstname=""
RegServer =db.Server
comment=""
IDfile = Left(certidfile,9)+lastname+".id"
userPassword="321"
middleinit=""
location = note.Department(0)
Call newreg.RegisterNewUser(Lastname, IDfile, _
RegServer, Firstname, middleinit, certpw, _
location, comment, MailFile, "",userPassword, _
NOTES_FULL_CLIENT )
'在oaconfig.nsf的Person表单中加入该注册用户
Dim configdb As notesdatabase
Dim configdoc As notesdocument
Set configdb = New notesdatabase( "","weboa\OaConfig.nsf" )
Set configdoc = New notesdocument( configdb )
configdoc.form = "Person"
configdoc.department = note.department(0)
configdoc.PersonNumber = note.PersonNumber(0)
configdoc.CellPhoneNumber = note.CellPhoneNumber(0)
configdoc.OfficePhoneNumber = note.OfficePhoneNumber(0)
configdoc.JobTitle = note.JobTitle(0)
configdoc.OfficeFAXPhoneNumber = note.OfficeFAXPhoneNumber(0)
configdoc.PhoneNumber_6 = note.PhoneNumber_6(0)
configdoc.StreetAddress = note.StreetAddress(0)
configdoc.PhoneNumber = note.PhoneNumber(0)
configdoc.HomeFAXPhoneNumber = note.HomeFAXPhoneNumber(0)
configdoc.Zip = note.Zip(0)
configdoc.LastName = note.LastName(0)
configdoc.ChineseName = note.ChineseName(0)
'configdoc.InternetAddress = note.InternetAddress(0)
Call configdoc.save( True,True )
Call view.refresh
Set doc=view.getdocumentbykey(note.lastname(0),True)
If doc Is Nothing Then
Print "internet口令未设"
Else
Doc.HTTPPassword=Evaluate("@Password('"+userPassword+"')")
Call doc.save(True,False)
Print |<script>window.alert("注册成功！")</script>|
Print |<script>window.history.back()</script>|
End If
Exit Sub
ErrorHandler:
Print Cstr(Erl)+" : "+Error
End Sub
Sub Initialize
Dim session As NotesSession
Dim db As NotesDatabase
Dim namesdb As NotesDatabase
Dim note,doc As NotesDocument
Dim view As NotesView
Dim newreg As New notesregistration
Set session = New NotesSession
Set db = session.CurrentDatabase
Set note = session.DocumentContext
Dim certidfile,certpw As String
Dim message , driver , MyServer,path ,faile As String
Dim boxType As Long
Dim paths As String
Dim ll As String
Dim answer As Integer
On Error Goto ErrorHandler
'//该名字是否已被占用
Set namesdb=session.GetDatabase("","names.nsf")
Set view = namesdb.getview("($Users)")
Set doc=view.getdocumentbykey(note.LastName(0),True)
If Not doc Is Nothing Then
Print |<script>window.alert("对不起，您输入的简称已经有人使用！")</script>|
Print |<script>window.history.back()</script>|
Exit Sub
Else
Set doc=view.getdocumentbykey(note.ChineseName(0),True)
If Not doc Is Nothing Then
Print |<script>window.alert("对不起，您输入的中文名已经有人使用！")</script>|
Print |<script>window.history.back()</script>|
Exit Sub
End If
End If
length% = 2
certidfile =session.GetEnvironmentstring("CertifierIDFile",True)
certpw = "password"
Shortname=note.lastname(0)
Lastname=note.ChineseName(0)
newreg.IDType =ID_HIERARCHICAL
newreg.Expiration = Cdat("2100-12-31")
newreg.MinPasswordLength = length%
newreg.IsNorthAmerican = False
newreg.CertifierIDFile = certidfile
newreg.RegistrationServer = db.Server
newreg.CreateMailDb = True
newreg.StoreIDInAddressBook = False
newreg.Updateaddressbook =True
newreg.ShortName=Shortname
MailFile = "Mail\"+Shortname+".nsf"
Firstname=""
RegServer =db.Server
comment=""
IDfile = Left(certidfile,9)+lastname+".id"
userPassword="321"
middleinit=""
location = note.Department(0)
Call newreg.RegisterNewUser(Lastname, IDfile, _
RegServer, Firstname, middleinit, certpw, _
location, comment, MailFile, "",userPassword, _
NOTES_FULL_CLIENT )
'在oaconfig.nsf的Person表单中加入该注册用户
Dim configdb As notesdatabase
Dim configdoc As notesdocument
Set configdb = New notesdatabase( "","weboa\OaConfig.nsf" )
Set configdoc = New notesdocument( configdb )
configdoc.form = "Person"
configdoc.department = note.department(0)
configdoc.PersonNumber = note.PersonNumber(0)
configdoc.CellPhoneNumber = note.CellPhoneNumber(0)
configdoc.OfficePhoneNumber = note.OfficePhoneNumber(0)
configdoc.JobTitle = note.JobTitle(0)
configdoc.OfficeFAXPhoneNumber = note.OfficeFAXPhoneNumber(0)
configdoc.PhoneNumber_6 = note.PhoneNumber_6(0)
configdoc.StreetAddress = note.StreetAddress(0)
configdoc.PhoneNumber = note.PhoneNumber(0)
configdoc.HomeFAXPhoneNumber = note.HomeFAXPhoneNumber(0)
configdoc.Zip = note.Zip(0)
configdoc.LastName = note.LastName(0)
configdoc.ChineseName = note.ChineseName(0)
'configdoc.InternetAddress = note.InternetAddress(0)
Call configdoc.save( True,True )
Call view.refresh
Set doc=view.getdocumentbykey(note.lastname(0),True)
If doc Is Nothing Then
Print "internet口令未设"
Else
Doc.HTTPPassword=Evaluate("@Password('"+userPassword+"')")
Call doc.save(True,False)
Print |<script>window.alert("注册成功！")</script>|
Print |<script>window.history.back()</script>|
End If
Exit Sub
ErrorHandler:
Print Cstr(Erl)+" : "+Error
End Sub