<% Function echo(sContent) Response.Write(sContent) End Function Function base64_encode(inData) 'rfc1521 '2001 Antonin Foller, Motobit Software, http://Motobit.cz Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim cOut, sOut, I 'For each group of 3 bytes For I = 1 To Len(inData) Step 3 Dim nGroup, pOut, sGroup 'Create one long from this 3 bytes. nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _ &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1)) 'Oct splits the long To 8 groups with 3 bits nGroup = Oct(nGroup) 'Add leading zeros nGroup = String(8 - Len(nGroup), "0") & nGroup 'Convert To base64 pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _ Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1) 'Add the part To OutPut string sOut = sOut + pOut 'Add a new line For Each 76 chars In dest (76*3/4 = 57) 'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf Next Select Case Len(inData) Mod 3 Case 1: '8 bit final sOut = Left(sOut, Len(sOut) - 2) + "==" Case 2: '16 bit final sOut = Left(sOut, Len(sOut) - 1) + "=" End Select base64_encode = sOut End Function Function MyASC(OneChar) If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar) End Function Function base64_decode(ByVal base64String) 'rfc1521 '1999 Antonin Foller, Motobit Software, http://Motobit.cz Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim dataLength, sOut, groupBegin 'remove white spaces, If any base64String = Replace(base64String, vbCrLf, "") base64String = Replace(base64String, vbTab, "") base64String = Replace(base64String, " ", "") 'The source must consists from groups with Len of 4 chars dataLength = Len(base64String) If dataLength Mod 4 <> 0 Then Err.Raise 1, "Base64Decode", "Bad Base64 string." Exit Function End If ' Now decode each group: For groupBegin = 1 To dataLength Step 4 Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut ' Each data group encodes up To 3 actual bytes. numDataBytes = 3 nGroup = 0 For CharCounter = 0 To 3 ' Convert each character into 6 bits of data, And add it To ' an integer For temporary storage. If a character is a '=', there ' is one fewer data byte. (There can only be a maximum of 2 '=' In ' the whole string.) thisChar = Mid(base64String, groupBegin + CharCounter, 1) If thisChar = "=" Then numDataBytes = numDataBytes - 1 thisData = 0 Else thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1 End If If thisData = -1 Then Err.Raise 2, "Base64Decode", "Bad character In Base64 string." Exit Function End If nGroup = 64 * nGroup + thisData Next 'Hex splits the long To 6 groups with 4 bits nGroup = Hex(nGroup) 'Add leading zeros nGroup = String(6 - Len(nGroup), "0") & nGroup 'Convert the 3 byte hex integer (6 chars) To 3 characters pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _ Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _ Chr(CByte("&H" & Mid(nGroup, 5, 2))) 'add numDataBytes characters To out string sOut = sOut & Left(pOut, numDataBytes) Next base64_decode = sOut End Function Function substr(sContent,iStart,iEnd) iLen = iEnd - iStart substr = Mid(sContent,iStart,iLen) End Function Function TrimL(sContent,iLen) iLen = iLen + 1 sReturn = Mid(sContent,iLen,Len(sContent)) TrimL = sReturn End Function Function TrimR(sContent,iLen) sReturn = Mid(sContent,1,Len(sContent)-iLen) TrimR = sReturn End Function Function Alert(sMessage) Response.Write("") End Function Function IsHome() If Request.QueryString("id") = "" AND Request.QueryString("controller") = "" AND Request.QueryString("view") = "" Then IsHome = true Else IsHome = false End If End Function Function Nav(sName) sName = "?controller=pages&view=load&id=" & sName Nav = sName End Function Function URL(sController,sView,iID) URL = "?controller="&sController&"&view="&sView&"&id=" & iID End Function Function URL2(sController,sView,iID,sVars) URL2 = C_SITE_ROOT & "/?controller="&sController&"&view="&sView&"&id=" & iID & "&" & sVars End Function Function AlertMessage(sMessage) sReturn = "" sReturn = sReturn & "
" sReturn = sReturn & "

" sReturn = sReturn & sMessage & "

" sReturn = sReturn & "
" AlertMessage = sReturn End Function Function ErrorMessage(sMessage) sReturn = "" sReturn = sReturn & "
" sReturn = sReturn & "

" sReturn = sReturn & sMessage & "

" sReturn = sReturn & "
" ErrorMessage = sReturn End Function Function ConvertToDate(sDate) sReturn = "" iYear = Left(sDate,4) iMonth = Mid(sDate,5,2) iDay = Mid(sDate,7,2) sReturn = cDate(iYear & "-" & iMonth & "-" & iDay) sReturn = FormatDateTime(sReturn,2) ConvertToDate = sReturn End Function Function ASP(sCode) sCode = Replace(sCode,"[[","<") sCode = Replace(sCode,"]]",">") ASP = sCode End Function Function DoSplit(sContent) DoSplit = Split(sContent,"|||") End Function Function LOOKUP(aData) End Function function Ceil( Number ) Ceil = Int( Number ) if Ceil <> Number then Ceil = Ceil + 1 end if end function function Floor( Number ) Floor = Int( Number ) end function Function stripHTML(strHTML) 'Strips the HTML tags from strHTML Dim objRegExp, strOutput Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True objRegExp.Pattern = "<(.|\n)+?>" 'Replace all HTML tag matches with the empty string strOutput = objRegExp.Replace(strHTML, "") 'Replace all < and > with < and > strOutput = Replace(strOutput, "<", "<") strOutput = Replace(strOutput, ">", ">") stripHTML = strOutput 'Return the value of strOutput Set objRegExp = Nothing End Function %>