")
isHumanSubmitted=false
else
isHumanSubmitted=true
end if
end function
'# Get browser version number
Function GetBrowserVersion()
Dim arrTemp,Agent,vrs,x,arrBrs,ii
vrs=-1
Agent=lcase(Request.ServerVariables("HTTP_USER_AGENT"))
if Agent="" then
vrs = ""
else
Select Case GetBrowserType()
Case "IE"
arrTemp = split(Agent, ";")
vrs = trim(replace(arrTemp(1), "msie", ""))
Case "FF"
arrTemp = split(Agent, ") ")
arrBrs=split(arrTemp(1)," ")
x=0
while x<=uBound(arrBrs)
if left(arrBrs(x),8) = "firefox/" then
vrs = mid(arrBrs(x), 9)
end if
x=x+1
wend
Case "NS"
arrTemp = split(Agent, ") ")
arrBrs=split(arrTemp(1)," ")
x=0
while x<=uBound(arrBrs)
if left(arrBrs(x),9) = "netscape/" then
'Response.Write "XXX: " & arrBrs(x) & " "
vrs = mid(arrBrs(x), 10)
end if
x=x+1
wend
Case "OP"
arrTemp = split(Agent, " ")
if left(arrTemp(0),6) = "opera/" then
vrs = mid(arrTemp(0), 7)
end if
Case else
'# could be a robot or unknown browser
'# so let them see the good site
vrs = ""
End Select
end if
GetBrowserVersion=vrs
End Function
'# Get operating system browser is on.
Function GetBrowserOS()
Dim arrTemp,Agent,os,begs,ends
Agent=Request.ServerVariables("HTTP_USER_AGENT")
if Agent="" then
GetBrowserOS=""
else
Select Case GetBrowserType()
Case "OP"
begs = instr( Agent, "(" ) + 1
ends = instr( Agent, ";" ) - begs
os = mid(Agent,begs,ends)
case else
arrTemp = split(Agent, ";")
os = trim(arrTemp(2))
end Select
GetBrowserOS=os
end if
End Function
Sub Mail_VCard(SenderName, SenderEmail, EmailName, EmailAdd, MainText)
sBodyText = "
" _
& "
" _
& Replace(MainText, vbCrLf, " ") _
& "
" _
& "
BengalOnline Virtual Cards
"
'blnSuccess = objMailer.SendMail
'Set objMailer = Nothing
Subject="BOVC: BengalOnline Virtual Card From: " & SenderName & "<" & SenderEmail & ">"
strBcc=smAddress
strCC=""
strAttacedFile=""
blnHtml=True
blnSuccess=CDONTS_SendMail(EmailName & "<" & EmailAdd & ">", siteMainAddress, strCC, strBcc, 1, Subject, sBodyText, strAttacedFile, blnHtml)
End Sub
function CDONTS_SendMail(sTo, sFrom, sCC, sBcc, sPriority, sSubject, sBody, sAttachment, bHTML)
CDONTS_SendMail = SendEmail( "", sFrom, sTo, sCc, sBcc, sSubject, sBody, sAttachment)
end function
function SendEmail( frmName, fromEmail, toEmail, cc, bcc, subject, msg, att)
On Error resume Next
Dim oMail,oConfig
' Create a new mail object set up its configuration
Set oMail = CreateObject("CDO.Message")
Set oConfig = Server.CreateObject("CDO.Configuration")
Set oFields = oConfig.Fields
With oFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "127.0.0.1"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") ="webmaster@sitemarvel.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="stx_%m"
.Update
End With
'==End remote SMTP server configuration section==
With oMail
Set .Configuration = oConfig
.From = fromName & "<" & fromEmail & ">"
.To = toEmail
.Subject = subject
.HtmlBody = msg
.CC = cc
.BCC = bcc
if not att="" then
.AddAttachment att
end if
End With
Err.Clear
if left(Request.ServerVariables("SERVER_NAME"),6)="stage." then
Response.Write "Mail cannot be sent from this computer. Instead we are displaying the message here:
" _
& replace(BodyText,vbcrlf," ")
SendEmail = true
else
oMail.Send
if Err then
Set oMail = Nothing
'e=ReportError(Request.ServerVariables("HTTP_Referer"),"common.asp - SendEmail utility failed", err)
'response.redirect "errHandler.asp"
Response.Write "
Error!
" & err.Description & "
The above error prevented eMail being sent to the receiepient.
"
SendEmail = False
else
Set oMail = Nothing
SendEmail = True
end if
end if
end function
Sub AutoRespond(EmailName, EmailAdd, MainText, Subject)
sBodyText = "
"
strBcc=smAddress
strCC=""
strAttacedFile=""
blnHtml=True
blnSuccess=CDONTS_SendMail(EmailAdd, siteMainAddress, strCC, strBcc, 1, Subject, sBodyText, strAttacedFile, blnHtml)
End Sub
Sub AddToMailList(FName, LName, Email, Update, DataConn)
Dim objListRS, objList2RS, strSelect
'& "first_name = '" & Trim(FName) & "' AND " _
'& "last_name = '" & Trim(LName) & "' AND " _
strSelect = "SELECT * FROM tblMailList WHERE " _
& "email = '" & Trim(Email) & "'"
Set objListRS = Server.CreateObject("ADODB.RecordSet")
' Response.Write strSelect
objListRS.Open strSelect, DataConn, 1, 1
If objListRS.EOF Then
strSelect = "INSERT INTO tblMailList (last_name, first_name, email, updates) VALUES " _
& "('" & Trim(LName) & "', '" & Trim(FName) & "', '" & Trim(Email) & "', "
If Update Then
strSelect = strSelect & "1)"
Else
strSelect = strSelect & "0)"
End If
Set objList2RS = DataConn.Execute(strSelect)
Else
If Update Then
strSelect = "UPDATE tblMailList SET updates = 1 WHERE client_ID = " & objListRS("client_ID")
Set objList2RS = DataConn.Execute(strSelect)
End If
End If
objListRS.Close
Set objList2RS = Nothing
Set objListRS = Nothing
End Sub
Function PutTabLink(sTargetLink, sLinkText)
Dim sRV, dQuote
sRV = "
" _
& "
"
If Trim(sTargetLink) = "" Then
sRV = sRV & Trim(sLinkText)
Else
sRV = sRV & "" & LCase(sLinkText) & ""
End If
sRV = sRV & "
" _
& "
"
PutTabLink = sRV
End Function
Function Line(pelWide, pelHigh, color)
Line = "
"
End Function
Function DottedLine(pelHigh)
Dim colorStr
colorStr = " bgcolor=#ffffff"
DottedLine = "
"
End Function
Function OpStatus(sTitle, subTitle, sMsg)
Dim sRV
OpStatus = "
" _
& FormHead(sTitle, subTitle) & "
" & sMsg & "
"
End Function
Public Function CheckServerDateFormat()
Dim strDateFormat
If Month("01/05/1999") = 5 Then ' ***** The server is returning the second part of the
strDateFormat = "UK" ' date as the month, therefore UK date format
ElseIf Month("01/05/1999") = 1 Then ' ***** The server is returning the first part of the
strDateFormat = "US" ' date as the month, therefore US date format
Else ' ***** it's not returning either - something is not
strDateFormat = "What???" ' working right
End If
CheckServerDateFormat = strDateFormat
End Function
' --------------------------------------------------------------------------------------------
' *** FUNCTION ConvertDateYYYY as STRING
' This function (added on 16/06/1999) is used to convert a date into a date format with a four
' digit year code. CDate only returns 2 digit year codes.
Public Function ConvertDateYYYY(DateIn)
Dim strYear, arrDate, strDate
strDate = CDate(DateIn)
strYear = DatePart("yyyy", DateIn)
arrDate = Split(strDate,"/")
ConvertDateYYYY = arrDate(0) & "/" & arrDate(1) & "/" & strYear
End Function
Function IsDateDMY(InDate)
Dim blnDMY, arrDate
blnDMY = False
arrDate = Split(InDate, "/")
If UBound(arrDate) <> 3 Then
arrDate = Split(InDate, "-")
End If
If UBound(arrDate) = 3 Then
If CInt(arrDate(0)) > 12 Then
blnDMY = True
End If
End If
IsDateDMY = blnDMY
End Function
Function IsDateMDY(InDate)
Dim blnMDY, arrDate
blnMDY = False
arrDate = Split(InDate, "/")
If UBound(arrDate) <> 3 Then
arrDate = Split(InDate, "-")
End If
If UBound(arrDate) = 3 Then
If CInt(arrDate(1)) > 12 Then
blnMDY = True
End If
End If
IsDateMDY = blnMDY
End Function
' --------------------------------------------------------------------------------------------
' *** FUNCTION ValidDay as BOOLEAN
' This function (added on 2000-01-27) is used to check whether a valid day is being used for
' any given month and year combination (year is only used to verify February)
Public Function ValidDay(DayNum, MonthNum, YearNum, ByRef ErrorMsg)
Dim blnValid
blnValid = True
ErrorMsg = ""
Select Case MonthNum
Case 2
If (YearNum Mod 4) = 0 Then
If(YearNum Mod 100) = 0 Then
If (YearNum Mod 400) = 0 Then
If DayNum > 29 Then
ErrorMsg = "February has only 29 Days in the Year " & CStr(YearNum)
blnValid = False
End If
Else
If DayNum > 28 Then
ErrorMsg = "February has only 28 Days in the Year " & CStr(YearNum)
blnValid = False
End If
End If
Else
If DayNum > 29 Then
ErrorMsg = "February has only 29 Days in the Year " & CStr(YearNum)
blnValid = False
End If
End If
Else
If DayNum > 28 Then
ErrorMsg = "February has only 28 Days in the Year " & CStr(YearNum)
blnValid = False
End If
End If
Case 4, 6, 9, 11
If DayNum > 30 Then
ErrorMsg = MonthName(MonthNum) & " has only 30 days"
blnValid = False
End If
Case Else
If DayNum > 31 Then
ErrorMsg = MonthName(MonthNum) & " has only 31 days"
blnValid = False
End If
End Select
If DayNum < 1 Then
ErrorMsg = "Invalid day"
blnValid = False
End If
ErrorMsg = UCase(ErrorMsg)
ValidDay = blnValid
End Function
' --------------------------------------------------------------------------------------------
' *** FUNCTION ISOConvert As STRING
' Use this function where you have a integer month, integer day and integer year.
' this will return ISO format of the combination of the three
'
' strISODate = ISOConvert([dayvariable],[monthvariable],[yearvariable])
'
' strISODate will be the date in ISO format
Public Function ISOConvert(DayNum, MonthNum, YearNum)
Dim strReturn, strError
strReturn = ""
strError = ""
If Not IsNumeric(Trim(DayNum)) Or _
Not IsNumeric(Trim(MonthNum)) Or _
Not IsNumeric(Trim(YearNum)) Or _
Not Len(Trim(YearNum)) = 4 Then
strReturn = "INVALID PARAMETERS"
Else
If CInt(Trim(MonthNum)) > 12 Or CInt(Trim(MonthNum)) < 1 Then
strReturn = "INVALID MONTH"
ElseIf Not ValidDay(CInt(Trim(DayNum)), CInt(Trim(MonthNum)), CInt(Trim(YearNum)), strError) Then
strReturn = strError
Else
strReturn = Trim(YearNum) & "-" & Right("0" & MonthNum, 2) & "-" & Right("0" & DayNum , 2)
End If
End If
ISOConvert = strReturn
End Function
' --------------------------------------------------------------------------------------------
' *** FUNCTION ConvertToISODate as STRING
' Use this function where you have any date which VB can interpret as a date, or if you have a
' month in MMM (eg "Jan") format. If this is the case make a variable and use:
'
' strTempDate = [dayvariable] & " " & [monthvariable] & " " & [yearvariable]
' strISODate = ConvertToISODate(strTempDate)
'
' If you have a date VB understands, use:
'
' strISODate = ConvertToISODate([datevariable])
'
' strISODate will be the date in ISO format.
' ##NB - VB IS UNABLE TO INTERPRET IT'S OWN LONG DATE FORMAT (ie formatdatetime(datevar,1)) ##
Public Function ConvertToISODate(VBDate)
Dim strReturnDate ' variable to hold return string
Dim arrDate ' array to hold date
Dim strDate
'On Error Resume Next
If VBDate="" Then ' if it's an empty string, return null
strReturnDate = "NULL"
ElseIf IsDate(VBDate) Then
strDate = ConvertDateYYYY(VBDate)
arrDate = Split(strDate, "/")
If IsDateMDY(strDate) Then ' if it is a us date format
strReturnDate = ISOConvert(arrDate(1), arrDate(0), arrDate(2))
ElseIf IsDateDMY(strDate) Then ' if it is a uk date format
strReturnDate = ISOConvert(arrDate(0), arrDate(1), arrDate(2))
Else
strReturnDate = "INVALID DATE"
End If
Else ' it's something undecipherable - spit back error msg.
strReturnDate = "INVALID DATE"
End If
ConvertToISODate = strReturnDate
End Function
Function NullEmptyString(Instring)
if trim(Instring) = "" then
NullEmptyString = Null
else
NullEmptyString = trim(Instring)
end if
End Function
Function EscapeQuotes(Instring)
dim temp
temp = Replace(InString,"'","'")
temp = Replace(temp,chr(34),""")
temp = Replace(temp,chr(96),"`")
EscapeQuotes = trim(temp)
End Function
Function ReplaceVbCrlf(Instring)
Instring = Replace(Instring, "" & Vbcrlf, " ")
'response.write Instring
ReplaceVbcrlf = Instring
End Function
Function MakeSQLString(Instring)
x = EscapeQuotes(Instring)
' Response.Write x
If isNull(x) then
MakeSQLString = "'" & "" & "'" '"NULL"
Else
MakeSQLString = "'" & x & "'"
End if
End Function
Function MakeSQLInt(Instring)
Dim strInt
strInt = NullEmptyString(Instring)
If IsNull(strInt) Then
MakeSQLInt = "NULL"
Else
MakeSQLInt = strInt
End If
End Function
Function MakeISODate(Year, Month, Day)
Dim strDay, strMonth
If Not Len(Year) = 4 Then
MakeISODate = "NULL" '"ERROR - Not 4 digit year"
Else
strDay = Right("0" & Day, 2)
strMonth = Right("0" & Month, 2)
MakeISODate = Year & "-" & strMonth & "-" & strDay
End If
End Function
Function SQLDate(InDate)
Dim strMonth, strDay, strYear
' Response.Write InDate
arrDate = Split(InDate, "/")
If UBound(arrDate) <> 3 Then
arrDate = Split(InDate, "-")
End If
If IsDateDMY(InDate) Then
strDay = arrDate(0)
strMonth = arrDate(1)
strYear = DatePart("yyyy", InDate)
ElseIf IsDateMDY(InDate) Then
strDay = arrDate(1)
strMonth = arrDate(0)
strYear = DatePart("yyyy", InDate)
Else
strMonth = Month(InDate)
strDay = Day(InDate)
strYear = DatePart("yyyy", InDate)
End If
SQLDate = MakeISODate(strYear, strMonth, strDay)
End Function
function iif(condition,a,b)
' Response.Write condition
if condition then
iif=a
else
iif=b
end if
end function
' --------------------------------------------------------------------------------------------
Function MsgAppend(Msg, NewString)
Dim strMsg
If Trim(Msg) = "" Then
strMsg = NewString
Else
strMsg = Msg & " " & NewString
End If
MsgAppend = strMsg
End Function
' --------------------------------------------------------------------------------------------
Sub DropDownSelector(selname, srcFileName, srcIdField, srcDescField, groop, DataConn)
Dim strSelect, objDDRS, currentSelection
strSQL = "SELECT * FROM " & srcFileName & " where cat_group = '" & groop & "'" & " ORDER BY " & srcDescField
'Response.Write(strSQL)
Set objDDRS = Server.CreateObject("ADODB.RecordSet")
objDDRS.Open strSQL, DataConn, 1, 1
If Not objDDRS.EOF Then %>
<%
End If
objDDRS.Close
Set objDDRS = Nothing
End Sub
Sub CountryDropDown(Connection, ID, fldname)
Dim objRSCntry, objCommCntry
Set objCommCntry = Server.CreateObject("ADODB.Command")
Set objRSCntry = Server.CreateObject("ADODB.RecordSet")
objCommCntry.ActiveConnection = Connection
objCommCntry.CommandType = 4
objCommCntry.CommandText = "stpSelectCountries"
objRSCntry.CursorLocation = 3
objRSCntry.CursorType = 2
objRSCntry.LockType = 2
Set objRSCntry = objCommCntry.Execute
If Not objRSCntry.EOF Then
'Response.Write "
![](" & "/images/blank.gif" & "){kind=spacer}