domino之用web注册用户

用 web 注册用户

Sub Initialize
        On Error Goto errorhandler
        ' 定义在代理中将要用到的对象
        Dim session As New NotesSession   ' 定义服务器Session变量，一个用户一个线程
        Dim db As NotesDatabase           ' 定义一个Notes数据库对象
        Dim dbn As notesdatabase
        Dim acl As NotesACL               ' 定义一个Notes数据库的存取控制列表对象
        Dim entry As NotesACLEntry        ' 定义一个Notes数据库的存取控制列表内的条目对象
        Dim view As NotesView             ' 定义一个Notes数据库内的视图对象
        Dim doc As NotesDocument          ' 定义一个Notes数据库内的文档对象
        '邮件信息
        Dim MailDb As NotesDatabase
        Dim CopyMailDB As Notesdatabase
        Dim template As  NotesDatabase
        
        Dim MailACL As NotesACL          
        Dim MailEntry As NotesACLEntry  
        
        Dim fileName As String
        
        Dim cgi As NotesDocument
        Set cgi = session.DocumentContext
        
        ' 如果帐号为空，则提示
        If (cgi.userName(0)=""  Then
                Msgbox cgi.referer(0)
                Print "<font size=2>用户帐号输录为空，注册失败！请重试</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back(0);'><font size=2>返回</font></a>"
                Exit Sub
        Else
                Dim letterCode As Long        
                Dim ln As String
                Dim l As Long
                
                ln =cgi.userName(0)
                l =Len(cgi.userName(0))
                For i = 1 To l                        
                        letterCode =Asc(Lcase(Mid(ln,i,1)))                        
                        If letterCode<Asc("a"  Or (letterCode>Asc("z" )  Then
                                If letterCode<Asc("0"  Or letterCode>Asc("9"  Then
                                        Print "<font size = 2 >用户帐号包含非法字符"
                                        Print "<hr size=1 color=red>"
                                        Print "点击这里<a href='javascript:history.back(0);'><font size=2>返回</font></a>"
                                        Exit Sub  
                                End If                                
                        End If                        
                Next
        End If
        
        ' 如果用户密码为空，则提示
        If (cgi.HTTPPassword(0)=""  Then
                Print "<font size=2>您的密码没有得到确认，不能注册</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
                Exit Sub
        End If
        ' 如果确认密码为空，则提示
        If (cgi.password(0)=""  Then
                Print "<font size=2>确认密码录入了空值，不能注册</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
                Exit Sub
        End If
        ' 如果真实姓名为空，则提示
        If (cgi.PeopleName(0)=""  Then
                Print "<font size=2>真实姓名录入了空值，不能注册</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
                Exit Sub
        End If
        
        Set db = session.GetDatabase("", "names.nsf"              ' 把db指向Domino目录
        Set view = db.GetView("People"                            ' 取Domino目录的People视图
        Set doc = view.GetDocumentByKey(cgi.LastName(0), False)    ' 得到帐号名为LastName域值的用户文档
        If Not(doc Is Nothing) Then                               ' 如果已经有相同的帐号存在，那么提示
                Print "<font size=2>用户帐号为： "+cgi.LastName(0)+" 的用户已经存在了，不能注册</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
                Exit Sub
        End If
        
        If (cgi.user(0)="webadmini"  Or (cgi.user(0)="KMHWAdmin"  Or (cgi.user(0)="developer"  Or (cgi.user(0)="ADMIN"  Then
                Set doc = db.CreateDocument()           ' 在Domino目录内创建一个新文档doc
                doc.Form = "Person"                     ' 填写doc的域 Form (一个隐藏域)
                doc.Type = "Person"                     ' 填写doc的域 Type
                doc.LastName = cgi.LastName(0)          ' 填写doc的域 FullName
                doc.FullName = cgi.LastName(0)          ' 填写doc的域 LastName
                doc.HTTPPassword = cgi.HTTPPassword(0)  ' 填写doc的域 HTTPPassord
                doc.Password = cgi.Password(0)          ' 填写doc的域 Passord
                doc.PeopleName = cgi.PeopleName(0)      ' 填写doc的域 PeopleN ame
                doc.MailSystem = "6"
                doc.MailServer = session.userName
                doc.MailFile = Trim("mail/"+cgi.lastName(0))
                doc.MailDomain = cgi.doMain(0)
                
                Call doc.Save(True, False)              ' 保存 doc
                
                Set acl = db.ACL                                                   ' 提取Domino目录的存取控制列表
                Set entry = acl.CreateACLEntry(cgi.LastName(0), ACLLEVEL_MANAGER)  ' 添加注册用户到存取控制列表里面，并设置其为管理员]
                entry.CanDeleteDocuments = False                                   ' 不能删除文档
                Call acl.Save()                                                    ' 保存修改结果到Domino目录
                Set db = session.CurrentDatabase                                   ' 将db指向当前数据库
                Set acl = db.ACL                                                   ' 提取当前数据库的存取控制列表
                Set entry = acl.CreateACLEntry(cgi.LastName(0), ACLLEVEL_MANAGER)  ' 添加条目到当前数据库的存取控制列表之中
                entry.CanDeleteDocuments = False
                Call acl.Save()         ' 保存结果
                '创建邮件数据库                
                Print "From here"
                Set mailDb = New notesDatabase("","mail50.ntf" '邮件系统模板
                fileName = Trim("mail\"+cgi.lastName(0)+".nsf" '目标邮件数据库文件名
                Set CopyMailDB =  MailDB.CreateCopy("",fileName)'邮件数据库(个人)
                CopyMailDB.Title =cgi.PeopleName(0)+"个人邮箱"'邮件数据库标题
                Print "pass 1"
                Set MailACL = CopyMailDB.ACL '邮件数据库的存取控制列表
                Set MailEntry =MailACL.CreateACLEntry(cgi.lastName(0),ACLLEVEL_MANAGER)'设置存取控制列表的权限
                Call  MailACL.save'保存控制列表
                Print "pass 2"
                'Set MailEntry =MailACL.CreateACLEntry(cgi.user(0),ACLLEVEL_MANAGER)
                'Call  MailACL.save                
                Print "<font size=2>用户帐号"+cgi.LastName(0)+" 已经注册成功了</font>"
                Print "且已经创建"+cgi.peopleName(0)+"个人邮箱("+copyMailDB.FileName+" "
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
                
        Else
                Print "<font size=2>您不是系统管理员，不能注册</font>"
                Print "<hr size=1 color=red>"
                Print "点击这里<a href='javascript:history.back();'><font size=2>返回</font></a>"
        End If        
        Exit Sub
errorhandler:
        Print Cstr(Erl)+" "+Error$
        Exit Sub
End Sub<!-- viewthread_post_sig -->