<%
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
ElseIf Request.QueryString("id") = "home" Then
IsHome = True
Else
IsHome = false
End If
End Function
Function Nav(sName)
If C_FRIENDLY = True Then
sName = C_SITE_ROOT & "/pages/load/" & sName
Else
sName = C_SITE_ROOT & "/?controller=pages&view=load&id=" & sName
End If
Nav = sName
End Function
Function OnPage(sName)
If trim(Request.QueryString("id")) = trim(sName) Then
OnPage = true
Else
OnPage = false
End If
End Function
Function DoSplit(sContent)
DoSplit = Split(sContent,"|||")
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 IsNothing(sVar)
sVar = CStr(sVar)
If sVar = "" OR sVar = "0" OR IsNull(sVar) Then
IsNothing = True
Else
IsNothing = False
End If
End Function
Function IsSet(sVar)
sVar = CStr(sVar)
'Response.Write("#" & sVar & "#")
If sVar <> "" Then
IsSet = True
Else
IsSet = False
End If
End Function
Function UFirst(ByVal str)
Dim intI, arrTmp
arrTmp = Split(str, " ")
str = ""
For intI = 0 To Ubound(arrTmp)
str = str & UCase(Left(arrTmp(intI), 1)) & Right(arrTmp(intI), Len(arrTmp(intI)) - 1) & " "
Next
UFirst = Trim(str)
End Function
Function URL(sController,sView,iID)
If C_FRIENDLY Then
URL = C_SITE_ROOT & "/"&sController&"/"&sView&"/" & iID
Else
URL = C_SITE_ROOT & "/online.asp?controller="&sController&"&view="&sView&"&id=" & iID
End If
End Function
Function URL2(sController,sView,iID,sVars)
If C_FRIENDLY Then
URL2 = C_SITE_ROOT & "/"&sController&"/"&sView&"/" & iID & "/" & sVars
Else
URL2 = C_SITE_ROOT & "/online.asp?controller="&sController&"&view="&sView&"&id=" & iID & "&" & sVars
End If
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 Escape(sVar)
sVar = Replace(sVar,"'","")
sVar = Replace(sVar," ","-")
Escape = sVar
End Function
Function Input(sName,sVal)
Input = ""
End Function
Function NumOccur(sHay, sNeedle)
aReturn = Split(sHay,sNeedle)
NumOccur = uBound(aReturn)
End Function
Function InArray(aArray,sKey)
blnReturn = False
If IsArray(aArray) Then
For Each Item in aArray
If Trim(sKey) = Trim(Item) Then
blnReturn = True
End If
Next
End If
InArray = blnReturn
End Function
Function RemoveIndex(aArray,sIndex)
intLength = uBound(aArray) + 1
Dim aNewArray()
Redim aNewArray(intLength)
intCounter = 0
If IsNumeric(sIndex) Then
For i = 0 to intLength - 1
If i <> sIndex Then
aNewArray(intCounter) = aArray(i)
intCounter = intCounter + 1
End If
Next
Else
For Each Item in aArray
Response.Write(Item & " ")
If Trim(Item) <> Trim(sIndex) Then
aNewArray(intCounter) = Item
Response.Write(aNewArray(intCounter) & " ")
'Response.Write(Item & " ")
intCounter = intCounter + 1
End If
Next
End If
Redim Preserve aNewArray(intCounter + 1)
RemoveIndex = aNewArray
End Function
Function HasKey(aArray,sKey)
HasKey = False
If HasKey = False Then
For Each Item in aArray
If aArray(sKey) <> "" And aArray(sKey) <> "0" Then
HasKey = True
Else
HasKey = False
End If
Next
Else
HasKey = True
End If
End Function
Function Validate(sVar)
sVar = cStr(sVar)
If sVar = "" Then
Validate = False
Else
Validate = True
End If
End Function
Function CheckRequired(aArray,aFields)
blnReturn = True
aFields = Split(aFields,",")
For Each Item in aFields
If blnReturn = True Then
If HasKey(aArray,Item) Then
blnReturn = True
Else
blnReturn = False
End If
End If
Next
If blnReturn = True Then
CheckRequired = True
Else
sReturn = ""
For Each Item in aArray
sReturn = sReturn & Item & "=" & aArray(Item) & "&"
Next
sReturn = Mid(sReturn,1,Len(sReturn) - 1)
CheckRequired = sReturn
End If
End Function
Function Rewrite(sString)
sString = Replace(sString,"&","and")
sString = LCase(Replace(sString," ","-"))
Rewrite = sString
End Function
Function HTMLDecode(sInput)
sReturn = ""
If sInput <> "" Then
sReturn = Replace(sInput,"%0D",VbCr)
sReturn = Replace(sReturn,"%0A",VbLf)
sReturn = Replace(sReturn,"%2C",",")
sReturn = Replace(sReturn,"%26","&")
sReturn = Replace(sReturn,"%20"," ")
sReturn = Replace(sReturn,"%40","@")
sReturn = Replace(sReturn,"+"," ")
sReturn = Replace(sReturn,VbCRLf," ")
End If
HTMLDecode = sReturn
End Function
%>