function Assigned(AObject)
  Assigned = IsValidObject(AObject)
end function

function BoolToStr(ABoolean)
  if VarType(ABoolean) = vbBoolean then
    if ABoolean then
      BoolToStr = "1"
    else
      BoolToStr = "0"
    end if
  else
    BoolToStr = "0"
  end if
end function

function CancelRightClick
  if Window.Event.Button = 2 then
    Window.Event.CancelBubble = True
    Window.Event.ReturnValue = False
    CancelRightClick = False
  end if
end function

sub CenterHTMLObject(AObject)
  if IsValidObject(AObject) then
    AObject.Style.Left = (ClientWidth - GetControlWidth(AObject)) / 2
    AObject.Style.Top = (ClientHeight - GetControlHeight(AObject)) / 2
  end if  
end sub

sub ChangeVMLFillColor(AVMLButton, AColor)
  AVMLButton.Style.Visibility = "hidden"   'Note: For some reason you need to do this otherwise it doesn't update. Look into it
  AVMLButton.Fillcolor = AColor  
  AVMLButton.Style.Visibility = "visible"  'Note: For some reason you need to do this otherwise it doesn't update. Look into it
end sub

sub ChangeVMLFontColor(AVMLButton, AColor)
  AVMLButton.Style.Color = AColor
end sub

function ClientHeight
  Err.Clear
  on error resume next
  ClientHeight = Document.Body.ClientHeight
  if not IsEmptyStr(Err.Description) or (ClientHeight = 0) then
    ClientHeight = Screen.AvailHeight
  end if
end function

function ClientWidth
  Err.Clear
  on error resume next
  ClientWidth = Document.Body.ClientWidth
  if not IsEmptyStr(Err.Description) or (ClientWidth = 0) then
    ClientWidth = Screen.AvailWidth
  end if
end function

function CollectionToList(Collection)
  set CollectionToList = new clsList
  
  dim li
  for li = 0 to Collection.Length-1
    CollectionToList.Add(Collection.Item(li))
  next
end function

function ControlTypeToInteger(AControlType)
  'XXX: change this to use array
  select case AControlType
    case uctNonCbt
      ControlTypeToInteger = "0"
    case uctEdit
      ControlTypeToInteger = "1"
    case uctButton
      ControlTypeToInteger = "2"
    case uctCheck
      ControlTypeToInteger = "3"
    case uctCombo
      ControlTypeToInteger = "4"
    case uctHotSpot
      ControlTypeToInteger = "5"
    case uctLabel
      ControlTypeToInteger = "6"
    case uctMenu
      ControlTypeToInteger = "7"
    case uctRadio
      ControlTypeToInteger = "8"
    case uctTab
      ControlTypeToInteger = "9"
    case uctPEntry
      ControlTypeToInteger = "10"
    case uctPage
      ControlTypeToInteger = "11"
    case uctFrame
      ControlTypeToInteger = "12"
    case uctImage
      ControlTypeToInteger = "13"
    case uctPanel
      ControlTypeToInteger = "14"
    case uctListBox
      ControlTypeToInteger = "15"
    case uctGroupBox
      ControlTypeToInteger = "16"
    case uctScroll
      ControlTypeToInteger = "17"
    case uctActiveX
      ControlTypeToInteger = "18"
    case uctClientArea
      ControlTypeToInteger = "19"
    case uctNode
      ControlTypeToInteger = "20"
    case uctHyperLink
      ControlTypeToInteger = "21"
    case uctSapToolBar
      ControlTypeToInteger = "22"
    case uctStatusBar
      ControlTypeToInteger = "23"
    case else
      ControlTypeToInteger = AControlType
  end select    
end function

function ControlXCenter(AControl)
  dim lLeft
  dim lWidth
  lLeft = GetAbsoluteLeft(AControl)
  lWidth = GetControlWidth(AControl)
  ControlXCenter = lLeft + Round((lWidth / 2), 0)
end function

function ControlYCenter(AControl)
  dim lTop
  dim lHeight
  lTop = GetAbsoluteTop(AControl)
  lHeight = GetControlHeight(AControl)
  ControlYCenter = lTop + Round((lHeight / 2), 0)
end function

function CreateDOMObject
  if GetBrowserVersion < 6 then
    set CreateDOMObject = CreateObject("MSXML2.DOMDocument.4.0")
  else
    set CreateDOMObject = CreateObject("MSXML2.DOMDocument")
  end if
  CreateDOMObject.Async = false
end function

sub CreateButton(AHtmlElement, ATextElement, AButtonID, AMinimumWidth, AMinimumHeight, AOnClickEvent)
  dim lVMLButtonTemplate
  dim lArcSize
  dim lTop
  dim lLeft
  dim lWidth
  dim lHeight
  dim lPaddingTop

  'Get top and left
  lTop = GetAbsoluteTop(AHtmlElement)
  lLeft = GetAbsoluteLeft(AHtmlElement)
  
  'Get width and ensure it is within acceptable range
  lWidth = GetControlWidth(ATextElement) + (cVMLButtonSidePadding * 2)
  if lWidth < AMinimumWidth then
    lWidth = AMinimumWidth
  end if
  
  'Get height and check that it is greater than the minimum
  lHeight = GetControlHeight(ATextElement)
  if lHeight < AMinimumHeight then
    lHeight = AMinimumHeight
  end if
  
  'Calculate the arc size for the corners (as a percentage of the smallest side)
  lArcSize = GetArcPercentage(lWidth, lHeight, cVMLButtonCornerRadius)
  
  'Calculate the top padding to ensure the text/image is in the center of the button
  lPaddingTop = Round((lHeight - GetControlHeight(ATextElement)) / 2, 0) + 2
  if IsNumeric(lPaddingTop) then
    if lPaddingTop < 0 then
      lPaddingTop = cVMLButtonTopPadding
    end if
  else
    lPaddingTop = cVMLButtonTopPadding
  end if
  
  'Populate template
  lVMLButtonTemplate = cVMLButtonTemplate
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "id='VML'", "id='btnvml_" & AButtonID & "'", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "id='TEXT'", "id='btntext_" & AButtonID & "'", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "arcsize=''", "arcsize='" & lArcSize & "%'", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "onclick=''", "onclick='" & AOnClickEvent & "'", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "top:;", "top:" & lTop & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "left:;", "left:" & lLeft & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "width:;", "width:" & lWidth & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "height:;", "height:" & lHeight & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "padding-top:px;", "padding-top:" & lPaddingTop & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "padding-left:px;", "padding-left:" & cVMLButtonSidePadding & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "padding-right:px;", "padding-right:" & cVMLButtonSidePadding & "px;", 1, -1, vbTextCompare)
  lVMLButtonTemplate = Replace(lVMLButtonTemplate, "</div>", ATextElement.OuterHTML & " </div>", 1, -1, vbTextCompare)

  AHtmlElement.InnerHTML = lVMLButtonTemplate
end sub

sub CreateImageOnlyButton(AHtmlElement, ATextElement, AButtonID)
  CreateButton AHtmlElement, ATextElement, AButtonID, 28, 28
end sub

sub CreateStandardButton(AHtmlElement, ATextElement, AButtonID, AOnClickEvent)
  CreateButton AHtmlElement, ATextElement, AButtonID, cVMLButtonMinimumWidth, cVMLButtonMinimumHeight, AOnClickEvent
end sub

function DetermineHighestOrderNode(ANode1, ANode2)
  set DetermineHighestOrderNode = nothing
  if IsValidObject(ANode1) and IsValidObject(ANode2) then
    if ANode1.ParentNode is ANode2.ParentNode then
      dim li
      dim lParentNode
      set lParentNode = ANode1.ParentNode
      for li = 0 to lParentNode.ChildNodes.Length-1
        if ANode1 is lParentNode.ChildNodes.Item(li) then
          set DetermineHighestOrderNode = ANode1
          exit for
        end if
        if ANode2 is lParentNode.ChildNodes.Item(li) then
          set DetermineHighestOrderNode = ANode2
          exit for
        end if
      next
    end if
  else
    if IsValidObject(ANode1) and not IsValidObject(ANode2) then
      set DetermineHighestOrderNode = ANode1
    else
      if not IsValidObject(ANode1) and IsValidObject(ANode2) then
        set DetermineHighestOrderNode = ANode2
      end if
    end if
  end if
end function

function Diff(Int1, Int2)
  dim lDiff
  lDiff = Int1 - Int2
  if lDiff < 0 then
    lDiff = lDiff * -1
  end if
  Diff = lDiff
end function

function Encrypt(sPwd)
  dim c,i,ln,tPwd,incr
  Randomize
  ln = len(sPwd)
  tPwd = ""
  incr = 65 + CInt(rnd(20)*20)
  for i=0 to ln-1
    c = (Asc(Mid(sPwd,i+1,1)) + incr) mod 256
    tPwd = tPwd + Chr(c)
  next
  Encrypt = Chr(incr) + tPwd
end function
  
function EntityTypeToControlType(AEntityType)
  dim lEntityType
  lEntityType = LCase(EntityType)
  select case lEntityType
    case "etedit"
      EnitityTypeToString = uctEdit
    case "etbutton"
      EnitityTypeToString = uctButton
    case "etcheck"
      EnitityTypeToString = uctCheck
    case "etcombo"
      EnitityTypeToString = uctCombo
    case "ethotspot"
      EnitityTypeToString = uctHotSpot
    case "etlabel"
      EnitityTypeToString = uctLabel
    case "etmenu"
      EnitityTypeToString = uctMenu
    case "etradio"
      EnitityTypeToString = uctRadio
    case "ettab"
      EnitityTypeToString = uctTab
    case "etpentry"
      EnitityTypeToString = uctPEntry
    case "tpage"
      EnitityTypeToString = uctPage
    case "etframe"
      EnitityTypeToString = uctFrame
    case "etimage"
      EnitityTypeToString = uctImage
    case "etpanel"
      EnitityTypeToString = uctPanel
    case "etlistbox"
      EnitityTypeToString = uctListBox
    case "etgroupbox"
      EnitityTypeToString = uctGroupBox
    case "etscroll"
      EnitityTypeToString = uctScroll
    case "etactivex"
      EnitityTypeToString = uctActiveX
    case "etclientarea"
      EnitityTypeToString = uctClientArea
    case "etsaptoolbar"
      EnitityTypeToString = uctSapToolBar
    case "etstatusbar"
      EnitityTypeToString = uctStatusBar
    case "etnoncbt"
      EnitityTypeToString = uctNonCbt
    case else
      EnitityTypeToString = ""
  end select
end function

'Returns nothing if the attribute does not exist, can be used for XML nodes or HTML objects
function EntityTypeToGIFFileName(EntityType)
  select case LCase(EntityType)
    case "etbutton"
      EntityTypeToGIFFileName = "button.gif"
    case "etcheck"
      EntityTypeToGIFFileName = "check_box.gif"
    case "etcombo"
      EntityTypeToGIFFileName = "combo_box.gif"
    case "etedit"
      EntityTypeToGIFFileName = "edit_box.gif"
    case "ethotspot"
      EntityTypeToGIFFileName = "hotspot.gif"
    case "etimage"
      EntityTypeToGIFFileName = "image.gif"
    case "etlabel"
      EntityTypeToGIFFileName = "label.gif"
    case "etradio"
      EntityTypeToGIFFileName = "radio_button.gif"
    case else
      EntityTypeToGIFFileName = ""  
  end select    
end function

function ExtractFileExt(AFileName)
  dim lString
  dim lPos
  ExtractFileExt = ""
  lString = StrReverse(AFileName)
  lPos = InStr(1, lString, ".")
  if (lPos > 0) then
    ExtractFileExt = StrReverse(Mid(lString, 1, lPos))
  end if
end function

function ExtractFileName(AFileName)
  dim lString
  dim lPos
  lString = StrReverse(AFileName)
  lPos = InStr(1, lString, "/")
  if lPos = 0 then
    lPos = InStr(1, lString, "\")
  end if
  ExtractFileName = StrReverse(Mid(lString, 1, lPos-1))
end function

function ExtractFolderPath(APath)
  dim lString
  dim lPos
  lString = StrReverse(APath)
  lPos = InStr(1, lString, "/")
  if lPos = 0 then
    lPos = InStr(1, lString, "\")
  end if
  ExtractFolderPath = StrReverse(Mid(lString, lPos))
end function

function ExtractFolderName(APath)
  dim lFullPath
  dim lResult
  if SubStr(APath, "file") then
    lFullPath = Replace(APath, "\", "/")
    lFullPath = Mid(lFullPath, 2)
  else
    lFullPath = APath
  end if
  
  lResult = StrReverse(lFullPath)
  lResult = Mid(lResult, InStr(1, lResult, "/"))      'Remove file name
  lResult = Mid(lResult, 1, InStr(2, lResult, "/"))   'Remove all parent folders
  lResult = Replace(lResult, "/", "")                 'Remove all slashes to produce the folder name
  lResult = StrReverse(lResult)
  
  ExtractFolderName = lResult
end function
  
function FindTagInString(AString, AStartPos, ATagName)
  dim lStartPos
  dim lTagName
  if not SubStr(ATagName, "<") then
    lTagName = "<" & ATagName
  else
    lTagName = ATagName
  end if
  if SubStr(lTagName, ">") then
    lTagName = Replace(lTagName, ">", "")
  end if
  lTagName = Trim(lTagName)
  
  lStartPos = InStr(AStartPos, AString, lTagName, vbTextCompare)  
  if lStartPos > 0 then
    dim lEndPos    
    lEndPos = InStr(lStartPos, AString, ">", vbTextCompare) + 1
    FindTagInString = Mid(AString, lStartPos, lEndPos-lStartPos)
  else
    FindTagInString = ""
  end if
end function

function GetAbsoluteLeft(AObject)
  if IsValidObject(AObject) then
    GetAbsoluteLeft = GetAbsoluteLeft(AObject.ParentElement) + GetLeft(AObject)
  else
    GetAbsoluteLeft = 0
  end if
end function

function GetAbsoluteTop(AObject)
  if IsValidObject(AObject) then
    GetAbsoluteTop = GetAbsoluteTop(AObject.ParentElement) + GetTop(AObject)
  else
    GetAbsoluteTop = 0
  end if
end function

function GetArcPercentage(AWidth, AHeight, AArcPixelSize)
  on error resume next
  Err.Clear
  dim lSmallestSideValue
  if AWidth > AHeight then
    lSmallestSideValue = AHeight
  else
    lSmallestSideValue = AWidth
  end if
  
  dim lArcSize
  lArcSize = (AArcPixelSize * 100) / lSmallestSideValue
  
  if Err.Number = 0 then
    GetArcPercentage = Round(lArcSize, 2)
  else
    GetArcPercentage = 5
  end if
end function

function GetComputerName
  dim lWScript
  on error resume next
  Err.Clear
  set lWScript = CreateObject("WScript.NetWork") 

  if Err.Number = 0 then
    GetComputerName = lWScript.ComputerName
  else
    GetComputerName = ""
  end if
  set lWScript = nothing
end function

function GetControlHeight(AObject)
  on error resume next
  if IsValidObject(AObject) then
    if IsValidObject(AObject.ParentElement) then
      if SubStr(AObject.ParentElement.ID, "container_") then
        set AObject = AObject.ParentElement
      end if
    end if

    dim lControlHeight
    lControlHeight = StrToInt(AObject.Style.Height)
    if not IsNumeric(lControlHeight) then
      lControlHeight = StrToInt(AObject.OffsetHeight)
    else
      if (lControlHeight < 0) then
        lControlHeight = StrToInt(AObject.OffsetHeight)
      end if
    end if
    GetControlHeight = lControlHeight
  else
    GetControlHeight = 0
  end if
  if (IsEmptyStr(lControlHeight) or (lControlHeight < 0)) and Environment.RepositorySettings.DebugMode then
    Msgbox "GetControlWidth could not find the value for control '" & GetSafeAttribute(AObject, "id") & "', object data:" & vbCrLf & _
                AObject.OuterHTML
  end if
end function

function GetControlWidth(AObject)
  on error resume next
  if IsValidObject(AObject) then
    if IsValidObject(AObject.ParentElement) then
      if SubStr(AObject.ParentElement.ID, "container_") then
        set AObject = AObject.ParentElement
      end if
    end if

    dim lControlWidth
    lControlWidth = StrToInt(AObject.Style.Width)
    if not IsNumeric(lControlWidth) then
      lControlWidth = StrToInt(AObject.OffsetWidth)
    else
      if (lControlWidth < 0) then
        lControlWidth = StrToInt(AObject.OffsetWidth)
      end if
    end if
    GetControlWidth = lControlWidth
  else
    GetControlWidth = 0
  end if
  
  if (IsEmptyStr(lControlWidth) or (lControlWidth < 0)) and Environment.RepositorySettings.DebugMode then
    Msgbox "GetControlWidth could not find the value for control '" & GetSafeAttribute(AObject, "id") & "', object data:" & vbCrLf & _
                AObject.OuterHTML
  end if
end function

function GetCookieValue(Name)
  GetCookieValue = ""
  if window.clientinformation.cookieEnabled then
    if InStr(1, Document.Cookie, Name, vbTextCompare) > 0 then
      lLength = len(Name)
      lStart = InStr(1, Document.Cookie, Name, vbTextCompare) + lLength + 1
      if not SubStr(Document.Cookie, ";") then
        GetCookieValue = Mid(Document.Cookie, lStart)
      else
        lEnd = InStr(lStart, Document.Cookie, ";")
        if not (lEnd = 0) then
          lLength = lEnd - lStart
        else
          lLength = len(Document.Cookie) - lStart  + 1 
        end if
        GetCookieValue = Mid(Document.Cookie, lStart, lLength)
      end if
    end if
  end if
end function

function GetCurrentDirectoryName
  dim lFullPath
  dim lResult
  if SubStr(Window.Location.Protocol, "file") then
    lFullPath = Replace(Window.Location.Pathname, "\", "/")
    lFullPath = Mid(lFullPath, 2)
  else
    lFullPath = Window.Location.Pathname
  end if
  
  lResult = StrReverse(lFullPath)
  lResult = Mid(lResult, InStr(1, lResult, "/"))      'Remove file name
  lResult = Mid(lResult, 1, InStr(2, lResult, "/"))   'Remove all parent folders
  lResult = Replace(lResult, "/", "")                 'Remove all slashes to produce the folder name
  lResult = StrReverse(lResult)
  
  GetCurrentDirectoryName = lResult
end function
  
public function GetDisplayDate(DateEntryXMLNode)
  GetDisplayDate = ""
  dim lDate
  dim lDay
  dim lMonth
  dim lYear
  dim lSeperator
  dim lDateFlags
  dim lResult
  
  if IsValidObject(DateEntryXMLNode) then
    lDate = GetRequiredDate(DateEntryXMLNode)
    lDay = DatePart("d", lDate)
    lMonth = DatePart("m", lDate)
    lYear = DatePart("yyyy", lDate)
    if Environment.RepositorySettings.Dates.DayLeadingZero and (len(lDay) = 1) then
      lDay = "0" & lDay
    end if
    if Environment.RepositorySettings.Dates.MonthLeadingZero and (len(lMonth) = 1) then
      lMonth = "0" & lMonth
    end if
    lSeperator = Environment.RepositorySettings.Dates.DateSeparator
    lDateFlags = GetSafeAttribute(DateEntryXMLNode, "dateflags")
    select case Environment.RepositorySettings.Dates.DateFormat
      case "doDMY"
        if SubStr(lDateFlags, "dfShowDay") then
          lResult = lDay
        end if
        if SubStr(lDateFlags, "dfShowMonth") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lMonth
          else
            lResult = lMonth
          end if
        end if
        if SubStr(lDateFlags, "dfShowYear") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lYear
          else
            lResult = lYear
          end if
        end if
      case "doMDY"
        if SubStr(lDateFlags, "dfShowMonth") then
          lResult = lMonth
        end if
        if SubStr(lDateFlags, "dfShowDay") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lDay
          else
            lResult = lDay
          end if
        end if
        if SubStr(lDateFlags, "dfShowYear") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lYear
          else
            lResult = lYear
          end if
        end if
      case "doYMD"
        if SubStr(lDateFlags, "dfShowYear") then
          lResult = lYear
        end if
        if SubStr(lDateFlags, "dfShowMonth") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lMonth
          else
            lResult = lMonth
          end if
        end if
        if SubStr(lDateFlags, "dfShowDay") then
          if not IsEmptyStr(lResult) then
            lResult = lResult & lSeperator & lDay
          else
            lResult = lDay
          end if
        end if
    end select
    GetDisplayDate = lResult
  end if
end function

function GetRequiredDate(XMLNode)  'YYY: all the date functions should be in seperate file or calculate on the task
  dim lResult
  lResult = Date
  if StringsEqual(XMLNode.NodeName, "lsn_dateentry") then
    dim lDay
    dim lMonth
    dim lYear
    dim lFixedDateNode
    dim lLastDaysStr
    dim lLastDaysArray
    lDay = 0
    lMonth = 0
    lYear = 0
    lLastDaysStr = "0,31,28,31,30,31,30,31,31,30,31,30,31"
    lLastDaysArray = Split(lLastDaysStr, ",")
    set lFixedDateNode = XMLNode.SelectSingleNode("lsn_fixeddate")
    
    select case GetSafeAttribute(XMLNode, "type")
      case "dtCurrentDate"
        'Do nothing, current date already acquired
      case "dtFixedDate"
        dim lDate
        if IsValidObject(lFixedDateNode) then
          lDay = GetSafeAttribute(lFixedDateNode, "day")
          lMonth = GetSafeAttribute(lFixedDateNode, "month")
          lYear = GetSafeAttribute(lFixedDateNode, "year")
          
          if LastDayOfMonth(lFixedDateNode) then
            lDay = lLastDaysArray(lMonth)
            if (lMonth = "2") and IsLeapYear(lYear) then
              lDay = "29"
            end if
          end if
          
          lMonth = MonthName(lMonth)
          lDate = lDay & " " & lMonth & " " & lYear
          lResult = DateValue(lDate)
          if RequiredWeekDay(lFixedDateNode) then
            dim lCurrentWeekDay
            dim lRequiredWeekDay
            lRequiredWeekDay = CInt(GetSafeAttribute(lFixedDateNode, "requiredweekday"))
            lCurrentWeekDay = Weekday(lDate)
            
            if lRequiredWeekDay < 0 then
              lRequiredWeekDay = lRequiredWeekDay * -1
              dim lDiff
              if lCurrentWeekDay < lRequiredWeekDay then
                lDiff = (lCurrentWeekDay  + (7 - lRequiredWeekDay)) * -1
                lResult = DateAdd("d",  lDiff, lResult) 
              else
                if lCurrentWeekDay > lRequiredWeekDay then
                  lDiff = (lCurrentWeekDay - lRequiredWeekDay) * -1
                  lResult = DateAdd("d",  lDiff, lResult) 
                else
                  lResult = DateAdd("d",  -7, lResult) 
                end if              
              end if
            else
              if lCurrentWeekDay < lRequiredWeekDay then
                lDiff = lRequiredWeekDay + lCurrentWeekDay
                lResult = DateAdd("d", lDiff, lResult) 
              else
                if lCurrentWeekDay > lRequiredWeekDay then
                  lDiff = lRequiredWeekDay + (7 - lCurrentWeekDay)
                  lResult = DateAdd("d", lDiff, lResult) 
                else
                  lDiff = (lCurrentWeekDay - lRequiredWeekDay) * -1
                  lResult = DateAdd("d", 7, lResult) 
                end if
              end if              
            end if
          end if 
        end if
      case "dtSpecialDate"
        'Dump  1, "<b><font color=""green"">Debug:</font></b> DateType=dtSpecialDate"
        set lNode = XMLNode.SelectSingleNode("lsn_relativedate")
        if IsValidObject(lNode) then
          dim lDays
          dim lMonths
          dim lYears
          dim lWeeks
          
          lDays = CInt(GetSafeAttribute(lNode, "day"))
          lMonths = CInt(GetSafeAttribute(lNode, "month"))
          lYears = CInt(GetSafeAttribute(lNode, "year"))
          lWeeks = CInt(GetSafeAttribute(lNode, "week"))

          if IsValidObject(lFixedDateNode) then
            lDay = GetSafeAttribute(lFixedDateNode, "day")
            lMonth = GetSafeAttribute(lFixedDateNode, "month")
            lYear = GetSafeAttribute(lFixedDateNode, "year")
          end if

          lResult = Date
          lResult = DateAdd("d", lDays, lResult) 
          lResult = DateAdd("m", lMonths, lResult) 
          lResult = DateAdd("yyyy", lYears, lResult) 
          lResult = DateAdd("d", (lWeeks*7), lResult)
          
          dim lTempDay
          dim lTempMonth
          dim lTempYear
          lTempDay = Day(lResult)
          lTempMonth = MonthName(Month(lResult))
          lTempYear = Year(lResult)
          
          if lDay <> 0 then
            lTempDay = lDay
          end if
          if lMonth <> 0 then
            lTempMonth = MonthName(lMonth)
          end if
          if lYear <> 0 then
            lTempYear = lYear
          end if
          
          lDate = lTempDay & " " & lTempMonth & " " & lTempYear
          lResult = DateValue(lDate)
        end if
    end select    
  end if
  GetRequiredDate = lResult
end function

function GetFullFolderPath
  dim lPos
  dim lResultPath
  lResultPath = Window.Location.HRef
  lResultPath = Replace (lResultPath, "\", "/")
  lResultPath = StrReverse(lResultPath)
  lPos = InStr(1, lResultPath, "/")
  if lPos > 0 then
    lResultPath = mid(lResultPath, lPos)
    lResultPath = StrReverse(lResultPath)
  else
    lResultPath = ""
  end if
  GetFullFolderPath = lResultPath
end function

function GetWindowParamInfo
  GetWindowParamInfo = ""
  
  GetWindowParamInfo = Window.Location.Search
  if IsEmptyStr(GetWindowParamInfo) then
    GetWindowParamInfo = Window.Location.Hash
  end if
end function

function GetOpenerParamInfo
  GetOpenerParamInfo = ""
  
  on error resume next  
  if IsValidObject(Window.Opener) then

    GetOpenerParamInfo = Window.Opener.Location.Search
    if IsEmptyStr(GetOpenerParamInfo) then
      GetOpenerParamInfo = Window.Opener.Location.Hash
    end if
  end if
end function

function GetHashParameter(ParameterName)
  GetHashParameter = ""
  
  dim lParamInfo
  lParamInfo = GetWindowParamInfo  
  
  if SubStr(lParamInfo, ParameterName) then
    dim lParameterName
    dim lPositionStart
    dim lPositionEnd
    dim lSubStr
    lParameterName = ParameterName & "="
    if SubStr(lParamInfo, lParameterName) then
      lPositionStart = InStr(1, lParamInfo, lParameterName, vbTextCompare)
      lSubStr = Mid(lParamInfo, lPositionStart)
      lPositionEnd = InStr(1, lSubStr, "&")
      if lPositionEnd > 0 then
        GetHashParameter = Mid(lSubStr, len(lParameterName)+1, (lPositionEnd-(len(lParameterName)+1)))
      else
        GetHashParameter = Mid(lSubStr, len(lParameterName)+1)
      end if
    end if
  elseif IsValidObject(Window.Opener) then
    on error resume next
    GetHashParameter = GetOpenerHashParameter(ParameterName)
  end if
end function

function GetOpenerHashParameter(ParameterName)
  on error resume next
  GetOpenerHashParameter = ""
  
  dim lParamInfo
  lParamInfo = GetOpenerParamInfo
  
  if SubStr(lParamInfo, ParameterName) then
    dim lParameterName
    dim lPositionStart
    dim lPositionEnd
    dim lSubStr
    lParameterName = ParameterName & "="
    if SubStr(lParamInfo, lParameterName) then
      lPositionStart = InStr(1, lParamInfo, lParameterName, vbTextCompare)
      lSubStr = Mid(lParamInfo, lPositionStart)
      lPositionEnd = InStr(1, lSubStr, "&")
      if lPositionEnd > 0 then
        GetOpenerHashParameter = Mid(lSubStr, len(lParameterName)+1, (lPositionEnd-(len(lParameterName)+1)))
      else
        GetOpenerHashParameter = Mid(lSubStr, len(lParameterName)+1)
      end if
    end if
  end if
end function

function GetQueryString(Parameters)
  GetQueryString = ""
  
  if not IsEmptyStr(Parameters) then
    'For versions of IE before 7, when running off hard disk, the usual query string
    'method does not work so we must rather hack it by using the hash parameter
    if (GetBrowserVersion < 7) and not RunningFromWebServer then
      GetQueryString = "#" & Parameters
    else
      GetQueryString = "?" & Parameters
    end if
  end if
end function

function GetLeft(AObject)
  if IsValidObject(AObject) then
    if IsNumeric(StrToInt(AObject.Style.Left)) and (StrToInt(AObject.Style.Left) >= 0) then
      GetLeft = StrToInt(AObject.Style.Left)
    else
      GetLeft = AObject.OffSetLeft
    end if
  else
    GetLeft = 0
  end if
end function

function GetTop(AObject)
  if IsValidObject(AObject) then
    if IsNumeric(StrToInt(AObject.Style.Top)) and (StrToInt(AObject.Style.Top) >= 0) then
      GetTop = StrToInt(AObject.Style.Top)
    else
      GetTop = AObject.OffSetTop
    end if
  else
    GetTop = 0
  end if
end function

function HasHashParameter(ParameterName)
  dim lParamInfo
  lParamInfo = GetWindowParamInfo  

  HasHashParameter = SubStr(lParamInfo, ParameterName)
  
  on error resume next
  if not HasHashParameter then    
    lParamInfo = GetOpenerParamInfo  
    HasHashParameter = SubStr(lParamInfo, ParameterName)
  end if
end function

function GetSafeAttribute(AObject, AttributeName)
  dim lResult
  lResult = ""
  if IsValidObject(AObject) then
    Err.Clear
    on error resume next
    dim lAttribute
    set lAttribute = AObject.Attributes.GetNamedItem(AttributeName)
    if Err.Number <> 0 then
      dim li
      for li = 0 to AObject.Attributes.Length-1
        if StringsEqual(AObject.Attributes.Item(li).NodeName, AttributeName) then
          lResult = AObject.Attributes.Item(li).NodeValue
        end if
      next
    else
      if IsValidObject(lAttribute) then
        lResult = lAttribute.Value
      end if
    end if
  end if
  if (VarType(lResult) = vbEmpty) or (VarType(lResult) = vbNull) then
    GetSafeAttribute = ""
  else
    GetSafeAttribute = lResult
  end if
end function

function GetFrameNamed(AFrameName)
  dim li
  for li = 0 to Top.Frames.Length-1 
    if StringsEqual(AFrameName, Top.Frames.Item(li).Name) then
      set GetFrameNamed = Top.Frames.Item(li)
      exit for
    end if
  next
end function

function GetWindowsLoginName
  dim lWScript
  on error resume next
  Err.Clear
  set lWScript = CreateObject("WScript.NetWork") 
  if Err.Number = 0 then
    GetWindowsLoginName = lWScript.UserName
  else
    GetWindowsLoginName = ""
  end if
  set lWScript = nothing
end function

function InFrameSet
  Err.Clear
  on error resume next
  InFrameSet = not(Top is Document)
  if not IsEmptyStr(Err.Description) then
    InFrameSet = false
  end if
end function

function IntegerToActionType(AInteger)
  'XXX: change this to use array
  select case AInteger
    case "1"
      IntegerToActionType = atLClick
    case "2"
      IntegerToActionType = atRClick
    case "3"
      IntegerToActionType = atPEClick
    case "4"
      IntegerToActionType = atDblClick
    case "5"
      IntegerToActionType = atText
    case "6"
      IntegerToActionType = atMultiText
    case "7"
      IntegerToActionType = atSelect
    case "8"
      IntegerToActionType = atDeselect
    case "9"
      IntegerToActionType = atDragDrop
    case "10"
      IntegerToActionType = atMultiSelect
    case "11"
      IntegerToActionType = atActiveControlChange
    case "12"
      IntegerToActionType = atInvalidClick
    case else
      IntegerToActionType = atNone
  end select
end function

function IntegerToControlType(AInteger)
  'XXX: change this to use array
  select case AInteger
    case "0"
      IntegerToControlType = uctNonCbt
    case "1"
      IntegerToControlType = uctEdit
    case "2"
      IntegerToControlType = uctButton
    case "3"
      IntegerToControlType = uctCheck
    case "4"
      IntegerToControlType = uctCombo
    case "5"
      IntegerToControlType = uctHotSpot
    case "6"
      IntegerToControlType = uctLabel
    case "7"
      IntegerToControlType = uctMenu
    case "8"
      IntegerToControlType = uctRadio
    case "9"
      IntegerToControlType = uctTab
    case "10"
      IntegerToControlType = uctPEntry
    case "11"
      IntegerToControlType = uctPage
    case "12"
      IntegerToControlType = uctFrame
    case "13"
      IntegerToControlType = uctImage
    case "14"
      IntegerToControlType = uctPanel
    case "15"
      IntegerToControlType = uctListBox
    case "16"
      IntegerToControlType = uctGroupBox
    case "17"
      IntegerToControlType = uctScroll
    case "18"
      IntegerToControlType = uctActiveX
    case "19"
      IntegerToControlType = uctClientArea
    case "20"
      IntegerToControlType = uctNode
    case "21"
      IntegerToControlType = uctHyperLink
    case "22"
      IntegerToControlType = uctSapToolBar
    case "23"
      IntegerToControlType = uctStatusBar
    case else
      IntegerToControlType = AInteger
  end select    
end function

function GetBrowserVersion
  GetBrowserVersion = 0
  dim lBrowserString
  dim lPosition
  
  lBrowserString = Navigator.UserAgent
  if not IsEmptyStr(lBrowserString) then
    lPosition = InStr(1, lBrowserString, "msie", vbTextCompare) + 5
    err.Clear
    on error resume next
    GetBrowserVersion = cint(Mid(lBrowserString, lPosition, 1))
    if err.number <> 0 then
      GetBrowserVersion = 0
    end if
  end if  
end function

function IsCorrectBrowserVersion
  IsCorrectBrowserVersion = false
  
  err.Clear
  on error resume next   
  if not(GetBrowserVersion >= cMinimumBrowserVersion) and IsEmptyStr(Err.Description) then
    lResult = MsgBox ("Incorrect browser version or unable to determine version, continue anyway?", vbYesNo, "Browser Error") = vbYes
  else
    IsCorrectBrowserVersion = true
  end if
end function

function IsEmptyStr(TestString)
  Err.Clear
  on error resume next
  if VarType(TestString) = vbString then
    IsEmptyStr = (len(Trim(TestString)) = 0)
  else
    lString = cStr(TestString)
    IsEmptyStr = (len(Trim(lString)) = 0)
  end if
  if Err.Number <> 0 then
    IsEmptyStr = true
  end if
end function

function IsFrameXMLNode(XMLNode)
  IsFrameXMLNode = False
  if IsValidObject(XMLNode) then
    IsFrameXMLNode = StringsEqual(XMLNode.NodeName, "lsn_frame")
  end if
end function  

function IsHexidecimal(HexNumber)
  if not IsEmptyStr(HexNumber) then
    IsHexidecimal = true
    dim li
    dim lChar
    for li = 1 to len(HexNumber)
      lChar = Mid(HexNumber, li, 1)
      if not IsNumeric(lChar) then
        select case lCase(lChar)
          case "a", "b", "c", "d", "e", "f"
            'do nothing
          case else
            IsHexidecimal = false
            exit for 
        end select
      end if
    next
  else
    IsHexidecimal = false
  end if
end function

function IsValidObject(AObject)
  on error resume next
  err.clear
  if IsObject(AObject) then
    IsValidObject = not(AObject is nothing)
  else
    IsValidObject = false
  end if  
  IsValidObject = IsValidObject and (err.number = 0)
end function
  
'Merges to arrays, will keep the order of the first array
function MergeArrays(Array1, Array2)
  dim lTempArray
  dim li
  dim lj
  redim lTempArray(0)

  for li = 0 to UBound(Array1)-1
    for lj = 0 to UBound(Array2)-1
      if StringsEqual(Array1(li), Array2(lj)) then
        redim preserve lTempArray(UBound(lTempArray) + 1)
        lTempArray(UBound(lTempArray)) = Array1(li)
      end if
    next
  next
  
  MergeArrays = lTempArray
end function

function GetRootFolder(ABaseFolder)
  dim lStartPos
  dim lEndPos
  if SubStr(ABaseFolder, "://") then
    lStartPos = InStr(1, ABaseFolder, "://") + 3
    lEndPos = InStr(lStartPos, ABaseFolder, "/")
    if lEndPos > 0 then
      GetRootFolder = Mid(ABaseFolder, 1, lEndPos-1)
    else
      GetRootFolder = ABaseFolder
    end if
  else
    if SubStr(ABaseFolder, ":\") then
      lStartPos = InStr(1, ABaseFolder, ":\") + 2
      lEndPos = InStr(lStartPos, ABaseFolder, "\")
      if lEndPos > 0 then
        GetRootFolder = Mid(ABaseFolder, 1, lEndPos-1)
      else
        GetRootFolder = ABaseFolder
      end if
    else
      if SubStr(ABaseFolder, "\\") then
        lStartPos = InStr(1, ABaseFolder, "\\") + 2
        lEndPos = InStr(lStartPos, ABaseFolder, "\")
        if lEndPos > 0 then
          GetRootFolder = Mid(ABaseFolder, 1, lEndPos-1)
        else
          GetRootFolder = ABaseFolder
        end if
      else
        GetRootFolder = ABaseFolder
      end if
    end if
  end if
end function

function LauncherTypeFromString(ALauncherString)
  select case ALauncherString
    case "stthelp"
      LauncherTypeFromString = ltSTTHelp
    case "sttmanager"
      LauncherTypeFromString = ltSTTManager
    case "lessonmanager"
      LauncherTypeFromString = ltLessonManager
    case else
      LauncherTypeFromString = ltUnknown
  end select
end function

function LauncherStringFromType(ALauncherType)
  select case ALauncherType
    case ltSTTHelp
      LauncherStringFromType = "stthelp"
    case ltSTTManager
      LauncherStringFromType = "sttmanager"
    case ltLessonManager
      LauncherStringFromType = "lessonmanager"
    case else
      LauncherStringFromType = ""
  end select
end function

function SubStrCount(AString, ASubStr)
  dim lString
  dim lCount
  lString = AString
  lCount = 0
  while InStr(1, lString, "../") = 1
    lCount = lCount + 1
    lString = Mid(lString, 4)
  wend
  SubStrCount = lCount
end function

function RelativeToAbsolutePath(BasePath, RelativePath)
  dim lBasePath
  dim lRelativePath
  dim lPos
  lBasePath = Replace(BasePath, "\", "/")
  lRelativePath = Replace(RelativePath, "\", "/")

  if (InStr(1, lRelativePath, "/") = 1) then     'Root
    lPos = InStr(1, lBasePath, "/")
    if InStr(1, lBasePath, "/") = InStr(1, lBasePath, "//") then    'Running from webserver
      lBasePath = Mid(lBasePath, 1, lPos+1)
    else
      lBasePath = Mid(lBasePath, 1, lPos)
    end if
    lRelativePath = Mid(lRelativePath, 2)
  elseif (InStr(1, lRelativePath, "../") > 0) then
    lBasePath = StrReverse(lBasePath)
    do while (InStr(1, lRelativePath, "../") > 0)
      lPos = InStr(2, lBasePath, "/")
      if (lPos > 0) then
        lBasePath = Mid(lBasePath, lPos)
        lRelativePath = Replace(lRelativePath, "../", "", 1, 1)
      else
        lBasePath = ""
        lRelativePath = Replace(lRelativePath, "../", "")
        exit do
      end if
    loop
    lBasePath = StrReverse(lBasePath)
  elseif (InStr(1, lRelativePath, "./") > 0) then
    lRelativePath = Replace(lRelativePath, "./", "")
  end if

  RelativeToAbsolutePath = lBasePath + lRelativePath
end function

function RemoveServerNameFromPath(APath)
  on error resume next
  Err.Clear
  RemoveServerNameFromPath = Replace(APath, Location.Protocol & "//" &  Location.Host, "")
  if Err.Number <> 0 then
    RemoveServerNameFromPath = APath
  end if
end function

function RemoveSubDirsFromPath(APath, ARemoveCount)
  dim li
  dim lPath
  dim lPos
  dim lLastChar
  lLastChar = "\"
  lPath = StrReverse(APath)
  if InStr(1, lPath, "\") = 1 then
    lPath = Mid(lPath, 2)
  else
    if InStr(1, lPath, "/") = 1 then
      lPath = Mid(lPath, 2)
      lLastChar = "/"
    end if  
  end if
  for li = 1 to ARemoveCount
    lPos = InStr(1, lPath, "\")
    if lPos = 0 then
      lPos = InStr(1, lPath, "/")
    end if
    if lPos > 0 then
      lPath = Mid(lPath, lPos+1)
    end if
  next
  RemoveSubDirsFromPath = StrReverse(lPath) + lLastChar
end function

sub MaximizeWindowSize
  'XXX - This code always moves the window back to the primary monitor so it 
  'has been commented out for Eon Sweden - Steven
  'Window.MoveTo 0,0
  Window.ResizeTo Screen.AvailWidth, Screen.AvailHeight
end sub

function MaxButtonSize(FormPixelWidth, NoOfButtons, ButtonPixelSpacing)
  dim lFormPixelWidth
  dim lNoOfButtons
  dim lButtonPixelSpacing
  lFormPixelWidth = StrToInt(FormPixelWidth)
  lNoOfButtons = StrToInt(NoOfButtons)
  lButtonPixelSpacing = StrToInt(ButtonPixelSpacing)
  
  on error resume next
  Err.Clear
  MaxButtonSize = ((lFormPixelWidth - (lButtonPixelSpacing * (lNoOfButtons + 1))) / lNoOfButtons)  
  if Err.Number <> 0 then
    MaxButtonSize = 75
  end if
end function

function MergePaths(ABaseFolder, ARelativePath)
  if SubStr(ARelativePath, "../") or SubStr(ARelativePath, "..\") then
    dim lSubStrCount
    dim lPath
    dim lRelativePath
    lSubStrCount = SubStrCount(ARelativePath, "../")
    if lSubStrCount = 0 then
      lSubStrCount = SubStrCount(ARelativePath, "..\")
    end if
    lPath = RemoveSubDirsFromPath(ABaseFolder, lSubStrCount)
    lRelativePath = Replace(ARelativePath, "../", "")
    lRelativePath = Replace(lRelativePath, "..\", "")
    MergePaths = lPath & lRelativePath
  else
    if (InStr(1, ARelativePath, "/") = 1) or (InStr(1, ARelativePath, "\") = 1) then
      MergePaths = GetRootFolder & ARelativePath
    else
      if InStr(1, ARelativePath, ".") <> 1 then
        dim lLastChar
        lLastChar = Mid(ABaseFolder, len(ABaseFolder), 1)
        if (lLastChar <> "/") and (lLastChar <> "\") then
          ABaseFolder = ABaseFolder & "/"
        end if
        MergePaths = ABaseFolder & ARelativePath
      end if
    end if  
  end if
end function

sub OnVMLButtonMouseDown(AVMLElement)
  ChangeVMLFillColor AVMLElement, "#202020"
end sub

sub OnVMLButtonMouseOver(AVMLElement)
  ChangeVMLFillColor AVMLElement, Environment.RepositorySettings.UserInterface.Color
  ChangeVMLFontColor AVMLElement, Environment.RepositorySettings.UserInterface.FontColor
end sub

sub OnVMLButtonMouseOut(AVMLElement)
  ChangeVMLFillColor AVMLElement, "#808080"
  ChangeVMLFontColor AVMLElement, "#000000"
end sub

sub OnVMLButtonMouseUp(AVMLElement)
  ChangeVMLFillColor AVMLElement, "#808080"
end sub

function RunningFromWebServer
  RunningFromWebServer = SubStr(Window.Location.Protocol, "http:") or SubStr(Window.Location.Protocol, "https:")
end function

function IsRelativePath(APath)
  if not SubStr(APath, "http:") then
    dim lPath
    lPath = Replace(APath, "/", "\")
    lPath = Replace(lPath, "file:\\\", "")
    IsRelativePath = not SubStr(lPath, ":\\") and not SubStr(lPath, ":\") and not SubStr(lPath, "\\")
  else
    IsRelativePath = false
  end if
end function

sub BatchSetAttributeValue(XML, XPathQuery, AttributeName, AttributeValue)
  dim li
  dim lNodes
  set lNodes = XML.SelectNodes(XPathQuery)
  for li = 0 to lNodes.Length-1
    SetSafeAttribute lNodes.Item(li), AttributeName, AttributeValue
  next
  set lNodes = nothing
end sub

sub SetCookieValue(AName, AValue)
  if window.clientinformation.cookieEnabled then
    if not IsEmptyStr(AName) and not IsEmptyStr(AValue) then
      dim lExpires  
      lExpires = "Saturday, 31-Dec-2050 23:59:59 GMT"
      
      dim lPath
      if RunningFromWebServer then
        lPath = RemoveServerNameFromPath(RelativeToAbsolutePath(GetFullFolderPath, csRepositoryFolder))
      else
        lPath = ExtractFolderName(RelativeToAbsolutePath(GetFullFolderPath, csRepositoryFolder))
      end if

      dim lCookie
      lCookie = AName & "=" & AValue & ";expires=" & lExpires &  ";path=" & lPath
      Document.Cookie = lCookie
    end if
  end if
end sub

sub SetSafeAttribute(AObject, AttributeName, NewAttributeValue)
  if IsValidObject(AObject) and not IsEmptyStr(AttributeName) then
    AObject.SetAttribute AttributeName, NewAttributeValue
  end if
end sub

function SetXSLVariable(AXSLDocument, AVariableName, AVariableValue)
  on error resume next
  Err.Clear
  dim lVariable
  set lVariable = AXSLDocument.SelectSingleNode("//xsl:variable[@name='" & AVariableName & "']")
  if IsValidObject(lVariable) then
    lVariable.Text = AVariableValue
  end if
  set lVariable = nothing
  SetXSLVariable = (Err.Number = 0)
end function

function StringsEqual(String1, String2)
  StringsEqual = (StrComp(String1, String2, vbTextCompare) = 0)
end function

function STTStrToDbl(AString)
  Err.Clear
  on error resume next
  if VarType(AString) = vbString then
    if SubStr(AString, ".") then
      dim lWholeNumber
      dim lFractionalNumber
      dim lFractionalNumberLength
      dim lArray
      lArray = Split(AString, ".")
      if IsEmptyStr(lArray(lBound(lArray))) then
        lWholeNumber = 0
      else
        lWholeNumber = CDbl(lArray(lBound(lArray)))
      end if
      lFractionalNumber = CDbl(lArray(uBound(lArray)))
      lFractionalNumberLength = lArray(uBound(lArray))
      lFractionalNumber = lFractionalNumber * (10^-(len(lFractionalNumberLength)))
      STTStrToDbl = lWholeNumber + lFractionalNumber
    else
      dim lString
      lString = Replace(AString, "px", "", 1, -1, vbTextCompare)
      lString = Replace(lString, "pt", "", 1, -1, vbTextCompare)
      lString = Replace(lString, "%", "", 1, -1, vbTextCompare)
      STTStrToDbl = CDbl(lString)
    end if
  else
    STTStrToDbl = CDbl(AString)
  end if  
  if not IsEmptyStr(Err.Description) then
    STTStrToDbl = 0
  end if
end function

function STTStrToInt(AString)
  STTStrToInt = Round(STTStrToDbl(AString))
end function

function StrToArray(AString)
  dim lArray()
  redim lArray(0)
  if not IsEmptyStr(AString) then
    dim li
    redim lArray(len(AString)-1)
    
    for li = 1 to len(AString)
      lArray(li-1) = Mid(AString, li, 1)
    next
  end if

  StrToArray = lArray
end function

'This function will convert a string to an integer, this function only needs to be used
'for strings that have px, pt, or spaces in them. Otherwise just use CInt
function StrToInt(AString)
  dim lResult
  lResult = Replace(AString, "px", "")
  lResult = Replace(lResult, "pt", "")
  lResult = Replace(lResult, " ", "")
  Err.Clear
  on error resume next
  StrToInt = CInt(lResult)
  if not IsEmptyStr(Err.Description) then
    StrToInt = -1
  end if
end function

function SubStr(String1, String2)
  SubStr = InStr(1, String1, String2, vbTextCompare) > 0
end function

function StartsWith(String1, String2)
  StartsWith = InStr(1, String1, String2, vbTextCompare) = 1
end function

function EndsWith(String1, String2)
  dim lPos
  lPos = InStr(1, String1, String2, vbTextCompare)
  if lPos > 0 then
    EndsWith = ((len(String1) - len(String2)) = (lPos - 1))
  else
    EndsWith = false
  end if
end function

function STTEscape(AString)
  dim lNewValue
  dim lPos
  dim lString
  dim lValue
  lString = Escape(AString)
  
  'Certain characters we do not want to 'Escape'
  lString = Replace(lString, "%20", " ")
  lString = Replace(lString, "%21", "!")
  lString = Replace(lString, "%23", "#")
  lString = Replace(lString, "%24", "$")
  lString = Replace(lString, "%25", "%")
  lString = Replace(lString, "%26", "&")
  lString = Replace(lString, "%27", "'")
  lString = Replace(lString, "%28", "(")
  lString = Replace(lString, "%29", ")")
  lString = Replace(lString, "%5E", "^")
  lString = Replace(lString, "%60", "`")
  
  lPos = InStr(1, lString, "%")
  while lPos > 0
    lValue = Mid(lString, lPos+1, 2)
    if IsHexidecimal(lValue) then
      lNewValue = "&#" & lValue & ";"
      lValue = "%" & lValue
      lString = Replace(lString, lValue, lNewValue, 1, len(lString), vbTextCompare)
      lPos = InStr(1, lString, "%")
    else
      lPos = InStr(lPos+1, lString, "%")
    end if
  wend
  
  STTEscape = lString
end function

function URLEncode(ARawURL)
  URLEncode = ""
  on error resume next
  dim iLoop
  dim sRtn
  dim sTmp
  sRtn = ""
  const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz:/.?=_-$(){}~&"

  if not IsEmptyStr(ARawURL) then
    for iLoop = 1 to len(ARawURL)
      sTmp = Mid(ARawURL, iLoop, 1)
      if InStr(1, sValidChars, sTmp, vbBinaryCompare) = 0 then
        ' If not ValidChar, convert to HEX and prefix with %
        sTmp = Hex(Asc(sTmp))
        if sTmp = "20" then
          sTmp = "+"
        else
          if len(sTmp) = 1 then
            sTmp = "%0" & sTmp
          else
            sTmp = "%" & sTmp
          end if
        end if
        sRtn = sRtn & sTmp
      else
        sRtn = sRtn & sTmp
      end if
    next
    URLEncode = sRtn
  end if
end function

function WindowOnPrimaryDisplay
	on error resume next
	Err.Clear
	dim lHorizontalOK
	dim lVerticalOK
  
	lHorizontalOK = (Window.screenLeft >= 0) and (Window.screenLeft < Screen.Width)
	lVerticalOK = (Window.screenTop >= 0) and (Window.screenTop < Screen.Height)
  
	if Err.Number = 0 then
		WindowOnPrimaryDisplay = lHorizontalOK and lVerticalOK
	else
		WindowOnPrimaryDisplay = true
	end if
end function

function WriteToFile(AOutput, AFileName)
  on error resume next
  dim objFileSystem, objOutputFile
  dim strOutputFile

  strOutputFile = AFileName

  set objFileSystem = CreateObject("Scripting.FileSystemObject")
  set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE)

  objOutputFile.WriteLine(AOutput)
  objOutputFile.Close

  set objFileSystem = nothing
end function

function LastDayOfMonth(FixedDateNode)
  LastDayOfMonth = False
  if StringsEqual(FixedDateNode.NodeName, "lsn_fixeddate") then
    LastDayOfMonth = GetSafeAttribute(FixedDateNode, "lastdayofmonth") = "1"
  end if
end function

function RequiredWeekDay(FixedDateNode)
  RequiredWeekDay = False
  if StringsEqual(FixedDateNode.NodeName, "lsn_fixeddate") then
    RequiredWeekDay = GetSafeAttribute(FixedDateNode, "requiredweekday") <> "0"
  end if
end function

function IsLeapYear(AYear)
  IsLeapYear = (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0))  
end function



