VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CUrlHistory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'---------------------------------------------------------------------------------------
' Module    : CUrlHistory
' DateTime  : 07 mar 2006 10:44
' Author    : Joacim Andersson
' Purpose   : This class acts as the Back and Forward history of a WebBrowser
'---------------------------------------------------------------------------------------
Option Explicit

Public Enum eHistoryText
    eUrl = 0
    eTitle = 1
End Enum

Private sHistory() As String
Private nCurrentPos As Long

Public Event HistoryChanged()
Public Event PositionChanged()

Public Sub Add(ByVal sUrl As String, ByVal sTitle As String)
    'To save some memory this class only use one array to store
    'both the URL and the Title of a page, separated with a NULL char.
    nCurrentPos = nCurrentPos + 1
    ReDim Preserve sHistory(nCurrentPos)
    sHistory(nCurrentPos) = sUrl & vbNullChar & sTitle
    RaiseEvent HistoryChanged
End Sub

Public Sub Clear()
    Erase sHistory
    'When the history is empty, the current position is -1
    nCurrentPos = -1
    RaiseEvent HistoryChanged
End Sub

Public Sub GoBack(Optional ByVal nSteps As Long = 1&)
    If nCurrentPos - nSteps >= 0 And nSteps > 0 Then
        nCurrentPos = nCurrentPos - nSteps
        RaiseEvent PositionChanged
    Else
        Err.Raise vbObjectError + &H65&, "CUrlHistory::GoBack", _
         "Can't move beyond BOF or EOF"
    End If
End Sub

Public Sub GoForward(Optional ByVal nSteps As Long = 1&)
    If nSteps <= Me.ForwardCount And nSteps > 0 Then
        nCurrentPos = nCurrentPos + nSteps
        RaiseEvent PositionChanged
    Else
        Err.Raise vbObjectError + &H65&, "CUrlHistory::GoForward", _
         "Can't move beyond BOF or EOF"
    End If
End Sub

Private Sub Class_Initialize()
    'When the history is empty, the current position is -1
    nCurrentPos = -1
End Sub

Public Property Get BackCount() As Long
    'This property defaults to 0
    If nCurrentPos <> -1 Then
        BackCount = nCurrentPos
    End If
End Property

Public Property Get ForwardCount() As Long
    'This property defaults to 0
    If nCurrentPos <> -1 Then
        ForwardCount = UBound(sHistory) - nCurrentPos
    End If
End Property

Public Property Get CurrentText( _
 Optional ByVal eText As eHistoryText = eUrl) As String
    'Returns either the URL (default) or the Title of the current position
    If nCurrentPos <> -1 Then
        CurrentText = Split(sHistory(nCurrentPos), vbNullChar)(eText)
    End If
End Property

Public Property Get BackText( _
 ByVal nIndex As Long, _
 Optional ByVal eText As eHistoryText = eUrl) As String
    If nIndex > -1 And nIndex < nCurrentPos Then
        'Return the array in the reversed order, if nIndex is 0 then
        'the last visited URL/Title will be returned
        BackText = Split(sHistory(nCurrentPos - (nIndex + 1)), vbNullChar)(eText)
    Else
        Err.Raise 9 '<-Subscript out of range
    End If
End Property

Public Property Get ForwardText( _
 ByVal nIndex As Long, _
 Optional ByVal eText As eHistoryText = eUrl) As String
    If nIndex > -1 And nIndex < Me.ForwardCount Then
        ForwardText = Split(sHistory(nIndex + nCurrentPos + 1), vbNullChar)(eText)
    Else
        Err.Raise 9 '<-Subscript out of range
    End If
End Property