放出在DOMINO数据库中创建独立文档读排斥锁的方法(改一下就是编辑排斥)
'文档关闭时清除锁记录
Function ClearLockWhenClosingFlowdocument(FlowDocument As notesdocument, ErrorText As String) As Variant
On Error Goto errhandle
Dim continue As Variant
Dim LockDoc As notesdocument
continue = True
ErrorText = ""
'获取锁文档
continue = getLockDocument(flowdocument, LockDoc, ErrorText)
If continue Then
continue = UnLockFlowDocument(LockDoc, Errortext)
Else
'如果锁文档不存在,新建一个锁文档
continue = CreateLockdocument(flowdocument, LockDoc, Errortext)
continue = UnLockFlowDocument(Lockdoc, Errortext)
End If
ClearLockWhenClosingFlowdocument = continue
Exit Function
errhandle:
ClearLockWhenClosingFlowdocument = False
errortext = "Script 库程序 ClearLockWhenClosingFlowdocument 运行失败," & Cstr(Erl()) & ":" & Error()
Exit Function
End Function
Function GetLockDocument(FlowDocument As notesdocument, LockDocument As notesdocument, ErrorText As String) As Variant
On Error Goto errhandle
Dim db As notesdatabase
Dim view As notesview
Dim continue As Variant
continue = True
errortext = ""
Set LockDocument = Nothing
Set db = flowdocument.parentdatabase
If db Is Nothing Then
continue = False
errortext = "Script 库程序 GetLockDocument 警告:未能获得数据库"
Else
Set view = db.getview("(Lock Documents View)")
If view Is Nothing Then
continue = False
errortext = "Script 库程序 GetLockDocument 警告:未能获得锁文档视图"
Else
Set LockDocument = view.getdocumentbykey(flowdocument.universalid, True)
If lockdocument Is Nothing Then
continue = False
ErrorText = "Script 库程序 GetLockDocument 警告:未能获得锁文档"
End If
End If
End If
GetLockDocument = continue
Exit Function
errhandle:
GetLockDocument = False
Set LockDocument = Nothing
ErrorText = "Script 库程序 GetLockDocument 运行失败," & Cstr(Erl()) & ":" & Error()
Exit Function
End Function
'----------------------------------------------
'检查文档锁状态
'Database:包含锁文档的数据库
'FlowDocument:具有锁的流程文档
'ErrorText:如果运行出错,返回的错误信息
'返回值:是否文档已经被锁住
'----------------------------------------------
Function IfDocumentLocked(FlowDocument As notesdocument, ErrorText As String) As Variant
On Error Goto errhandle
Dim s As New notessession
Dim view As notesview
Dim LockDoc As notesdocument
Dim uname As notesname
Dim continue As Variant
continue = True
Errortext = ""
'获取锁文档
continue = GetLockDocument(FlowDocument, LockDoc, errortext)
'根据锁文档是否存在分支处理
If continue Then
'存在锁,返回锁定信息
If Trim(LockDoc.CurrentUser(0)) <> "" Then
continue = False
Set uname = s.createname(LockDoc.CurrentUser(0))
errortext = "用户 " & uname.abbreviated & " 正在使用该文档。" & Chr(13) & Chr(10) & "请稍後重新尝试您的操作。"
Else
'没有锁定,加锁后返回继续处理(true)
continue = LockFlowDocument(LockDoc, s.username, ErrorText)
End If
Else
'锁文档不存在,在加锁后可以继续
continue = CreateLockDocument(FlowDocument, LockDoc, ErrorText)
If continue Then
'如果加锁失败,处理应当中断
continue = LockFlowDocument(LockDoc, s.username, ErrorText)
End If
End If
IfDocumentLocked = continue
Exit Function
errhandle:
errortext = "Script 库程序 IfDocumentLocked 运行出错," & Cstr(Erl()) & ":" & Error()
IfDocumentLocked = False
Exit Function
End Function
Function UnLockFlowDocument(lockDocument As notesdocument, ErrorText As String) As Variant
On Error Goto errhandle
Dim db As notesdatabase
Dim continue As Variant
Dim lockdoc As notesdocument
continue = True
errortext = ""
Set lockdoc = lockdocument
If continue Then
Call lockdoc.replaceitemvalue("CurrentUser", "")
Call lockdoc.save(True, True)
End If
UnLockFlowDocument = continue
Exit Function
errhandle:
UnLockFlowDocument = False
errortext = "Script 库程序 UnLockFlowDocument 运行失败," & Cstr(Erl()) & ":" & Error()
Exit Function
End Function
'----------------------------------------
'使用当前用户名将流程文档锁定(更新锁文档中的锁信息)
'Database:包含锁文档的数据库
'FlowDocument:需要锁定的流程文档
'CanonicalUserName:锁定流程文档的用户名(标准全层次结构名称)
'ErrorText:如果运行出错,返回的错误信息
'返回值:锁定是否成功
'
'Jason 2003.08.05
'----------------------------------------
Function LockFlowDocument(LockDocument As notesdocument, Byval CanonicalUserName As String, ErrorText As String) As Variant
On Error Goto errhandle
Dim continue As Variant
continue = True
errortext = ""
Call LockDocument.replaceitemvalue("CurrentUser", CanonicalUserName)
continue = LockDocument.save(True, True)
LockFlowDocument = continue
Exit Function
errhandle:
errortext = "Script 库程序 LockFlowDocument 运行出错:" & Cstr(Erl()) & ":" & Error()
LockFlowDocument = False
Exit Function
End Function
'----------------------------------------
'使用当前用户名将流程文档锁定(更新锁文档中的锁信息)
'Database:包含锁文档的数据库
'FlowDocument:需要锁定的流程文档
'CanonicalUserName:锁定流程文档的用户名(标准全层次结构名称)
'ErrorText:如果运行出错,返回的错误信息
'返回值:锁定是否成功
'
'Jason 2003.08.05
'----------------------------------------
Function LockFlowDocument(LockDocument As notesdocument, Byval CanonicalUserName As String, ErrorText As String) As Variant
On Error Goto errhandle
Dim continue As Variant
continue = True
errortext = ""
Call LockDocument.replaceitemvalue("CurrentUser", CanonicalUserName)
continue = LockDocument.save(True, True)
LockFlowDocument = continue
Exit Function
errhandle:
errortext = "Script 库程序 LockFlowDocument 运行出错:" & Cstr(Erl()) & ":" & Error()
LockFlowDocument = False
Exit Function
End Function
'-----------------------------------------
'为一个需要锁的流程文档创建一个锁文档
'Database: 锁文档所在数据库
'FlowDocument: 流程文档
'LockDocument: 返回创建的锁文档
'ErrorText: 如果创建过程中出现错误,返回的错误信息
'Return: 创建锁文档是否成功
'
'Jason 2003.08.05
'-----------------------------------------
Function CreateLockDocument(FlowDocument As notesdocument, LockDocument As notesdocument, ErrorText As String) As Variant
On Error Goto errhandle
Dim continue As Variant
Dim lockDoc As notesdocument
Dim db As notesdatabase
continue = True
ErrorText = ""
'LockDocUniqueID = ""
Set LockDocument = Nothing
Set db = flowdocument.parentdatabase
If Db Is Nothing Then
continue = False
ErrorText = "Script 库程序 CreateLockDocument 警告:没有获得创建锁文档所在的数据库。"
Else
If FlowDocument Is Nothing Then
continue = False
ErrorText = "Script 库程序 CreateLockDocument 警告:没有获得需要加锁的文档。"
Else
Set lockDocument = Db.createdocument()
If lockDocument Is Nothing Then
continue = False
ErrorText = "Script 库程序 CreateLockDocument 警告:创建锁文档失败。"
Else
Call lockDocument.replaceitemvalue("SourceDocumentID", FlowDocument.universalID)
Call lockDocument.save(True, True)
End If
End If
End If
CreateLockDocument = continue
Exit Function
errhandle:
ErrorText = "Script 库程序 CreateLockDocument 运行出错," & Cstr(Erl()) & ":" & Error()
CreateLockDocument = False
'LockDocUniqueID = ""
Exit Function
End Function
=======================================
在QUERYOPEN的时候使用IFDocumentLocked
在queryClose的时候使用ClearLockWhenClosingFlowdocument