放出在DOMINO数据库中创建独立文档读排斥锁的方法(改一下就是编辑排斥)

sacrefies 2003-08-21 03:48:52
'文档关闭时清除锁记录
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
...全文
80 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
Intotherain1 2003-11-20
  • 打赏
  • 举报
回复
cs下的? 想知道BS下的
xiaozhigood 2003-11-19
  • 打赏
  • 举报
回复
我前一段时间也在做关于这方面的问题,功能达到了,但是没有上面老兄那么的精彩!!
有时间会学习的!
zlala 2003-11-18
  • 打赏
  • 举报
回复
ding!!!!!!!
cai_yb 2003-08-22
  • 打赏
  • 举报
回复
做个记号
tianzl 2003-08-22
  • 打赏
  • 举报
回复
也帮你顶顶吧!

先收藏,以后再研究研究!
daluoboequalto 2003-08-21
  • 打赏
  • 举报
回复
看你这么卖力,帮你顶顶吧。
sacrefies 2003-08-21
  • 打赏
  • 举报
回复
代码中使用的锁文档视图设计如下:

选择公式:SELECT @IsAvailable(SourceDocumentID)
第一列:列值是域SourceDocumentID,升序
第二列:列值是域CurrentUser
sacrefies 2003-08-21
  • 打赏
  • 举报
回复
备注:注释是一开始规划的时候写的,后来我又修改过一些代码,所以有些地方注释和代码有点不怎么匹配~

见谅~

========================================
如果想要转载,请注明是“只增笑耳原创”,呵呵~

535

社区成员

发帖
与我相关
我的任务
社区描述
企业开发 Exchange Server
社区管理员
  • 消息协作社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧