LotusScript常用集合操作函数

ListToArray() ListToArray(srcList List As String,dstArray() As String)
   On Error Goto errmsg
   ''''''''''''''''''''''''''''''''''''''''''''''''
   '程序名：ListToArray
   '设计者：wnight88
   '功    能：将列表转化为数组
   ''''''''''''''''''''''''''''''''''''''''''''''''
    
   Dim i As Integer
  i = 0
    
  ForAll tempValue In srcList
     If tempValue <> "" Then
       ReDim Preserve dstArray(i)
      dstArray(i) = tempValue
      i = i + 1
     End If
   End ForAll
    
   Exit sub
errmsg:
   If Cstr(Erl) = "0" Then
    Msgbox "tools.txt中的子程序(ListToArray)成功执行完毕！"
   Else
    Msgbox "tools.txt中的子程序(ListToArray)出错..出错行数为:" & Cstr

(Erl) & "行！错误原因为:" & Error
   End If
End Sub

ArrayToList() ArrayToList(srcArray As Variant,dstList List As String)
   On Error Goto errmsg
   ''''''''''''''''''''''''''''''''''''''''''''''''
   '程序名：ArrayToList
   '设计者：wnight88
   '功    能：将数组转换为列表
   ''''''''''''''''''''''''''''''''''''''''''''''''    
   Dim i As Integer
  i = 0
    
  ForAll tempValue In srcArray
     If tempValue <> "" Then
      dstList(i) = tempValue
      i = i + 1
     End If
   End ForAll
    
   Exit sub
errmsg:
   If Cstr(Erl) = "0" Then
    Msgbox "tools.txt中的子程序(ArrayToList)成功执行完毕！"
   Else
    Msgbox "tools.txt中的子程序(ArrayToList)出错..出错行数为:" & Cstr

(Erl) & "行！错误原因为:" & Error
   End If
End Sub

getFilePath() getFilePath()
   On Error Goto errmsg
   ''''''''''''''''''''''''''''''''''''''''''''''''
   '程序名：getFilePath
   '设计者：wnight88
   '功    能：获取当前数据库路径，前后不带"/"和"\"
   ''''''''''''''''''''''''''''''''''''''''''''''''
   Dim s As New NotesSession
   Dim db As NotesDatabase
    
   Dim FilePath As String
   Set db = s.CurrentDatabase
  Msgbox Len(db.FilePath) - Len(db.FilePath) - 1
  FilePath = Left(db.FilePath, Len(db.FilePath) - Len(db.FileName) - 1)
    
  getfilepath = filepath
    
   Exit Function
errmsg:
   If Cstr(Erl) = "0" Then
    Msgbox "tools.txt中的函数(getFilePath)成功执行完毕！"
   Else
    Msgbox "tools.txt中的函数(getFilePath)出错..出错行数为:" & Cstr(Erl)    

& "行！错误原因为:" & Error
   End If
End Function

SplitString() SplitString( Byval srcString As String,Symbol As String,strArray() As String)
   On Error Goto errmsg
   ''''''''''''''''''''''''''''''''''''''''''''''''
   '程序名：SplitString
   '设计者：wnight88
   '功    能：将字符串srcString以符号symbol拆分为数组strArray()
   ''''''''''''''''''''''''''''''''''''''''''''''''
    
   Redim strArray(0) As String
   Dim i As Integer
   If Instr(srcString,Symbol) > 0 Then
    srcString = srcString + Symbol
    i = 0
     Do While srcString <> ""
       Redim Preserve strArray(i)
      strArray(i) = Left(srcString, Instr(srcString,Symbol) - 1)
      srcString = Right(srcString, Len(srcString) - Instr

(srcString,Symbol) - Len(Symbol) + 1)
      i = i + 1
     Loop
   Else
    strArray(0) = srcString
   End If
    
   Exit Sub
errmsg:
   If Cstr(Erl) = "0" Then
    Msgbox "tools.txt中的子程序(SplitString)成功执行完毕！"
   Else
    Msgbox "tools.txt中的子程序(SplitString)出错..出错行数为:" & Cstr

(Erl) & "行！错误原因为:" & Error
   End If
End Sub


SortArray () SortArray (SortMe As Variant) As Variant
   On Error Goto errmsg
   ''''''''''''''''''''''''''''''''''''''''''''''''
   '程序名：SortArray
   '设计者：wnight88
   '功    能：用冒泡排序法排序数组
   ''''''''''''''''''''''''''''''''''''''''''''''''    
   Dim currentItem As Integer
   Dim nextItem As Integer
    
   Dim tmp_element As Variant
    
   For CurrentItem = 0 To UBound(SortMe)
    NextItem = CurrentItem
     Do While NextItem > 0
       If (SortMe(NextItem) > SortMe(NextItem - 1)) Then
         Exit Do
       Else
        tmp_element = SortMe(NextItem)
        SortMe(NextItem) = SortMe(NextItem-1)
        SortMe(NextItem-1) = tmp_element
       End If    
      NextItem=NextItem-1
     Loop
   Next
  SortArray = SortMe
   Exit Function
errmsg:
   If Cstr(Erl) = "0" Then
    Msgbox "tools.txt中的函数(SortArray)成功执行完毕！"
   Else
    Msgbox "tools.txt中的函数(SortArray)出错..出错行数为:" & Cstr(Erl) &    

"行！错误原因为:" & Error
   End If    
End Function

本文出自 “wnight88” 博客，转载请与作者联系！