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