非常有用的Lotus Script

[Zerotm]

今天心情比较好（中秋节了），现决定每天发放一段经典代码，节假日每日2段。
9月11日（中秋节）代码：

Function getQSTR(QuerySTR As String,StrFrom As String,StrTo As String) As String

' 功能 在QuerySTR中截取从StrFrom到StrTo的字符串
'
' 传入变量说明
' QuerySTR: 原字符串
' StrFrom: 开始截取的字符串（不区分大小写）
' StrTo: 结束的字符串（不区分大小写）

'返回值:
' 返回QuerySTR中从StrFrom到StrTo的字符串。（实例1）
' 如果StrFrom不在QuerySTR中，则返回空（实例2）
' 如果StrTo不在QuerySTR中，则返回从StrFrom到最右边所有的字符（实例3）


'实例1:getQSTR("Hello boy!","El","B") 返回 "lo"
'实例2:getQSTR("Hello boy!","x","B") 返回 ""
'实例3:getQSTR("Hello boy!","El","x") 返回 "lo boy!"

If Instr(Ucase(QuerySTR),Ucase(StrFrom))<>0 Then
tmpstr = Right(QuerySTR,Len(QuerySTR)-Instr(Ucase(QuerySTR),Ucase(STRFrom))-Len(STRFrom)+1)
If strTo<>"" And Instr(Ucase(tmpstr),Ucase(StrTo))<>0 Then
getQSTR = Left(tmpstr,Instr(Ucase(tmpstr),Ucase(StrTo))-1)
Else
getQSTR = tmpstr
End If
Else
getQSTR = ""
End If

End Function

[Zerotm]

9月13日（没什么特别的日子）代码：
Function GetDBPath(db As NotesDatabase)

' 功能 得到数据库路径

' db Notes数据库

' 返回值：Web浏览器能正确识别的数据库的路径。

Dim tmpPath As String
tmpPath = db.filepath
'如果数据库不在第一层目录下，则要将所有的"\"都转成"/"，否则浏览器不能识别
Do While Instr(tmpPath,"\") > 0
tmpPath = Left$(tmpPath, Instr(tmpPath,"\")-1) + "/" + Right$(tmpPath,Len(tmpPath)-Instr(tmpPath,"\"))
Loop

'将所有的" "都转成"+"，否则浏览器不能识别
Do While Instr(tmpPath," ") > 0
tmpPath = Left$(tmpPath, Instr(tmpPath," ")-1) + "+" + Right$(tmpPath,Len(tmpPath)-Instr(tmpPath," "))
Loop

GetDbPath = tmpPath
End Function

[Zerotm]

有半年以上开发经历的人都应该会写以上的代码吧，所以今天的这段代码主要是写给刚接触LotusScript的人，主要是因为有人用短信告知，希望我能：“由基本开始，否则学的人只会借用，不能及时吸收知识。”

[jhlqab]

这里的大虾可真多。HOHO。偶也来顶一下。

[xiajiatou]

webmailer(亓峰) ,Zerotm (悠久金星) 两位能同台献技，实在难得！呵呵

[alian1982413]

谢谢指教啊！
我试试啊！我搞不定在找你哦！◎

[alian1982413]

我想问一下你那个delete多值域是什么意思啊◎
域的类型是什么啊？？
改过了，还是不行！不过代理可以用的，我想是不是那个域的问题啊◎

[alian1982413]

视图的一例值“<input type=\'checkbox\' name=\'id\' value=\'"+@Text(@DocumentUniqueID)+" \' onclick=\'selectdoc()\'>”
表单中加视图，有一热点用javascript写的
if (document.forms[0].seldocs.value==''){
alert("请选择要删除的文档!");
}else{
var path=document.forms[0].mailpath.value;
var delbool=confirm("警告：此操作不可回复!\r\n是否执行此操作？");
if (delbool)
{ var s1='';
s=document.forms[0].seldocs.value;
s1=s.split(';');
k=5000;
for(i=1;i<s1.length;i++){
window.location="/"+path+"/deldocpyhsics?openagent&"+s1[i];
for(j=0;j<k;j++);
}
window.location="/"+path+"/deldocpyhsics?openagent&"+s1[i];
for(j=0;j<k;j++);
// window.location="/"+path+"/(webnewview)?openview"
// for(j=0;j<k;j++);
window.location.reload();
}
}

代理名称deldocpyhsics，写在initialize里
Sub Initialize
Dim sion As New notessession
Dim db As notesdatabase
Dim doc As notesdocument
On Error Goto msg
Set db=sion.currentdatabase
Set doc=sion.documentcontext
s=breakstr(doc.Query_String_Decoded(0),"&")
id_str=Trim(Cstr(s(1)))
Set doc=db.GetDocumentByUNID(id_str)
If (doc.Remove( True ) = False) Then
Print |<script>文档删除失败！</script>|
End If

Exit Sub
msg:
Print db.filepath+ " mvoefolder error "
Print Error()
Print Erl()

End Sub
在breakstr里写
Function breakstr (bstr As String,sep As String) As Variant
Dim i As Integer
Dim n As Integer
Dim temstr As String
Redim strlist(0) As String
tempstr = bstr
bstr = bstr + sep

While Instr(bstr,sep)
n = Instr(bstr,sep)
If i = 0 Then
strlist(i) = Left(bstr,n-1)
Else
Redim Preserve strlist(i) As String
strlist(i) = Left(bstr,n-1)
End If
i = i + 1
bstr = Right(bstr,Len(bstr)-n)
Wend
breakstr = strlist
bstr = tempstr
End Function
在replacestr_new里写
Function replacestr_new(a As String,b As String,c As String)As String
'该函数用于将A字符串中b字符串用c字符串
'-------------------参数说明-------------------------
'a为须参与改变字符的字符串
'b为需要替换的字符串
'c为用与替代的字符串
'----------------------------------------------------

Dim x As Integer
Dim y As String
Dim ystring As String
y=a
ystring=""
x=Instr(1,y,b)
If x=0 Then
replacestr_new=y
Else
While Not x=0
ystring=ystring+Left(y,x-1)+c
y=Mid(y,x+Len(b))
x=Instr(1,y,b)
Wend
replacestr_new=ystring+y
End If
End Function

这是别人的一个◎是可以用的，但在我的系统里却不能用◎
不知道为什么？？
能指教吗◎

[亓锋]

修改以便降低运行花销：
建议大家记住几个原则，这也是我以后要注意的。我在ibm internal knowledge base里看到LS专家的几个建议：

if S="" then =>> if len(S)=0 ，因为字符串的比较将花费更多的时间，内存指针会不断消耗处理器时间。

Function Implode(var As Variant,SP As String) As String

' 将数组组合成字符串
'
' var 需要组合数组
' SP 分割符
'
' 返回值 拼合后的字符串

tmp$ = ""
Forall v In var
If Trim$(v) <> "" Then
tmp$ = tmp$+SP+Cstr(v)
End If
End Forall

If Len(Trim(tmp$)) > 0 Then
tmp$ = Right(tmp$,Len(tmp$)-1)
End If

Implode = Trim$(tmp$)

End Function

执行时间比下面的程序慢44.69%

Function Implode(var As Variant,SP As String) As String
dim session as new notessession
dim doc as notesdocument
set doc = session.currentdatabase.createdocument
doc.x = var
v = evaluate(|@Implode(x;"|+SP+|")|,doc)
Implode = v(0)
end function

LS专家建议利用这种方式，使用notesdocument来evaluate一个notes公式可以替代许多的算法，因为在lotus中公式的执行代码是最终代码，而LS是中间代码。也就是公式比LS运行速度快。

同理，上面几个贴的函数大家可以试一试这样执行。

[Zerotm]

我们通常的做法是：
在视图内插入一列，列值使用公式写："[<input type=checkbox name=\"Delete\" value=\"" + @Text(@DocumentUniqueID) +"\">]"

然后做张表单，将视图嵌入表单。在表单上创建一个“Delete”的多值域。
在表单上创建个按钮，按钮使用公式：@Command([ToolsRunMacro]; "DEL")

创建个DEL的代理代码如下：
直接写在Initialize中就行了。
Dim Session As New NotesSession

Dim DB As NotesDatabase
Set DB = Session.CurrentDatabase '得到当前数据库

Dim Doc As NotesDocument
Set Doc = Session.DocumentContext '当前文档
'（注意：此时的Doc对于Agent来说仅仅是个请求，必须对Doc进行操作后才能Save）

Dim Doc_ToBeDelete As NotesDocument'待删除的临时文档

Dim Item As NotesItem

Set Item = Doc.GetFirstItem("Delete")'得到所有待删除文档的UNID


Forall v In item.Values '逐一删除
unid$ = v
Set Doc_ToBeDelete = DB.GetDocumentByUNID(unid$)
'这时的 Doc_ToBeDelete 就是即将要被删除的文档了。在它被REMOVE前可以进行任何操作。

Call Doc_ToBeDelete.Remove(True)
End Forall

[Zerotm]

To alian1982413(alian):
不知道这样做能不能解决问题？

[Zerotm]

下周二可能要出差，我会让我同事继续贴代码或解答疑问（保证每日更新）

[tuzi_zyl]

写什么程序，可读性太差了，而且一点都没有用，差强人意

[亓锋]

简直就是小儿科的程序。
我问一个：怎样用Domino输出XML?

[aalup]

up ，请发到我的邮箱[e-mail],谢谢！

[花酒]

UP

[flxa]

up

[Zerotm]

既而大家都觉得没必要，那我立即结贴！

[topfriend]

啊～～～，结贴的说了？
Zerotm(悠久金星) 再开一帖吧

[qxm]

gz

[TangJiHeDe]

群蛙