Options (Class1.cls)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Options"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const MAX_RECENT_URL = 64
Private Const NOT_FOUND = -1

Private m_bCompleteURL As Boolean
Private m_bConvertToXML As Boolean
Private m_bUseAlways As Boolean
Private m_bUseLingo As Boolean
Private m_bStripLingo As Boolean
Private m_bAssignLIDs As Boolean
Private m_sLingoPath As String
Private m_sLingoID As String
Private m_colRecent As New Collection
Private m_colAttrib As New Collection
Private m_colAlways As New Collection
Private m_colLingo As New Collection
Private m_colBuild As New Collection

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpApplicationName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

' Loads the default variables from our private profile (INI file)
Friend Function LoadDefaults()
   ' Load list of recent URLs from INI
   LoadColl "LastURL", m_colRecent, "about:blank"
   LoadColl "CustomAttr", m_colAttrib
   
   LoadColl "AlwaysClose", m_colAlways
   ' The "Close Always" defaults
   If m_colAlways.Count = 0 Then
      m_colAlways.Add "APPLET"
      m_colAlways.Add "DIV"
      m_colAlways.Add "IFRAME"
      m_colAlways.Add "OBJECT"
      m_colAlways.Add "SCRIPT"
      m_colAlways.Add "SELECT"
      m_colAlways.Add "SPAN"
      m_colAlways.Add "TABLE"
      m_colAlways.Add "TD"
      m_colAlways.Add "TEXTAREA"
      m_colAlways.Add "TITLE"
      m_colAlways.Add "TR"
   End If
   
   LoadColl "LingoAttr", m_colLingo
   ' The "Lingo-izeable" defaults
   If m_colLingo.Count = 0 Then
      m_colLingo.Add "ACCESSKEY"
      m_colLingo.Add "ALT"
      m_colLingo.Add "TITLE"
      m_colLingo.Add "VALUE"
   End If
   
   ' The list of "build projects"
   LoadColl "BuildProj", m_colBuild
   If m_colBuild.Count = 0 Then
      m_colBuild.Add "C|Convert Source|C:\Source|C:\Destination|lingo.xml|True"
   End If
   
   ' Load boolean options
   m_bCompleteURL = LoadBool("CompleteURL", "0")
   m_bConvertToXML = LoadBool("ConvertToXML", "1")
   m_bUseAlways = LoadBool("UseAlwaysTags", "1")
   m_bUseLingo = LoadBool("UseLingoFile", "0")
   m_bAssignLIDs = LoadBool("AssignLIDs", "0")
   m_bStripLingo = LoadBool("StripLingoText", "0")
   m_sLingoPath = LoadString("LingoFilePath")
   m_sLingoID = LoadString("LingoIDAttrib", "_locID")
End Function

' Saves the default variables to our private profile (INI file)
Friend Function SaveDefaults()
    Dim Result As Long, Count As Long
    
   ' Save list of recent URLs to INI
   For Count = 0 To m_colRecent.Count - 1
      Result = WritePrivateProfileString("LastURL", "LastURL" & Count, CStr(m_colRecent.item(Count + 1)), "HXML.INI")
      Debug.Assert Result = 1
   Next
   
   ' Save list of custom attributes to INI
   DeleteSection "CustomAttr"
   For Count = 0 To m_colAttrib.Count - 1
      Result = WritePrivateProfileString("CustomAttr", "CustomAttr" & Count, CStr(m_colAttrib.item(Count + 1)), "HXML.INI")
      Debug.Assert Result = 1
   Next
   
   ' Save list of custom attributes to INI
   DeleteSection "CloseAlways"
   For Count = 0 To m_colAlways.Count - 1
      Result = WritePrivateProfileString("AlwaysClose", "AlwaysClose" & Count, CStr(m_colAlways.item(Count + 1)), "HXML.INI")
      Debug.Assert Result = 1
   Next
   
   ' Save list of custom attributes to INI
   DeleteSection "LingoAttr"
   For Count = 0 To m_colLingo.Count - 1
      Result = WritePrivateProfileString("LingoAttr", "LingoAttr" & Count, CStr(m_colLingo.item(Count + 1)), "HXML.INI")
      Debug.Assert Result = 1
   Next
   
   ' Save list of custom attributes to INI
   DeleteSection "BuildProj"
   For Count = 0 To m_colBuild.Count - 1
      Result = WritePrivateProfileString("BuildProj", "BuildProj" & Count, CStr(m_colBuild.item(Count + 1)), "HXML.INI")
      Debug.Assert Result = 1
   Next
   
   ' Save boolean options
   Result = WritePrivateProfileString("Options", "CompleteURL", CStr(IIf(m_bCompleteURL, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "ConvertToXML", CStr(IIf(m_bConvertToXML, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "UseAlwaysTags", CStr(IIf(m_bUseAlways, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "UseLingoFile", CStr(IIf(m_bUseLingo, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "StripLingoText", CStr(IIf(m_bStripLingo, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "AssignLIDs", CStr(IIf(m_bAssignLIDs, "1", "0")), "HXML.INI")
   Debug.Assert Result = 1
   
   ' Save string settings
   Result = WritePrivateProfileString("Options", "LingoFilePath", m_sLingoPath, "HXML.INI")
   Debug.Assert Result = 1
   Result = WritePrivateProfileString("Options", "LingoIDAttrib", m_sLingoID, "HXML.INI")
   Debug.Assert Result = 1
End Function

Private Function LoadBool(ByVal Key As String, Optional ByVal Default As String = "1") As Boolean
   Dim szBool As String, Length As Long
   ' Load boolean options
   szBool = String$(6, Chr(0))
   Length = GetPrivateProfileString("Options", Key, Default, szBool, 5, "HXML.INI")
   LoadBool = IIf(Left(szBool, 1) = "1", True, False)
   ' Also accept "true" as valid
   If Not LoadBool Then LoadBool = IIf(LCase(szBool) = "true", True, False)
End Function

Private Sub LoadColl(ByVal Key As String, ByRef coll As Collection, Optional ByVal Default As String)
   Dim szVal As String, Length As Long
   ' Load collection
   szVal = String$(256, Chr(0))
   Length = GetPrivateProfileString(Key, Key & "0", Default, szVal, 255, "HXML.INI")
   Do While Length > 0
      szVal = Left(szVal, Length)
      coll.Add szVal
      szVal = String$(256, Chr(0))
      Length = GetPrivateProfileString(Key, Key & coll.Count, Chr(0), szVal, 255, "HXML.INI")
   Loop
End Sub

Private Function LoadString(ByVal Key As String, Optional ByVal Default As String)
   Dim szStr As String, Length As Long
   szStr = String$(256, Chr(0))
   Length = GetPrivateProfileString("Options", Key, Default, szStr, 255, "HXML.INI")
   szStr = Left$(szStr, Length)
   LoadString = szStr
End Function

Private Sub DeleteSection(ByVal Key As String)
   Dim Result As Long, NullList As String
   NullList = Chr(0) & Chr(0)
   Result = WritePrivateProfileSection(Key, NullList, "HXML.INI")
   Debug.Assert Result <> 0
End Sub

Friend Property Get CompleteURL() As Boolean
   CompleteURL = m_bCompleteURL
End Property

Friend Property Let CompleteURL(ByVal RHS As Boolean)
   m_bCompleteURL = RHS
End Property

Friend Property Let ConvertToXML(ByVal RHS As Boolean)
   m_bConvertToXML = RHS
End Property

Friend Property Get ConvertToXML() As Boolean
   ConvertToXML = m_bConvertToXML
End Property

Friend Property Let UseAlwaysTags(ByVal RHS As Boolean)
   m_bUseAlways = RHS
End Property

Friend Property Get UseAlwaysTags() As Boolean
   UseAlwaysTags = m_bUseAlways
End Property

Friend Property Let UseLingoFile(ByVal RHS As Boolean)
   m_bUseLingo = RHS
End Property

Friend Property Get UseLingoFile() As Boolean
   UseLingoFile = m_bUseLingo
End Property

Friend Property Let StripLingoText(ByVal RHS As Boolean)
   m_bStripLingo = RHS
End Property

Friend Property Get StripLingoText() As Boolean
   StripLingoText = m_bStripLingo
End Property

Friend Property Let AssignLIDs(ByVal RHS As Boolean)
   m_bAssignLIDs = RHS
End Property

Friend Property Get AssignLIDs() As Boolean
   AssignLIDs = m_bAssignLIDs
End Property

Friend Property Let LingoFilePath(ByVal RHS As String)
   m_sLingoPath = RHS
End Property

Friend Property Get LingoFilePath() As String
   LingoFilePath = m_sLingoPath
End Property

Friend Property Let LingoIDAttrib(ByVal RHS As String)
   m_sLingoID = RHS
End Property

Friend Property Get LingoIDAttrib() As String
   LingoIDAttrib = m_sLingoID
End Property

' === MRU List for URLs

Friend Sub AddRecentURL(URL As String)
   Dim idx As Integer
   idx = FindExactURL(URL)
   If idx > NOT_FOUND Then
      ' Only move if entry is not already the MRU
      If idx > 0 Then
         ' Move existing entry to top of the list
         m_colRecent.Add URL, , 1
         m_colRecent.Remove idx + 1
      End If
   Else
      ' Add entry, drop last entry (MAX_RECENT_URL)
      If m_colRecent.Count > 0 Then
         m_colRecent.Add URL, , 1
      Else
         m_colRecent.Add URL
      End If
      If MAX_RECENT_URL <= m_colRecent.Count Then
         m_colRecent.Remove MAX_RECENT_URL
      End If
   End If
End Sub

Friend Function GetRecentURL(ByVal Index As Long) As String
   Debug.Assert Index > 0
   GetRecentURL = m_colRecent.item(Index)
End Function

Friend Property Get RecentURLCount() As Long
   RecentURLCount = m_colRecent.Count
End Property

Friend Sub RemoveRecentURLs()
   Set m_colRecent = Nothing
   Set m_colRecent = New Collection
End Sub

Private Function FindNextURL(szURL) As Integer
   Dim i As Integer
   FindNextURL = NOT_FOUND
   For i = 1 To m_colRecent.Count
      If Left(m_colRecent.item(i), Len(szURL)) = szURL Then
         FindNextURL = i
         Exit For
      End If
   Next
End Function

Private Function FindExactURL(szURL) As Integer
   Dim i As Integer, szMatch
   szMatch = LCase(szURL)
   FindExactURL = NOT_FOUND
   For i = 1 To m_colRecent.Count
      If LCase(m_colRecent.item(i)) = szMatch Then
         FindExactURL = i
         Exit For
      End If
   Next
End Function

' === List of Custom Attributes

Friend Sub AddCustomAttribute(attrib As String)
   m_colAttrib.Add attrib
End Sub

Friend Function GetCustomAttribute(ByVal Index As Long) As String
   Debug.Assert Index >= 0
   If Index = 0 Then
      GetCustomAttribute = m_sLingoID
   Else
      GetCustomAttribute = m_colAttrib.item(Index)
   End If
End Function

Friend Property Get CustomAttributeCount() As Long
   CustomAttributeCount = m_colAttrib.Count
End Property

Friend Sub RemoveCustomAttributes()
   Set m_colAttrib = Nothing
   Set m_colAttrib = New Collection
End Sub

' === List of "Always Close" tags

Friend Sub AddAlwaysCloseTag(attrib As String)
   m_colAlways.Add attrib
End Sub

Friend Function GetAlwaysCloseTag(ByVal Index As Long) As String
   Debug.Assert Index > 0
   GetAlwaysCloseTag = m_colAlways.item(Index)
End Function

Friend Property Get AlwaysCloseTagCount() As Long
   AlwaysCloseTagCount = m_colAlways.Count
End Property

Friend Sub RemoveAlwaysCloseTags()
   Set m_colAlways = Nothing
   Set m_colAlways = New Collection
End Sub

Friend Function IsAlwaysTag(tagName As String)
   Dim tag As Variant, tagMatch As String
   tagMatch = LCase(tagName)
   For Each tag In m_colAlways
      If tagMatch = LCase(CStr(tag)) Then
         IsAlwaysTag = True
         Exit Function
      End If
   Next
   IsAlwaysTag = False
End Function

' === List of "Lingo-izeable" attributes and tags

Friend Sub AddLingoTag(attrib As String)
   m_colLingo.Add attrib
End Sub

Friend Function GetLingoTag(ByVal Index As Long) As String
   Debug.Assert Index > 0
   GetLingoTag = m_colLingo.item(Index)
End Function

Friend Property Get LingoTagCount() As Long
   LingoTagCount = m_colLingo.Count
End Property

Friend Sub RemoveLingoTags()
   Set m_colLingo = Nothing
   Set m_colLingo = New Collection
End Sub

Friend Function IsLingoTag(tagName As String)
   Dim tag As Variant, tagMatch As String
   tagMatch = LCase(tagName)
   For Each tag In m_colLingo
      If tagMatch = LCase(CStr(tag)) Then
         IsLingoTag = True
         Exit Function
      End If
   Next
   IsLingoTag = False
End Function

' === List of Build Projects

Friend Sub AddProject(item As BuildListItem)
   Dim projInfo As String
   projInfo = IIf(item.ProjectType = prjBuild, "B", "C") & "|" & _
              item.name & "|" & item.SourceDir & "|" & _
              item.DestinationDir & "|" & item.LingoFile & "|" & _
              CStr(item.Enabled)
   m_colBuild.Add projInfo
End Sub

Friend Function GetProject(ByVal Index As Long) As BuildListItem
   Debug.Assert Index > 0
   Dim item As New BuildListItem
   Dim projInfo() As String
   projInfo = Split(m_colBuild.item(Index), "|")
   Debug.Assert UBound(projInfo) = 5
   item.ProjectType = IIf(projInfo(0) = "C", prjConvert, prjBuild)
   item.name = projInfo(1)
   item.SourceDir = projInfo(2)
   item.DestinationDir = projInfo(3)
   item.LingoFile = projInfo(4)
   item.Enabled = CBool(projInfo(5))
   Set GetProject = item
End Function

Friend Property Get ProjectCount() As Long
   ProjectCount = m_colBuild.Count
End Property

Friend Sub RemoveProjects()
   Set m_colBuild = Nothing
   Set m_colBuild = New Collection
End Sub