Copiare ACL via LotusScript

In LotusScript abbiamo le classi per manipolare l’ACL di un database ma purtroppo non esiste un metodo per copiare direttamente un ACL da un database ad un altro .

Ecco una sub che esegue la copia dell’ACL , compresi i ruoli :

Sub copiaAcl( dbPartenza As NotesDatabase , dbArrivo As NotesDatabase)
	Dim acl As NotesACL
	Dim targetacl As NotesACL
	Dim entry As NotesACLEntry
	Dim targetEntry As NotesACLEntry
	Dim entry2 As NotesACLEntry

	If dbArrivo Is Nothing Then
		Call scrivilog("Non trovo db arrivo",2,"copiaAcl") 
		Exit Sub
	End If
	On Error GoTo Gestisci_copiaAcl:	
	'Istanzio i due ACL
	Set acl = dbPartenza.ACL
	Set targetacl = dbArrivo.ACL

	'Rimuovo le entry del db arrivo per evitare duplicati
	
	Set targetentry = targetacl.getfirstEntry
	While Not(targetentry Is Nothing)
		'Skip se la entry è -Default- , LocalDomainAdmins o LocalDomainServers
		If targetentry.name <> "-Default-" And targetentry.name <> s.username And targetentry.name <> "LocalDomainServers" And targetentry.name <> "LocalDomainAdmin"  Then
			Set entry2 = targetacl.getnextentry(targetentry)
			Call targetentry.remove()
			Call targetACL.save()
			Set targetentry = entry2
		Else
			Set targetentry = targetacl.getnextentry(targetentry)
		End If
	Wend
	'Rimuovo ruoli esistenti
	ForAll r In targetacl.roles
		If r<>"" Then Call targetacl.deleterole(r)
	End ForAll
	Call targetacl.save()

	'Creo ruoli nuovi
	ForAll r In acl.roles
		If r<>"" Then Call targetacl.addrole(r)
	End ForAll

	'Adesso scrivo l'ACL sul di db di arrivo
	Set entry = acl.GetFirstEntry
	While Not(entry Is Nothing)
		If targetentry.name <> "-Default-" And targetentry.name <> s.username And targetentry.name <> "LocalDomainServers" And targetentry.name <> "LocalDomainAdmin"  Then
			Set targetEntry = targetACL.CreateACLEntry(entry.name, entry.level)
			targetentry.usertype = entry.usertype
			targetentry.isgroup = entry.isgroup
			targetentry.isperson = entry.isperson
			targetentry.isserver = entry.isserver
			targetentry.ispublicreader = entry.ispublicreader
			targetentry.ispublicwriter = entry.ispublicwriter
			targetentry.IsAdminServer = entry.IsAdminServer
			targetentry.IsAdminReaderAuthor = entry.IsAdminReaderAuthor
			targetentry.CanCreateDocuments = entry.CanCreateDocuments
			targetentry.CanDeleteDocuments = entry.CanDeleteDocuments
			targetentry.CanCreatePersonalAgent = entry.CanCreatePersonalAgent
			targetentry.CanCreateLSorJavaAgent = entry.CanCreateLSorJavaAgent
			targetentry.CanCreateSharedFolder = entry.CanCreateSharedFolder
			targetentry.CanCreatePersonalFolder = entry.CanCreatePersonalFolder
			targetentry.CanReplicateorCopyDocuments = entry.CanReplicateorCopyDocuments
			ForAll r In entry.roles
				If r<>"" Then Call targetentry.enablerole(r)
			End ForAll
			Call targetACL.save()
		End If
		Set entry = acl.GetNextEntry(entry)
	Wend

	Set targetentry=targetacl.getentry("-Default-")
	Set entry=acl.getentry("-Default-")
	targetentry.level = entry.level
	targetentry.ispublicreader = entry.ispublicreader
	targetentry.ispublicwriter = entry.ispublicwriter
	targetentry.CanCreateDocuments = entry.CanCreateDocuments
	targetentry.CanDeleteDocuments = entry.CanDeleteDocuments
	targetentry.CanCreatePersonalAgent = entry.CanCreatePersonalAgent
	targetentry.CanCreateLSorJavaAgent = entry.CanCreateLSorJavaAgent
	targetentry.CanCreateSharedFolder = entry.CanCreateSharedFolder
	targetentry.CanCreatePersonalFolder = entry.CanCreatePersonalFolder
	targetentry.CanReplicateorCopyDocuments = entry.CanReplicateorCopyDocuments

	ForAll r In entry.roles
		If r<>"" Then Call targetentry.enablerole(r)
	End ForAll

	Call targetACL.save()
		
	
fine_acl:
Exit Sub

Gestisci_copiaAcl:	
	errmsg$ = Str(Err) & ": " & Error$ & " linea " & CStr(Erl) 
	Print errmsg$
	 
Resume fine_acl
End Sub

 

0 commenti

Invia un commento

Il tuo indirizzo email non sarà pubblicato. I campi obbligatori sono contrassegnati *