обновление и замена дизайна

Тема в разделе "Работа с API", создана пользователем hosm, 1 дек 2009.

  1. hosm

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    Подкорректирован код ToxaRat из темы про наследование шаблонов
    Пусть тут будет.
    Так как на маках и всяких прочих никсах не пробовала делать обновление, деклараций для этих платформ и кроссплатформенной обработки нет.

    Вариант для WinAPI:
    Код (Text):
    Declare Private Function W32_NSFDbOpen Lib "nnotes" Alias "NSFDbOpen" (Byval PathName As Lmbcs String, hDB As Long) As Integer
    Declare Private Function W32_NSFDbClose Lib "nnotes" Alias "NSFDbClose" (Byval hDB As Long) As Integer
    'обновление
    Declare Private Function W32_DesignRefresh Lib "nnotes" Alias "DesignRefresh" (Byval ServerName As Lmbcs String, Byval hDB As Long, Byval dwFlags As Long, Byval abortCheck As Long, Byval messageProc As Long) As Integer
    'замена дизайна из шаблона
    Declare Function W32_DesignReplace Lib "nnotes.dll" Alias "DesignReplace" (Byval ht As Long, Byval hDB As Long, Byval dw1 As Long, Byval dw2 As Long, Byval dw3 As Long, Byval dw4 As Long) As Integer
    Обновление дизайна
    Код (Text):
    Sub RefreshDesign(destPath As String)
    Dim rc As Integer, hDb As Long
    Call AddLog("Обновление на сервере: " & destPath & " ...")  
    rc = W32_NSFDbOpen(destPath, hDb) ' Open the db in the API and get a handle to the open db
    If rc <> 0 Then
    Call AddLog("Не удаётся открыть БД - Error Code " & Cstr(rc))
    Else
    rc = W32_DesignRefresh("", hDb, 0, 0, 0)
    If rc <> 0 Then
    Call AddLog("Не удалось обновить БД - Error Code " & Cstr(rc))
    End If
    Call W32_NSFDbClose(hDb)
    End If
    End Sub
    Замена дизайна из указанного шаблона
    Код (Text):
    Sub ReplaceDesign(Byval templateDB As String, Byval targetDB As String)
    Dim status As Integer
    Dim htemplate As Long
    Dim htarget As Long

    status = W32_NSFDbOpen(templateDB, htemplate)
    If status<>0 Then
    Call AddLog("Не удалось открыть шаблон " & templateDB & " - Error Code " & Cstr(status) )
    Exit Sub
    End If

    status = W32_NSFDbOpen(targetDB, htarget)
    If status<>0 Then
    Call AddLog("Не удалось открыть БД " & targetDB & " - Error Code " & Cstr(status) )          
    Call W32_NSFDbClose(htemplate)
    Exit Sub
    End If

    Call W32_DesignReplace(htemplate, htarget, 1, 0, 0, 0) 
    Call W32_NSFDbClose(htemplate)
    Call W32_NSFDbClose(htarget)
    End Sub
    P.S. destPath, templateDB и targetDB имеют вид <имя сервера>!!<путь к бд> для базы на сервере,
    для локальной БД достаточно указать <путь к бд>.
     
  2. TIA

    TIA :-)
    Lotus team

    Регистрация:
    15 май 2009
    Сообщения:
    790
    Симпатии:
    0
    У приведённого RefreshDesign не хватает возможности указать имя сервера, с которого необходимо обновить дизайн и не очевидно, что формат параметра destPath должен быть <имя сервера>!!<путь к бд>. Тоже относится и к templateDB, targetDB у ReplaceDesign
    Лучше так:
    Код (Text):
    Sub RefreshDesign(db as NotesDatabase, templateServer As String, force As Integer)
    dim flags&, destPath$
    dim hDb As Long

    If force Then flags = DESIGN_FORCE ' Force operation, even if destination "up to date".
    destPath = db.FilePath
    if db.Server<>"" then destPath = db.Server & "!!" & destPath

    rc = W32_NSFDbOpen(destPath, hDb) ' Open the db in the API and get a handle to the open db
    If rc Then
    Call AddLog("Не удаётся открыть БД. " & getLNerror(rc))
    Else
    rc = W32_DesignRefresh(templateServer, hDb, flags, 0, 0)
    If rc <> 0 Then
    Call AddLog("Не удалось обновить БД. " & getLNerror(rc))
    End If
    End If
    if hDb then W32_NSFDbClose(hDb)
    End Sub
    Код (Text):
    Declare Public Function OSLoadString Lib "nnotes.dll" Alias "OSLoadString" _
    (Byval hModule&, Byval StringCode%, Byval retBuffer As Lmbcs String, BufferLength%) As Integer

    Public Function getLNerror(stat%) As String
    Dim s$
    s$=String$(500," ") ' должно хватить

    Dim i%
    i%=OSLoadString(0,stat%,s$,500)
    If i%=0 Then
    getLNerror="Error description not found. Code: """+Cstr(stat%)+"""."
    Else
    getLNerror=Left$(s$,i%)
    End If
    End Function
     
  3. savl

    savl Lotus team
    Lotus team

    Регистрация:
    28 окт 2011
    Сообщения:
    2.051
    Симпатии:
    146
    Так как описания W32_DesignReplace нет, решил поиграться.
    Провел пару экспериментов, правда использовал 1 и 0, выяснил:
    Код (LotusScript):
     Call W32_DesignReplace(htemplate, htarget, 0, 0, 0, 0)
    Call W32_DesignReplace(htemplate, htarget, 0, 1, 0, 0)
    Call W32_DesignReplace(htemplate, htarget, 1, 0, 0, 0)
    Call W32_DesignReplace(htemplate, htarget, 1, 1, 0, 0)
    Работают совершенно одинаково.
    Видимо параметры A и B игнорируются, а вот C и D кладут Lotus при изменении.
    Код (LotusScript):
    Call W32_DesignReplace(htemplate, htarget, A, B, C, D)
     
  4. proteam

    proteam Well-Known Member

    Регистрация:
    2 мар 2012
    Сообщения:
    144
    Симпатии:
    2
    А у меня вызов DesignReplace на AIX завалил лотус
    Код (Text):
    Declare Function AIX_DesignReplace Lib "libnotes_r.a" Alias "DesignReplace" (ByVal ht As Long, ByVal hDB As Long, ByVal dw1 As Long, ByVal dw2 As Long, ByVal dw3 As Long, ByVal dw4 As Long) As Integer

    ****

    Call AIX_DesignReplace(htemplate, htarget, 1, 0, 0, 0)
     
  5. hosm

    hosm * so what *

    Регистрация:
    18 май 2009
    Сообщения:
    2.450
    Симпатии:
    7
    AIX32bit или 64bit? там могут отличаться декларации- в частности, в 64bit параметры-указатели 64bit(2 последних параметра), а Long - 32bit. Чтоб не говорить о том, что валится только недокументированная ф-ция, попробуй на своей системе рефреш запустить - если декларации неправильные, то он тоже упадет.
    >C и D кладут Lotus при изменении.
    Вероятно, там тоже указатели, как и в рефреше :)
    Видела в сети, кстати, вариант с A=1, B=1.
     
  6. proteam

    proteam Well-Known Member

    Регистрация:
    2 мар 2012
    Сообщения:
    144
    Симпатии:
    2
    Спасибо, да у меня на рефреше тоже валится. Кстати у меня AIX/64.

    прописал два последних параметра как Integer итог тот же - сервер упал
     
  7. savl

    savl Lotus team
    Lotus team

    Регистрация:
    28 окт 2011
    Сообщения:
    2.051
    Симпатии:
    146
    OKEN
    Есть подозрение что A и B являются битовыми флагами, а определенная комбинация может выставлять опции скрытия дизайна и может чего еще... А 1 и 0 тут как проверка совершенно не работают...
     
Загрузка...

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