Beiträge von Diali

Function Sonderzeichen_ersetzen(txt As String) As String
    ' ersetzt alle Steuerzeichen und \ durch ein Leerzeichen
    Sonderzeichen_ersetzen = ""
    For i = 0 To Len(txt) - 1
      zeichen_nr = Asc(Right(txt, Len(txt)- i))
      If Zeichen_nr > 31 And zeichen_nr <> Asc("\") Then
        Sonderzeichen_ersetzen = Sonderzeichen_ersetzen + Chr(zeichen_nr)
      Else
        Sonderzeichen_ersetzen = Sonderzeichen_ersetzen + " "
      End If
    Next
End Function

Sub Initialize
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim view_Personen As NotesView
  Dim view_Gruppen As NotesView
  Dim doc_Personen As NotesDocument
  Dim doc_Gruppen As NotesDocument
  Set db = session.CurrentDatabase
  Set view_Personen = db.GetView("People")
  Set view_Gruppen = db.GetView("Groups")
  Set doc_Personen = view_Personen.GetFirstDocument
  Dim Array() As String
  Dim Kategorie As String

  ' über alle Personen-Dokumente gehen
  While Not doc_Personen Is Nothing
    If Trim(doc_Personen.FullName(0)) <> "" Then
      ' über alle Kategorieen gehen, falls mehrere eingetragen sind
      For i = 0 To Ubound(doc_Personen.Categories)
        ' nur wenn etwas im Kategorieeintrag steht
        If Trim(doc_Personen.Categories(i)) <> "" Then
          Kategorie = Sonderzeichen_ersetzen(doc_Personen.Categories(i))
          ' Gruppe für die Kategorie suchen
          Set doc_Gruppen = view_Gruppen.GetDocumentByKey(Kategorie, True)
          ' ist die Gruppe schon vorhanden
          If doc_Gruppen Is Nothing Then
            ' Gruppe nicht vorhanden ... neu anlegen
            Set doc_Gruppen = New NotesDocument(db)
            ' Felder zuweisen und Eigenschaften setzen
            doc_Gruppen.Form = "Group"
            doc_Gruppen.Type= "Group"
            Set item_Members = New NotesItem(doc_Gruppen, "Members", Trim(doc_Personen.FullName(i)), NAMES)
            Set item_DocumentAccess = New NotesItem(doc_Gruppen, "DocumentAccess", "[GroupModifier]", AUTHORS)
            doc_Gruppen.GroupType = "0"
            doc_Gruppen.AvailableForDirSync = "1"
            doc_Gruppen.ListName = Kategorie
            flag = doc_Gruppen.ComputeWithForm(True, True)
            doc_Gruppen.Save True, True, True
            ' Refresh der Ansicht, damit neue Gruppen gefunden werden
            Call view_Gruppen.Refresh
          Else
            Redim Array(0)
            vorhanden = False
            For i_Array = 0 To Ubound(doc_Gruppen.Members)
              ' Gruppe ist vorhanden ... ist Person schon in der Gruppe eingetragen
              If Trim(doc_Gruppen.Members(i_Array)) = Trim(doc_Personen.FullName(0)) Then
                ' Abbruch Person ist schon in der Gruppe
                i_Array = Ubound(doc_Gruppen.Members)
                vorhanden = True
              Else
                ' Array mit allen Gruppenmitgliedern erstellen
                If Array(0) <> "" Then
                  Redim Preserve Array(Ubound(Array) +1)
                End If
                Array(Ubound(Array)) = Trim(doc_Gruppen.Members(i_Array))
              End If
            Next
            If Not vorhanden Then
              ' Person war nicht in Gruppe, dann Person hinzufügen
              Redim Preserve Array(Ubound(Array) +1)
              Array(Ubound(Array)) = Trim(doc_Personen.FullName(0))
              doc_Gruppen.Members = Array
              flag = doc_Gruppen.ComputeWithForm(True, True)
              doc_Gruppen.Save True, True, True
            End If
          End If
        End If
      Next
    End If
    Set doc_Personen = view_Personen.GetNextDocument(doc_Personen)
  Wend
End Sub
 
 
Function Sonderzeichen_ersetzen(txt As String) As String
  ' ersetzt alle Steuerzeichen und \ durch ein Leerzeichen
  Sonderzeichen_ersetzen = ""
  For i = 0 To Len(txt) - 1
    zeichen_nr = Asc(Right(txt, Len(txt)- i))
    If Zeichen_nr > 31 And zeichen_nr <> Asc("\") Then
      Sonderzeichen_ersetzen = Sonderzeichen_ersetzen + Chr(zeichen_nr)
    Else
      Sonderzeichen_ersetzen = Sonderzeichen_ersetzen + " "
    End If
  Next
End Function

(Declarations)
Const APIModule = "NNOTES" ' Windows/32 only
Const REPLFLG_DO_NOT_BROWSE = &H0400
 
Type ReplicaInfo
  ID(1) As Long
  Flags As Integer
  CutoffDays As Integer
  CutoffDate(1) As Long
End Type
 
Declare Function NSFDbOpen Lib APIModule Alias "NSFDbOpen" ( Byval P As String, H As Long) As Integer
Declare Function NSFDbClose Lib APIModule Alias "NSFDbClose" ( Byval H As Long) As Integer
Declare Function OSPathNetConstruct Lib APIModule Alias "OSPathNetConstruct" ( Byval Z As Long, Byval S As String, Byval F As String, Byval P As String) As Integer
Declare Function NSFDbReplicaInfoGet Lib APIModule Alias "NSFDbReplicaInfoGet" ( Byval H As Long, R As ReplicaInfo) As Integer
Declare Function NSFDbReplicaInfoSet Lib APIModule Alias "NSFDbReplicaInfoSet" ( Byval H As Long, R As ReplicaInfo) As Integer
 
' Beispiel Script
	Dim hDB As Long
	Dim session As New NotesSession
	Dim db As NotesDatabase
	Set db = session.CurrentDatabase
	p$ = String(1024, " ")
	OSPathNetConstruct 0, db.Server, db.FilePath, p$
	NSFDbOpen p$, hDB

	Dim R As ReplicaInfo
	NSFDbReplicaInfoGet hDB, R
	R.Flags = R.Flags And Not REPLFLG_DO_NOT_BROWSE   ' Haken setzen
'	R.Flags = R.Flags Or REPLFLG_DO_NOT_BROWSE   ' Haken löschen
	NSFDbReplicaInfoSet hDB, R

	NSFDbClose hDB

' db_kop ... DB-Kopie
' db_org ... originale DB
 Dim db_kop As NotesDatabase
 Set db_kop = db_org.CreateCopy(SERVER, DATEINAME)
 Dim dc_org As NotesDocumentCollection
 Set dc_org = db_org.AllDocuments
 Dim doc_org As NotesDocument
 Set doc_org = dc.GetFirstDocument

'kopieren der Dokumente
 While Not doc_org Is Nothing
  Set doc_kop = doc_org.CopyToDatabase( db_kop )
  doc_kop.OriginalUID = doc_org.UniversalID
  doc_kop.Save True, True, True
  Set doc_org = dc_org.GetNextDocument(doc_org)
 Wend

' Ordner-Einträge prüfen
 Dim ndt As New NotesDateTime("30.12.1899")
 Forall v In db_org.Views
  If v.IsFolder Then
   Set doc_org = v.GetFirstDocument
   While Not doc_org Is Nothing
    Set doc_kop = db_kop.Search("OriginalUNID=""" & _
    doc_org.UniversalID & """", ndt,0)
    If Not doc_kop Is Nothing Then
     Call doc_kop.PutInFolder(v.Name, True)
    End If
    Set doc_org = v.GetNextDocument(doc_org)
   Wend
  End If
 End Forall