注册用户

Sub ZhuCeUser(UserName As String,PassWord As String,IDType As String)
  'REM 获得系统变量
 Dim ss As New notessession
 Dim ws As New NotesUIWorkspace
 Dim uidoc As NotesUIDocument
 Set uidoc=ws.CurrentDocument
 Dim doc As NotesDocument
 Set doc=uidoc.Document
 cartfile =  ss.GetEnvironmentString("Directory",True)+"cert.id"
'获得认证文件
  lognsf = ss.GetEnvironmentString("Log",True)
 count = Instr(1,lognsf,",")
 If count > 1 Then
  lognsf = Left(lognsf,count-1)
 End If
'获得日志文件
 
 mailserver = ss.GetEnvironmentString("MailServer",True)
'获得邮件服务器
 
REM datapath = ss.GetEnvironmentString("KeyFilename",True)
 datapath = ss.GetEnvironmentString("Directory",True） 
 'Mailpath = Left(ss.GetEnvironmentString("Directory",True),9)+"Domino/Data/Mail/"
'获得文件所在的目录
 
 Dim iddate As New NotesDateTime(Date)
 Const QiXian = 10 '用户ID使用期限为10年
 Call iddate.AdjustYear( QiXian )
 
REM 定义认证属性
 Dim newreg As New NotesRegistration
 newreg.CertifierIDFile = cartfile '认证CART.ID文件
 newreg.CreateMailDb = True '是否创建邮件数据库
 newreg.Expiration = Datevalue(iddate.dateonly) 'ID文件的有效时间
 newreg.IDType = ID_HIERARCHICAL '用户名称的层次结构
 newreg.IsNorthAmerican = False '是否是北美用户
 newreg.MinPasswordLength = 0 '最小密码长度
 newreg.OrgUnit = "" '组织单元名称
 newreg.RegistrationLog = lognsf '日志记录数据库
 newreg.RegistrationServer = mailserver'注册通讯录所在的服务器名称
 newreg.StoreIDInAddressbook = True '决定是否在通讯录中保存ID文件
 newreg.UpdateAddressbook = True '决定是否更新通讯录
 
REM 为注册用户必须输入赋值的变量
 
 lastname = username '用户姓氏
 idfile = datapath+username+".id" '用户ID文件　
 regserver = mailserver '用户邮件数据库名称　
 firstname = "" '用户名字
 middle = "" '用户中间名
 certpw ="" '认证文件cart.id的密码
 location = "" '保存在通讯录中域"location"的内容
 comment = password '保存在通讯录中域"comment"的注释内容
 maildbpath = "Mail/"+username+".nsf" '用户邮件数据库名称
 fwddomain = "" '用户邮件网络域
 userpw = password '用户密码
 If IDType="拥有全部权限" Then '用户权限类型
  usertype = NOTES_FULL_CLIENT
 Elseif IDType="没有开发设计和管理权限" Then
  usertype = NOTES_DESKTOP_CLIENT
 Else
  usertype = NOTES_LIMITED_CLIENT
 End If
 
%REM
用户类型：
NOTES_DESKTOP_CLIENT：没有开发设计和管理权利
NOTES_FULL _CLIENT :拥有全部权利
NOTES_LIMITED_CLIENT:仅拥有邮件收发权利
%END REM
 
'On Error Goto on_error '如果用户没有选择认证文件，就显示错误通知。
 Call newreg.RegisterNewUser( lastname, idfile, regserver , firstname , middle ,_
 certpw ,location , comment , maildbpath , fwddomain , userpw, usertype )
 Messagebox "成功注册用户："+username+"！",64,"注册成功"
  doc.Save True,True
 Call uidoc.save
 Call uidoc.close
 End Sub