VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Anchors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Collection" ,"Anchor"
Attribute VB_Ext_KEY = "Member0" ,"Anchor"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'local variable to hold collection
Private mCol As Collection
Public Function Add(Optional sKey As String) As Anchor
'create a new object
Dim objNewMember As Anchor
Set objNewMember = New Anchor
'set the properties passed into the method
objNewMember.Index = mCol.Count + 1
If Len(sKey) = 0 Then
mCol.Add objNewMember
Else
mCol.Add objNewMember, sKey
End If
'return the object created
Set Add = objNewMember
Set objNewMember = Nothing
End Function
Public Property Get Item(vntIndexKey As Variant) As Anchor
Attribute Item.VB_UserMemId = 0
'used when referencing an element in the collection
'vntIndexKey contains either the Index or Key to the collection,
'this is why it is declared as a Variant
'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
'used when retrieving the number of elements in the
'collection. Syntax: Debug.Print x.Count
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
'used when removing an element from the collection
'vntIndexKey contains either the Index or Key, which is why
'it is declared as a Variant
'Syntax: x.Remove(xyz)
Dim i As Integer
mCol.Remove vntIndexKey
For Each xobj In mCol
i = i + 1
xobj.Index = i
Next
End Sub
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
'this property allows you to enumerate
'this collection with the For...Each syntax
Set NewEnum = mCol.[_NewEnum]
End Property
Private Sub Class_Initialize()
'creates the collection when this class is created
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
'destroys collection when this class is terminated
Set mCol = Nothing
End Sub
Public Sub CompileList(strData As String)
Dim anchorOpenBegin As Long
Dim anchorOpenEnd As Long
Dim anchorCloseBegin As Long
Dim anchorCloseEnd As Long
Dim anchorbody As String
Dim Splitter As Variant
Dim splitter1 As Variant
Dim xCol As Collection
Dim xa As Anchor
anchorOpenBegin = InStr(1, strData, " 0
Set xa = New Anchor
xa.Index = mCol.Count + 1
anchorOpenEnd = InStr(anchorOpenBegin, strData, ">")
anchorbody = Mid(strData, anchorOpenBegin, anchorOpenEnd - anchorOpenBegin)
Splitter = Split(anchorbody, " ")
For i = 0 To UBound(Splitter)
If InStr(1, Splitter(i), "=") Then
splitter1 = Split(Splitter(i), "=", 2)
If splitter1(0) = "href" Then
xa.link = Replace(splitter1(1), Chr(34), "")
xa.NamePositionStart = InStr(anchorOpenBegin, strData, "href") + 6 ' 6 - href="
xa.NamePositionEnd = xa.NamePositionStart + Len(xa.link)
End If
End If
Next
anchorCloseBegin = InStr(anchorOpenEnd, strData, "", strData)
xa.TitlePositionStart = anchorOpenEnd + 1
xa.TitlePositionEnd = anchorCloseBegin
anchorbody = Mid(strData, xa.TitlePositionStart, xa.TitlePositionEnd - xa.TitlePositionStart)
xa.Title = anchorbody
mCol.Add xa
DoEvents
anchorOpenBegin = InStr(anchorOpenBegin + 1, strData, " 0
Set xa = New Anchor
anchorOpenEnd = InStr(anchorOpenBegin, strData, ">")
If anchorOpenEnd = 0 Then GoTo zzz
anchorbody = Mid(strData, anchorOpenBegin, anchorOpenEnd - anchorOpenBegin)
Splitter = Split(anchorbody, " ")
For i = 0 To UBound(Splitter)
If InStr(1, Splitter(i), "=") Then
splitter1 = Split(Splitter(i), "=", 2)
If LCase(splitter1(0)) = "href" Then
xa.link = Replace(splitter1(1), Chr(34), "")
End If
End If
Next
anchorCloseBegin = InStr(anchorOpenEnd, LCase(strData), "")
End If
mvarTitlePositionStart = anchorOpenEnd + 1
mvarTitlePositionEnd = anchorCloseBegin
anchorbody = Mid(strData, mvarTitlePositionStart, mvarTitlePositionEnd - mvarTitlePositionStart)
xa.Title = anchorbody
zz:
anchorOpenBegin = InStr(anchorOpenBegin + 1, LCase(strData), "-->