十万火急，用notesregister class注册新用户时使用CA去注册，总是不成功。

伏伏 2012-01-29 09:39:04

十万火急,用notesregister class注册新用户时使用CA去注册，总是不成功。
报错。user-defined error.

谁能帮我分析一下啊。十万火急啊。

代码如下



Sub Initialize

	On Error GoTo handleerrors

	MsgBox "agent autoregisteruserbackground register start at "+returnnow

	Dim session As New NotesSession

	Dim dt As Variant

	Dim ss9 As New NotesSession

	Dim db9 As NotesDatabase

	Set db9 = ss9.CurrentDatabase

	Dim doc As NotesDocument

	Dim view As NotesView

	Set view = db9.getview("registeruser")

	Dim dcc As NotesDocumentCollection

	Set dcc = view.Getalldocumentsbykey("GRNU")

	Set doc = dcc.Getfirstdocument()

	While Not doc Is Nothing

		Dim reg As New NotesRegistration

		Dim RegistrationServer As New NotesName(doc.RegistrationServer(0))

		Dim RegistrationServer1 As string

		RegistrationServer1 = RegistrationServer.Canonical

		reg.RegistrationServer = RegistrationServer1

		dt = DateNumber(Year(Today)+100, Month(Today), Day(Today))

		reg.Expiration = dt

		'enable roaming

		If doc.enableroaming(0)="YES" Then

			reg.IsRoamingUser = True

			Dim roamingserver As New NotesName(doc.roamingserver(0))

			Dim roamingserver1 As string

			roamingserver1 = roamingserver.Canonical

			reg.RoamingServer=roamingserver1

			reg.RoamingCleanupSetting = REG_ROAMING_CLEANUP_NEVER

			reg.RoamingSubdir="roaming\" + doc.FirstName(0) +doc.MiddleInitial(0) +doc.LastName(0)+ "\"

		End If

		'create mailserver

		If doc.CreateMailDb(0)="YES" Then

			reg.CreateMailDb =	True

			reg.MailTemplateName=doc.MailTemplateName(0)

		Else

			reg.CreateMailDb = false

		End If

		

		'certifier

		reg.CertifierName = doc.certifier(0)

		reg.UseCertificateAuthority = True

		'id

		reg.NoIDFile = false

		reg.StoreIDinAddressBook = True  

		reg.UpdateAddressBook = True

		reg.IDType = ID_HIERARCHICAL

		reg.OrgUnit = ""		

		'Set ACL

		reg.Mailaclmanager = "_system-All-Admin"

		reg.MailOwnerAccess = 	REG_MAIL_OWNER_ACL_MANAGER

		'Other

		reg.EnforceUniqueShortName = True

		reg.Minpasswordlength = 6

		reg.IsNorthAmerican = False

		reg.SynchInternetPassword = True

		reg.RegistrationLog = "log.nsf"

		'=======use CA to register

		Dim mailserver As New NotesName(doc.mailserver(0))

		Dim mailserver1 As String

		mailserver1 = mailserver.Canonical

		Dim idpath As String

		idpath = doc.idstorefolder(0)+doc.idname(0)+".id"

		MsgBox doc.LastName(0)		&" , "&idpath 		&" , "&mailserver1		&" , "&doc.FirstName(0)		&" , "&doc.MiddleInitial(0)		&" , "&""		&" , "&doc.Location(0)		&" , "&doc.comment(0)		&" , "&"mail\"+doc.mailfile(0)+".nsf"		&" , "&""		&" , "&doc.userpassword(0)	&" , "¬ES_DESKTOP_CLIENT

		Dim lastname1 As String

		lastname1 = doc.LastName(0)

		Dim FirstName1 As string

		FirstName1 = doc.FirstName(0)

		Dim MiddleInitial1 As string

		MiddleInitial1=doc.MiddleInitial(0)

		Dim location1 As  String 

		location1 = doc.Location(0)

		Dim comment1 As string

		comment1 = doc.comment(0)

		Dim mailfile1 As string

		mailfile1="mail\"+doc.mailfile(0)+".nsf"

		Dim userpassword1 As string

		userpassword1 = doc.userpassword(0)

		'--------------

		If reg.RegisterNewUser(lastname1, _  		' last name

		idpath, _ 					' file to be created

		mailserver1, _  				' mail server

		FirstName1, _		                        ' first name

		MiddleInitial1, _                     		' middle initial

		"", _                   			' certifier password

		location1, _                          		' location field

		comment1, _                           		' comment field

		mailfile1, _         				' mail file

		"", _                              		' forwarding domain

		userpassword1, _                   	' user password

		NOTES_DESKTOP_CLIENT) _              		' user type

		Then

			Call doc.Replaceitemvalue("step", "GRNU99")

			Call doc.Replaceitemvalue("status", "Completed")

			doc.log = doc.log(0)+Chr(13)+Chr(10)+returnnow+"	system	[agent]register"

			Dim db1 As New NotesDatabase("hub-01/GURIT","admin\ndcertificates.nsf")

			If db1 Is Nothing Then

				

			else

			End if

			Call doc.save(True,False)

		Else

			Call doc.Replaceitemvalue("status", "Error")

			Call doc.Replaceitemvalue("step", "GRNU005")

			doc.log = doc.log(0)+Chr(13)+Chr(10)+returnnow+"	system	[agent]has an error while register."

			Call doc.save(True,False)

		End If

			

			Set doc = dcc.Getnextdocument(doc)

	Wend

	MsgBox "register end at "+returnnow

	Exit Sub

handleerrors:

	Const sn1 = "agent->autoregisteruserbackground"

	If handleerrorwithoutprint(sn1, CStr(Error$(Err)),CStr(Erl)) Then

		Resume Next

	End If

	Exit Sub

End Sub