Не могу обработать ошибку 4060 в цикле

Тема в разделе "Lotus - Программирование", создана пользователем deeeman, 18 июн 2015.

  1. deeeman

    deeeman Well-Known Member

    Регистрация:
    4 дек 2007
    Сообщения:
    382
    Симпатии:
    0
    Добрый день!

    нужно просканировать все базы на серверах и сделать логи по пользователям кто какие права на базы имеет.
    соответсвенно есть настройка серверов
    так же есть настройка папок (чтобы определять почтовая это база или нет)

    НО! есть базы в которые нет доступа, мне их надо пропускать, но не получается...

    какие то базы проскакивает а на каких то все равно валиться с ошибкой 4060

    вот код, подскажите что не так?

    Код (LotusScript):
    Option Public
    Option Declare
     
    Dim db As NotesDatabase
    Dim keyView As NotesView
    Dim ScanDb As NotesDatabase
     
    Sub Initialize
     
    On Error GoTo ErrSub
    'On Error Resume next
    Dim agentName As String
    agentName = "getLogs2"
     
    MsgBox agentName + " Start!"
     
    Dim s As New NotesSession
     
    Dim i As Integer
    Dim msg As String
    Dim SetView As NotesView
    Dim SetDoc As NotesDocument
    Dim profDoc As NotesDocument
    Dim directory As NotesDbDirectory
    Dim flagEx As Boolean
    Dim owner As String
    Dim level As Integer
    Dim StrFormula As String
    Dim namesDb As NotesDatabase
    Dim namesDC As NotesDocumentCollection
    Dim namesDoc As NotesDocument
    Dim maildblist() As String
    Dim dblist() As String
    Dim serverDSP As string
    Dim pDoc As NotesDocument
     
    Set db = s.Currentdatabase
    Set SetView = db.Getview("Settings")
    Set keyView = db.Getview("PersonLogByKey")
    Set SetDoc = SetView.Getfirstdocument()
    If SetDoc Is Nothing Then
    MsgBox "Не найдена настройка!"
    GoTo EndSub
    End If
     
     
    Set pDoc = keyView.Getfirstdocument()
    While Not pDoc Is Nothing
    Call pDoc.Removeitem("MailDBList")
    Call pDoc.Removeitem("DBList")
    Call pDoc.save(True,true)
    Set pDoc = keyView.Getnextdocument(pDoc)
    Wend
     
    Set namesDb = s.Getdatabase(db.server,"names.nsf")
    StrFormula = {form = "Person" & @LowerCase(CompanyName) = "} & LCase(SetDoc.Getitemvalue("Company")(0)) & {"}
     
    Set namesDC = namesDb.Search(StrFormula,Nothing,0)
     
    If namesDC.Count > 0 Then
    Set namesDoc = namesDC.Getfirstdocument()
    While Not namesDoc Is Nothing
     
    ReDim maildblist(0)
    ReDim dblist(0)
     
    'создаем\обновляем карточку лога сотрудника
    Set pDoc = CreatePersonLog(namesDoc.Getitemvalue("Owner")(0))
    If pDoc Is Nothing Then GoTo nextP
     
    ForAll server In SetDoc.Getitemvalue("Servers_1")
     
    If InStr(server,"/") > 0 then
    serverDSP = StrLeft(server,"/")
    Else
    serverDSP = server
    End if
     
    ForAll folder In SetDoc.Getitemvalue("Folders_1")
     
    Set directory = s.GetDbDirectory(server)
    Set ScanDb = directory.GetFirstDatabase(DATABASE)
    While Not ScanDb Is Nothing
      level = 0
     
    If UCase(StrLeft(Replace(ScanDb.Filepath,"/","\"),"\")) = UCase(folder) Then  'почта
     
    Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
    If Not ScanDb Is Nothing Then
      If ScanDb.Filepath = "" Then GoTo nextdb
      msg = ScanDb.Filepath
    level = ScanDb.QueryAccess(namesDoc.Getitemvalue("Owner")(0))
    End If
     
    ReDim Preserve maildblist(UBound(maildblist)+1)
      maildblist(UBound(maildblist)) = ScanDb.Title & "~~" & ScanDb.Filepath & " (" & (serverDSP) & ")" & "~~" & CStr(level)
     
    Else  'не почтовая бд
      Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
      If Not ScanDb Is Nothing Then
    If ScanDb.Filepath = "" Then GoTo nextdb
    level = ScanDb.QueryAccess(namesDoc.Getitemvalue("Owner")(0))
    msg = ScanDb.Filepath
    End If
     
      ReDim Preserve dblist(UBound(dblist)+1)
    dblist(UBound(dblist)) = ScanDb.Title & "~~" & ScanDb.Filepath & " (" & (serverDSP) & ")" & "~~" & CStr(level)
     
    End If
     
    nextdb:
    Set ScanDb = directory.Getnextdatabase
    Wend
    End ForAll
    End ForAll
    nextP:
     
    Call pDoc.Replaceitemvalue("MailDbList", ArrayUnique(FullTrim(maildblist)))
    Call pDoc.Replaceitemvalue("DbList", ArrayUnique(FullTrim(dblist)))
    Call pDoc.save(True,true)
     
    Set namesDoc = namesDC.Getnextdocument(namesDoc)
    Wend
    End If
     
    MsgBox agentName + " Finish!"
     
    EndSub:
    Exit Sub
    ErrSub:
    If Err = 4060 Then GoTo nextdb
     
    MsgBox  "Error (" & Err() & ") in " & agentName & " at line " & Erl() & ": " & Error()
    Resume EndSub
    End Sub
     
    Function createPersonLog(lotusName As String) As NotesDocument
    On Error GoTo ErrSub
    'On Error Resume next
    Dim agentName As String
    agentName = "getLogs2/createPersonLog"
     
    Dim logDoc As NotesDocument
     
    Set logDoc = keyView.getdocumentbykey(lotusName)
    If logDoc Is Nothing Then
     
    Set logDoc = db.Createdocument()
    Call logDoc.Replaceitemvalue("Form","PersonLog")
    Call logDoc.Replaceitemvalue("NotesName",lotusName)
    Call logDoc.Replaceitemvalue("MailDBList","")
    Call logDoc.Replaceitemvalue("DBList","")
    Call logDoc.save(True,True)
     
    End If
     
    Set createPersonLog = logDoc
     
    EndSub:
    Exit Function
    ErrSub:
    MsgBox  "Error (" & Err() & ") in " & agentName & " at line " & Erl() & ": " & Error()
    Resume EndSub
    End Function
     
  2. savl

    savl Lotus team
    Lotus team

    Регистрация:
    28 окт 2011
    Сообщения:
    2.052
    Симпатии:
    146
    А где?
    ScanD.isOpen , по этому флагу можно проверять.
    Получить базу мало, надо еще проверить можно ли её открыть.
     
  3. deeeman

    deeeman Well-Known Member

    Регистрация:
    4 дек 2007
    Сообщения:
    382
    Симпатии:
    0
    вставляю isOpen до строки:
    Set ScanDb = s.Getdatabase(server,ScanDb.Filepath)
    всегда false
    вставляю после, ошибка на самой строке Getdatabase

    итог: не помогло.
     
  4. deeeman

    deeeman Well-Known Member

    Регистрация:
    4 дек 2007
    Сообщения:
    382
    Симпатии:
    0
    проблему решил. сервера между собой не дружили.главный не все мог открывать с дополнительного.
    пришлось делать копию базы на другой сервер и там запускать агента.

    а что нужно настроить чтобы сервера дружили?
    на вкладке Security у дополнительного сервера стоит главный сервер везде кроме Administration и Full Administration
     
  5. oshmianski

    oshmianski Достойный программист
    Lotus team

    Регистрация:
    25 апр 2012
    Сообщения:
    521
    Симпатии:
    13
    коннекшены, ACL проверяли?
    если не в одном домене, то кроссертификация.
     
  6. deeeman

    deeeman Well-Known Member

    Регистрация:
    4 дек 2007
    Сообщения:
    382
    Симпатии:
    0
    1. в ACL базы на дополнительном сервере должно быть обязательно указан главный сервер для того чтобы главный мог открыть базу на дополнительном?
    сейчас это не так, но главный некоторые открывает...а некоторые нет.

    в одном домене.
    конекшены есть.
     
  7. oshmianski

    oshmianski Достойный программист
    Lotus team

    Регистрация:
    25 апр 2012
    Сообщения:
    521
    Симпатии:
    13
    я бы в ACL добавил группу LocalDomainServers (или кастомную) и дал бы ей полные права. естественно, в этой группе должны быть все нужные сервера.
     
  8. Constantin A Chervonenko

    Constantin A Chervonenko Well-Known Member

    Регистрация:
    30 май 2006
    Сообщения:
    1.288
    Симпатии:
    0
    Что-бы фоновый агент на одном сервере мог открыть БД на другом сервере, он (1й сервер) должен быть помянут на 2-м как Trusted.
    Вроде так...
     
  9. motogarri

    motogarri Well-Known Member

    Регистрация:
    17 фев 2010
    Сообщения:
    188
    Симпатии:
    4
    Помню была как-то пролема с db.IsOpen у меня. При получение объекта NotesDatabase из сессии проверка на IsOpen не работала. Когда брал New NotesDatabase, тогда работала корректно.
     
Загрузка...

Поделиться этой страницей