一个时间段排斥下的会议安排问题

改写了一下，通用一些
'类名：会议安排
'说明: 属性IsPointRepeat，确定时间点是否可以重复，如[1-3][3-4]
'      方法AddMeeting(lngStart,lngEnd,anyValue):lngStart开始时间，lngEnd结束时间，anyValue需要安排的具体值
'      方法GetResult()返回安排后的anyValue数组
Class CMeetingManage
 Private m_lngCount
 Private m_alngStart(),m_alngEnd(),m_aanyValue()
 Private m_ablnEnabled() '计算后，需要抛弃一些冲突项，此值用于表示记录是否可用
 Private m_blnPointRepeat

 Private Sub Class_Initialize()
  m_lngCount=0
  m_blnPointRepeat=True
 End Sub

 Private Sub Class_terminate()
  Erase m_alngStart
  Erase m_alngEnd
  Erase m_ablnEnabled
  Erase m_aanyValue
 End Sub
 
 '是否允许点重复,例如[1-2][2-3]这种情况，称为点重复
 Public Property Let IsPointRepeat(bln)
  m_blnPointRepeat=bln
 End Property

 '按照会议安排算法冲突处理，
 Private Function ConflictDispose()
  Dim i,j,k,a,b,c

  i=0
  j=i+1
  Do While j<m_lngCount 'error:j<m_lngCount-1,last value error
 '  If m_alngEnd(i) >= m_alngStart(j)   Then '存在冲突,点无重复
   If ConfilctDetect(i,j)  Then '存在冲突
    If m_alngEnd(i)<=m_alngEnd(j) Then
     '丢弃j
     m_ablnEnabled(j)=False
     j=j+1
    Else
     '丢弃i
     m_ablnEnabled(i)=False
     i=j
     j=i+1
    End If
   Else '不存在冲突,处理下一个
    i=j
    j=i+1
   End If
  Loop

 End Function

 '冲突检测
 Private Function ConfilctDetect(i,j)
  If m_blnPointRepeat Then
   ConfilctDetect=(m_alngEnd(i) >m_alngStart(j))
  Else
   ConfilctDetect=(m_alngEnd(i) >=m_alngStart(j))
  End If
 End Function

 

 '返回结果，若为空，则返回Empty
 Public Function GetResult()
  Dim i,j,k
  Dim aanyRet(),lngRetCount,blnIsObject
  lngRetCount=0
  
  Call SortByStart()
  Call ConflictDispose()

  If m_lngCount>0 Then blnIsObject=IsObject(m_aanyValue(0))
  For i=0 To m_lngCount-1
   If m_ablnEnabled(i) Then
    ReDim preserve aanyRet(lngRetCount)
    If blnIsObject Then
     Set aanyRet(lngRetCount)=m_aanyValue(i)
    Else
     aanyRet(lngRetCount)=m_aanyValue(i)
    End If
    lngRetCount=lngRetCount+1
   End If
  Next

  If lngRetCount>0 Then GetResult=aanyRet 'error:空返回错误
 End Function

 '按m_alngStart排序数组,由小到大
 Private Function SortByStart()
  '采用冒泡算法
  Dim i,j,k,intTmp1,intTmp2
  For i=m_lngCount-1 To 1 Step -1
   For j=0 To i-1
    If m_alngStart(j)>m_alngStart(j+1) Then Call SwitchMeeting(j,j+1)
   Next
  Next
 End Function

 Public Function AddMeeting(lngStart,lngEnd,anyValue)
  ReDim Preserve m_alngStart(m_lngCount)
  ReDim Preserve m_alngEnd(m_lngCount)
  ReDim preserve m_aanyValue(m_lngCount)
  ReDim preserve m_ablnEnabled(m_lngCount)
  m_alngStart(m_lngCount)=lngStart
  m_alngEnd(m_lngCount)=lngEnd
  If IsObject(anyValue) Then   '操你妈个傻VBS
   Set m_aanyValue(m_lngCount)=anyValue
  Else
   m_aanyValue(m_lngCount)=anyValue
  End If
  m_ablnEnabled(m_lngCount)=True
  m_lngCount=m_lngCount+1
 End Function

 Public Function SwitchMeeting(i,j)
  Dim lngStart,lngEnd,anyValue

  lngStart=m_alngStart(i)
  m_alngStart(i)=m_alngStart(j)
  m_alngStart(j)=lngStart

  lngEnd=m_alngEnd(i)
  m_alngEnd(i)=m_alngEnd(j)
  m_alngEnd(j)=lngEnd

  If IsObject(m_aanyValue(i)) Then
   Set anyValue=m_aanyValue(i)
   Set m_aanyValue(i)=m_annyValue(j)
   Set m_aanyValue(j)=anyValue
  Else
   anyValue=m_aanyValue(i)
   m_aanyValue(i)=m_aanyValue(j)
   m_aanyValue(j)=anyValue
  End If
 End Function

 Public Function Debug()
  Dim i,t,k
  Randomize
  For i=1 To 20
   t=CLng(100*rnd)
   k=t+clng(10*rnd)+1
   Call addMeeting(t,k,"[" & t & "-" & k & "]")
  Next
  MsgBox Join(GetResult,vbcrlf)
 End Function
End Class

====================================================================================
附录1：问题来源"日期不能交叉的检测算法(头都想痛了)"
http://topic.csdn.net/u/20080121/15/3c8733a6-fef8-46d2-9031-08d299c97dc2.html

====================================================================================
附录2：在算法区的讨论"一个时间段排斥的最多段算法"
http://topic.csdn.net/u/20080121/19/aa2e9d5c-ae95-4435-94d9-0fe0c029616c.html