<%
' Last Updated 19 May 2006
' Jonathan Maxwell

Function FormatPageTitle(PageName)
	' Checks ascii values of each letter
	' and replaces with a space for capital letter
	' 65-90 = CAPS, 97-122 = Lcase
	
	dim CurrentLetter, PageTitle
	dim i, j
	for i = 0 to len(PageName)
		CurrentLetter = mid(PageName, i+1, 1)
		for j = 65 to 90
			if CurrentLetter = Chr(j) then PageTitle = PageTitle & " ":exit for		
		next
		PageTitle = PageTitle & CurrentLetter
	next
	
	FormatPageTitle = PageTitle

End Function

Function URLDecode(str)
	' An inverse to Server.URLEncode
	' URLDecodeHex required
	dim re
	set re = new RegExp

	str = Replace(str, "+", " ")
	
	re.Pattern = "%([0-9a-fA-F]{2})"
	re.Global = True
	URLDecode = re.Replace(str, GetRef("URLDecodeHex"))
End Function


Function URLDecodeHex(match, hex_digits, pos, source)
	' Replacement function for the above
	URLDecodeHex = chr("&H" & hex_digits)
End Function

Function mmEncode(strMemberPassword)
	' Weak encryption method
	dim strEncodeCode
	strEncodeCode = trim(strMemberPassword)
	strEncodeCode = StrReverse(strEncodeCode)
	strEncodeCode = strEncodeCode & "qrULG883Ld7GY988dKJK22"
	mmEncode = strEncodeCode
End Function

Function mmDecode(strMemberPassword)
	' Weak decryption method
	dim strDecodeCode, intStrLeft
	strDecodeCode = trim(strMemberPassword)
	strDecodeCode = StrReverse(strDecodeCode)
	intStrLeft = 23
	strDecodeCode = mid(strDecodeCode,intStrLeft, len(strDecodeCode))
	
	mmDecode = strDecodeCode
End Function

Function StringToBinary(String) 
  Dim I, B 
  For I=1 to len(String) 
    B = B & ChrB(Asc(Mid(String,I,1))) 
  Next 
  StringToBinary = B 
End Function 


Function BinaryToString(Binary) 
  '2001 Antonin Foller, PSTRUH Software 
  'Optimized version of PureASP conversion function 
  'Selects the best algorithm to convert binary data to String data 
  Dim TempString 


  On Error Resume Next 
  'Recordset conversion has a best functionality 
  TempString = RSBinaryToString(Binary) 
  If Len(TempString) <> LenB(Binary) then'Conversion error 
    'We have to use multibyte version of BinaryToString 
    TempString = MBBinaryToString(Binary) 
  end if 
  BinaryToString = TempString 
End Function 


Function MBBinaryToString(Binary) 
  '1999 Antonin Foller, PSTRUH Software 
  'MultiByte version of BinaryToString function 
        'Optimized version of simple BinaryToString algorithm. 
  dim cl1, cl2, cl3, pl1, pl2, pl3 
  Dim L', nullchar 
  cl1 = 1 
  cl2 = 1 
  cl3 = 1 
  L = LenB(Binary) 


  Do While cl1<=L 
    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1))) 
    cl1 = cl1 + 1 
    cl3 = cl3 + 1 
    if cl3>300 then 
      pl2 = pl2 & pl3 
      pl3 = "" 
      cl3 = 1 
      cl2 = cl2 + 1 
      if cl2>200 then 
        pl1 = pl1 & pl2 
        pl2 = "" 
        cl2 = 1 
      End If 
    End If 
  Loop 
  MBBinaryToString = pl1 & pl2 & pl3 
End Function 


Function RSBinaryToString(xBinary) 
  '1999 Antonin Foller, PSTRUH Software 
  'This function converts binary data (VT_UI1 | VT_ARRAY or MultiByte string) 
        'to string (BSTR) using ADO recordset 
        'The fastest way - requires ADODB.Recordset 
        'Use this function instead of MBBinaryToString if you have ADODB.Recordset installed 
        'to eliminate problem with PureASP performance 


        Dim Binary 
        'MultiByte data must be converted to VT_UI1 | VT_ARRAY first. 
        if vartype(xBinary) = 8 then Binary = MultiByteToBinary(xBinary) else 
Binary = xBinary 


  Dim RS, LBinary 
  Const adLongVarChar = 201 
  Set RS = CreateObject("ADODB.Recordset") 
  LBinary = LenB(Binary) 


        if LBinary>0 then 
                RS.Fields.Append "mBinary", adLongVarChar, LBinary 
                RS.Open 
                RS.AddNew 
                        RS("mBinary").AppendChunk Binary 
                RS.Update 
                RSBinaryToString = RS("mBinary") 
        Else 
                RSBinaryToString = "" 
        End If 
End Function 


Function MultiByteToBinary(MultiByte) 
  ' This function converts multibyte string to real binary data (VT_UI1 | VT_ARRAY) 
  ' Using recordset 
  Dim RS, LMultiByte, Binary 
  Const adLongVarBinary = 205 
  Set RS = CreateObject("ADODB.Recordset") 
  LMultiByte = LenB(MultiByte) 
        if LMultiByte>0 then 
                RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte 
                RS.Open 
                RS.AddNew 
                        RS("mBinary").AppendChunk MultiByte & ChrB(0) 
                RS.Update 
                Binary = RS("mBinary").GetChunk(LMultiByte) 
        End If 
  MultiByteToBinary = Binary 
End Function 

Function GetContent(Content,ContentStart,ContentEnd)
	' Gets text from string e.g. GetContent("xxx here is text yyy","xxx","yyy")
	dim TempContent, TempContentStart, TempContentEnd
	TempContentStart = Content
	if TempContentStart = "" then exit function
	
	TempContentStart = instr(Content, ContentStart)
	TempContentEnd = instr(Content, ContentEnd)
	
	if TempContentStart > 0 and TempContentEnd > 0 then
		TempContent = mid(Content,(TempContentStart+len(ContentStart)),(TempContentEnd-(TempContentStart+len(ContentStart))))
	end if
	
	GetContent = TempContent

End Function

%>