Вернуться к содержанию

Вернуться к содержанию

Вернуться к содержанию

Вернуться к содержанию

Sub Click(Source As Button)
Dim cs As New NotesSession
Dim Platform$
Platform$ = cs.Platform
Dim szFileName As String*256
Dim szTitle As String
Dim szFilter As String
szFilename = Chr(0)
szTitle = "Выбор файла"
szFilter = "Notes Databases|*.NSF|" & _
"Notes Templates|*.NTF|" & _
"Программы|*.EXE|" & _
"Text Files|*.TXT|" & _
"Все файлы|*.*|" 'Use this format for ANY file type
Print Platform$
GetFile% = NEMGetFileWin32( 0, szFileName, szFilter, szTitle)
If GetFile% <> 0 Then
Messagebox szFileName
End If
End Sub

Вернуться к содержанию

Declare Sub OSMemFree Lib "nnotes.dll" (Byval hBuffer As Long)
'return string instead of long for LS type checking
Declare Function OSLockObject Lib "nnotes.dll" (Byval hBuffer As Long) As String
Declare Sub OSUnlockObject Lib "nnotes.dll" (Byval hBuffer As Long)
Declare Function NSFRemoteConsole Lib "nnotes.dll" (Byval ServerName As String, Byval ConsoleCommand As String, rethBuffer As Long) As Long

Sub Initialize
Dim hBuf As Long
Dim pBuf As String
Dim result As Long
Dim data As Variant
result = NSFRemoteConsole("Имя сервера","строка команды", hBuf)
pBuf = OSLockObject(hBuf)
print pBuf ' Выводит результат команды
Call OSUnlockObject(hBuf)
Call OSMemFree(hBuf)
End Sub

Вернуться к содержанию

Dim session As New NotesSession
Dim db As NotesDatabase
Dim acl As NotesACL
ser=Inputbox$("Введите имя сервера")
dbs=Inputbox$("Введите имя базы")
Set db = New NotesDatabase( ser, dbs )
If db.Title="" Then
ak=Msgbox( "Не найдена база, повторите попытку!", ,"Внимание")
Exit Sub
End If
Set db1 = session.CurrentDatabase
Set acl = db.ACL
Set acl1 = db1.ACL
Forall r In acl.Roles
per1=Msgbox( "Добавить роль - "+Cstr(r) +" - в текущую базу?",1, "Внимание")
If per1=1 Then
Call acl1.AddRole( r )
End If
End Forall
Call acl1.Save

Вернуться к содержанию

Dim session As New NotesSession
Dim db As NotesDatabase
Dim acl As NotesACL
Dim parentACL As NotesACL
Dim entry As NotesACLEntry
Dim mas(5)
Dim mas1(6)
mas(0)="UNSPECIFIED"
mas(1)="PERSON"
mas(2)="SERVER"
mas(3)="MIXED_GROUP"
mas(4)="PERSON_GROUP"
mas(5)="SERVER_GROUP"

mas1(0)="NOACCESS"
mas1(1)="DEPOSITOR"
mas1(2)="READER"
mas1(3)="AUTHOR"
mas1(4)="EDITOR"
mas1(5)="DESIGNER"
mas1(6)="MANAGER"
Stop
Set db = session.CurrentDatabase
Set acl = db.ACL
Set entry = acl.GetFirstEntry
fileNum% = Freefile()
fileName$ = "c:\acl.txt"
Open fileName$ For Output As fileNum%
While Not ( entry Is Nothing )
per=entry.Name
per3=entry.Level
per4=entry.UserType
Set notesName = New NotesName( per )
per=notesName.Abbreviated
per1=entry.Roles
per2=""
For r=0 To Ubound(per1)
per2=per2+"-"+per1(r)
Next
Write #fileNum%, Cstr(per)+" *{"+mas(per4)+"}*"+" *{"+mas1(per3)+"}
* "+per2
Set entry = acl.GetNextEntry( entry )
Wend
Close fileNum%

Вернуться к содержанию

Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim acl As NotesACL
Dim entry As NotesACLEntry
ser=Inputbox$("Введите имя сервера")
dbs=Inputbox$("Введите имя базы")
Set db = New NotesDatabase( ser, dbs )
If db.Title="" Then
ak=Msgbox( "Не найдена база, повторите попытку!", ,"Внимание")
Exit Sub
End If
Set db1 = session.CurrentDatabase
Set acl = db.ACL
Set acl1 = db1.ACL
Forall r In acl1.Roles
fl="0"
Forall r2 In acl.Roles
If r2=r Then
fl="1"
End If

End Forall
If fl<>"1" Then
Call acl.AddRole( r )
End If
End Forall
Call acl.Save
Dim mas(5)
Dim mas1(6)
mas(0)="UNSPECIFIED"
mas(1)="PERSON"
mas(2)="SERVER"
mas(3)="MIXED_GROUP"
mas(4)="PERSON_GROUP"
mas(5)="SERVER_GROUP"

mas1(0)="NOACCESS"
mas1(1)="DEPOSITOR"
mas1(2)="READER"
mas1(3)="AUTHOR"
mas1(4)="EDITOR"
mas1(5)="DESIGNER"
mas1(6)="MANAGER"

Set entry = acl1.GetFirstEntry
While Not ( entry Is Nothing )
per=entry.Name
Set notesName = New NotesName( per )
per=notesName.Abbreviated
Set entry1 = acl.GetEntry( per )
If entry1 Is Nothing Then
Set entry1= acl.CreateACLEntry ( per, entry.Level )
End If
entry1.Level =entry.Level
entry1.UserType = entry.UserType
per1=entry.Roles
If per1(0)<>"" Then
For r1=0 To Ubound(per1)
Call entry1.EnableRole( per1(r1) )
Next
End If
entry1.CanCreateDocuments = entry.CanCreateDocuments
entry1.CanDeleteDocuments =entry.CanDeleteDocuments
entry1.CanCreateLSOrJavaAgent=entry.CanCreateLSOrJavaAgent
entry1.CanCreatePersonalAgent =entry.CanCreatePersonalAgent
entry1.CanCreatePersonalFolder =entry.CanCreatePersonalFolder
entry1.CanCreateSharedFolder =entry.CanCreateSharedFolder
entry1.CanReplicateOrCopyDocuments =entry.CanReplicateOrCopyDocuments
entry1.IsPublicWriter=entry.IsPublicWriter
entry1.IsPublicReader=entry.IsPublicReader
Call acl.Save
Set entry = acl1.GetNextEntry( entry )

Wend
End Sub

Вернуться к содержанию

(Declaration)
Dim Gper

Sub Postopen(Source As Notesuidocument)
Gper="0"
End Sub

Sub Querysave(Source As Notesuidocument, Continue As Variant)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument, doc1 As NotesDocument
Dim db As NotesDatabase
Dim unid As String
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Unid = doc.UniversalID
Set db = doc.ParentDatabase
mas=doc.GetItemValue("$Revisions")
per=mas(Ubound(mas))
Delete doc
Set doc1 = db.GetDocumentByUNID( Unid )
mas1=doc1.GetItemValue("$Revisions")
per1=mas1(Ubound(mas1))
If per<>per1 And Gper="0" Then
mes="Во время редактирования документ был пересохранен другим
пользователем"+Chr(13)+"Необходимо выйти из документа без сохранения, и повторно
отредактировать документ"
ss=Messagebox( mes,0,"Внимание")
Continue=False
Exit Sub
End If
Gper="1"
End Sub

Вернуться к содержанию

(Declaration)
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_BROWSEINCLUDEFILES = &H1 Or &H4000
Const BIF_BROWSEFORCOMPUTER = &H1000
Const BIF_BROWSEFORPRINTER = &H2000
Const MAX_PATH = 260
Declare Sub CoTaskMemFree Lib "ole32.dll" (Byval hMem As Long)
Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (Byval lpString1 As String,
Byval lpString2 As String) As Long
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (Byval pidList As Long, Byval
lpBuffer As String) As Long

Function fBrowseForFolder(hWndOwner As Long, sPrompt As String, WhatBr) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
udtBI.hWndOwner = hWndOwner
udtBI.lpszTitle = lstrcat(sPrompt, "Выберите папку")
udtBI.ulFlags = WhatBr
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath =String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = Instr(sPath, Chr(0))
If iNull Then sPath = Left$(sPath, iNull - 1)
End If
fBrowseForFolder = sPath
End Function

Sub Click(Source As Button)
Dim hWnd As Long
'вместо входящего параметра BIF_RETURNONLYFSDIRS можно использовать одну из
'BIF-констант, описанных в Declarations)
path = fBrowseForFolder(hWnd, "", BIF_RETURNONLYFSDIRS)
End Sub

Вернуться к содержанию

(Declaration)
Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (Byval pwszKLID As String, Byval flags As Long) As Integer
Private Const KLF_ACTIVATE = 1

Sub Click(Source As Button)
SetLanguage ("R")
' SetLanguage ("E")
End Sub

Sub SetLanguage(Byval s As String)
Select Case Ucase(Left(s, 1))
Case "R"
LoadKeyboardLayout "00000419", KLF_ACTIVATE
Case "U"
LoadKeyboardLayout "00000422", KLF_ACTIVATE
Case "E"
LoadKeyboardLayout "00000409", KLF_ACTIVATE
Case Else
End Select
End Sub

Вернуться к содержанию