UName10
asked on
Database Error: Microsoft VBScript runtime error '800a000d' Type mismatch: '[string: ""]'
I'm getting the error on this page here, where I added the start time and end times:
Microsoft VBScript runtime error '800a000d'
Type mismatch: '[string: ""]'
/Admin/FranchiseAdmin/CommunityArticles/AddArticle.asp, line 43
<%
on error resume next
Set upload = Server.CreateObject("Persits.Upload")
upload.CodePage = 65001
upload.save
on error goto 0
%>
<!--#include virtual="/System/Startup_Admin.asp"-->
<!--#include virtual="/Admin/FranchiseAdmin/ContentEditor/i_EditContent.asp"-->
<%
getrs rs,"SELECT * FROM CommunityArticles WHERE ca_franchise = '"&session("AdminFranchiseGID")&"' AND ca_id = '"&cint(request.querystring("delarticle"))&"';",""
if ""&request.querystring("action") = "add" then
path = server.MapPath("/LiveStorage/Uploads/image/CommunityArticles/")&"\"
set file = upload.files("thumbimg")
if not file is nothing then
thumbfile = getguid & file.ext
file.saveas path&thumbfile
end if
set file = upload.files("fullimg")
if not file is nothing then
fullimg = getguid & file.ext
file.saveas path&fullimg
end if
set sql = new sql_insert
with sql
.table = "CommunityArticles"
.addparam "ca_franchise",Session("AdminFranchiseGID"),""
.addparam "ca_title",trim(""&getform("title")),""
.addparam "ca_location",trim(""&getform("location")),""
.addparam "ca_address1",trim(""&getform("address1")),""
.addparam "ca_address2",trim(""&getform("address2")),""
.addparam "ca_town",trim(""&getform("town")),""
.addparam "ca_county",trim(""&getform("county")),""
.addparam "ca_postcode",trim(""&getform("postcode")),""
.addparam "ca_category","",cint(""&getform("category"))
.addparam "ca_startdate","","'"&getform("startdate_Day") & " " & monthname(getform("startdate_Month")) & " " & getform("startdate_Year")&"'"
.addparam "ca_enddate","","'"&getform("enddate_Day") & " " & monthname(getform("enddate_Month")) & " " & getform("enddate_Year")&"'"
.addparam "ca_starttime","","'"&getform("starttime_Hour") & " " & minute(getform("starttime_Min")) & "'"
.addparam "ca_endtime","","'"&getform("endtime_Hour") & " " & minute(getform("endtime_Min")) & "'"
.addparam "ca_summary",""&getform("summary"),""
.addparam "ca_article",""&getform("article"),""
.addparam "ca_thumbnail",""&thumbfile,""
.addparam "ca_fullimage",""&fullimg,""
.run
end with
set sql = nothing
response.redirect "Default.asp"
end if
%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Inside-Guides.co.uk - Community Article Administration</title>
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/HeadCSS.asp"-->
<script type="text/javascript" src="/system/ckeditor/ckeditor.js"></script>
<script type="text/javascript" src="/system/ckeditor/adapters/jquery.js"></script>
<script type="text/javascript">
CKEDITOR.config.width ='550px';
CKEDITOR.config.toolbar = 'Basic';
</script>
<script type="text/javascript">
$(window).load(function(){
$('.ckeditor').ckeditor( function() { /* callback code */ }, { toolbar: 'Basic' } );
});
</script>
</head>
<body>
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/TemplateStart.asp"-->
<br />
<h1><%Response.Write(Session("AdminFranchiseName"))%> Community: Add a New Article</h1>
<br />
<br /><br />
<% If Not Session("Role_Franchise_ManageContent") then AccessDenied %>
<span class="ErrorText"><% = strUserError %></span>
<form name="EditForm" id="EditForm" method="post" action="AddArticle.asp?Action=add" enctype="multipart/form-data">
<table>
<tr>
<th align="left" valign="top" width="200">
Title:
</th>
<th align="left" valign="top">
<input type="text" name="title" id="title" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Location</th>
<th align="left" valign="top">
<input type="text" name="location" id="location" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Address 1</th>
<th align="left" valign="top">
<input type="text" name="address1" id="address1" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Address 2</th>
<th align="left" valign="top">
<input type="text" name="address2" id="address2" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Town</th>
<th align="left" valign="top">
<input type="text" name="town" id="town" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">County</th>
<th align="left" valign="top">
<input type="text" name="county" id="county" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Postcode</th>
<th align="left" valign="top">
<input type="text" name="postcode" id="postcode" style="width:97%;" />
</th>
</tr>
<tr>
<th align="left" valign="top">Start Date</th>
<th align="left" valign="top">
<% CreateDateSelectionBox "startdate", NOW, False %>
</th>
</tr>
<tr>
<th align="left" valign="top">Category</th>
<th align="left" valign="top">
<select name="category" id="category">
<option value=""></option>
<% getrs tmp,"SELECT * FROM CommunityArticleCategories ORDER BY cac_category;",""
while not tmp.eof %>
<option value="<%=server.HTMLEncode(""&tmp("cac_id"))%>"><%=server.HTMLEncode(""&tmp("cac_category"))%></option>
<% tmp.movenext : wend %>
</select>
</th>
</tr>
<tr>
<th align="left" valign="top">End Date (optional)</th>
<th align="left" valign="top">
<% CreateDateSelectionBox "enddate", NOW, False %>
</th>
</tr>
<tr>
<th align="left" valign="top">Start Time</th>
<th align="left" valign="top">
<% CreateDateTimeSelectionBox "starttime", NOW, False %>
</th>
</tr>
<tr>
<th align="left" valign="top">End Time</th>
<th align="left" valign="top">
<% CreateDateTimeSelectionBox "endtime", NOW, False %>
</th>
</tr>
<tr>
<th align="left" valign="top">Summary</th>
<th align="left" valign="top"> <textarea name="summary" id="summary" style="border:1px solid #888;" maxlength="255"></textarea>
</th>
</tr>
<tr>
<th align="left" valign="top">Full Article</th>
<th align="left" valign="top">
<textarea name="article" class="ckeditor" rows="40" id="article" style="border:1px solid #888;"></textarea>
<script type="text/javascript">
CKEDITOR.replace( 'article',
{
toolbar : 'article',
});
</script>
</th>
</tr>
<tr>
<th align="left" valign="top">Thumbnail Image</th>
<th align="left" valign="top">
<input type="file" name="thumbimg" id="thumbimg" />
</th>
</tr>
<tr>
<th align="left" valign="top">Full Image</th>
<th align="left" valign="top">
<input type="file" name="fullimg" id="fullimg" />
</th>
</tr>
<tr>
<th align="left" valign="top"></th>
<th align="left" valign="top">
<br />
<a style="padding:0 1em;" href="javascript:document.getElementById('EditForm').submit();"><% = GetIcon("OK", "Save Changes", 40, True) %> Save Changes</a>
<a style="padding:0 1em;" href="javascript:document.location='Default.asp?PGID=<% = Request("PGID") %>';"><% = GetIcon("Delete", "Cancel Changes", 40, True) %> Cancel</a>
<a style="padding:0 1em;" href="javascript:window.parent.location.reload(true);"><% = GetIcon("Undo", "Undo Changes", 40, True) %> Undo</a>
</td>
</tr>
</table>
</form>
<br />
<!--#include virtual="/Assets/Templates/Admin/FranchiseAdmin/TemplateEnd.asp"-->
</body>
</html>
<!--#include virtual="/System/Shutdown.asp"-->
ASKER
Hi there, thanks for the suggestion.
I just tried it and I'm getting the following error:
The field's set to smalldatetime in the table, so that's ok..
Here's where it further down the page:
Here's the functions.asp code it's referring to just in case you can spot it:
Many thanks for the help.
I just tried it and I'm getting the following error:
Microsoft OLE DB Provider for SQL Server error '80040e07'
Conversion failed when converting character string to smalldatetime data type.
/includes/functions.asp, line 355
The field's set to smalldatetime in the table, so that's ok..
Here's where it further down the page:
<tr>
<th align="left" valign="top">Start Time</th>
<th align="left" valign="top">
<% CreateDateTimeSelectionBox "starttime", NOW, False %>
</th>
</tr>
<tr>
<th align="left" valign="top">End Time</th>
<th align="left" valign="top">
<% CreateDateTimeSelectionBox "endtime", NOW, False %>
</th>
</tr>
Here's the functions.asp code it's referring to just in case you can spot it:
<%
constr = strConn
function IIf (boolValue, varTrue, varFalse) ' Inline If
if boolValue then IIf = varTrue else IIf = varFalse
end function
function sqlsafe(svar)
sqlsafe = svar'replace(svar,"'","\'")
end function
function urlsafe(surl)
urlsafe = ""
if len(""&surl) > 0 then
safechars = "abcdefghijklmnopqrstuvwxyz-0123456789"
surl = replace(surl," ","-")
surl = lcase(surl)
for i = 1 to len(surl)
if instr(safechars,mid(surl,i,1)) > 0 then urlsafe = urlsafe & mid(surl,i,1)
next
end if
end function
function getquery(qvar)
getquery = sqlsafe(request.querystring(qvar))
end function
function getform(fvar)
getform = ""
if isobject(upload) then
for each Item in upload.form
if Item.name = fvar then
if len(""&getform)>0 then getform = getform & "," & item.value else getform = item.value
end if
next
else
getform = sqlsafe(request.form(fvar))
end if
end function
function pagetostring(theurl)
set xml = server.createobject("Microsoft.XMLHTTP")
xml.open "GET",theurl,False,"adc","pathways1"
xml.send
pagetostring = xml.responsetext
set xml = nothing
end function
sub callpage(theurl)
set cpxml = server.createobject("MSXML2.ServerXMLHTTP")
cpxml.open "GET",theurl,False,"adc","pathways1"
cpxml.send
set cpxml = nothing
end sub
Function ExtractFilename( Path )
Dim Pos
Pos = InStrRev(Path,"\")
If Pos = 0 Then Pos = InStrRev(Path,"/")
If Pos = 0 Then Pos = InStrRev(Path,":")
If Pos = 0 Then
ExtractFilename = Path
Else
ExtractFilename = Right(Path,Len(Path)-Pos)
End If
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
sub addtoarray(thearray,thevalue)
if isarray(thearray) then
oldcount = ubound(thearray)
newcount = oldcount + 1
redim preserve thearray(newcount)
thearray(newcount) = thevalue
else
thearray = array(thevalue)
end if
end sub
function arraysearch(asarray,asvalue)
arraysearch = -1
if isarray(asarray) then
for ars = 0 to ubound(asarray)
if ""&trim(asarray(ars)) = ""&asvalue then
arraysearch = ars
exit function
end if
next
end if
end function
function arraytostring(ats)
if isarray(ats) then
for iats = 0 to ubound(ats)
arraytostring = arraytostring & iats & " = " & ats(iats) & ", "
next
else
arraytostring = "Not array"
end if
end function
function getguid()
getguid = server.createobject("scriptlet.typelib").guid
getguid = replace(getguid,"}","")
getguid = replace(getguid,"{","")
getguid = replace(getguid,"-","")
getguid = server.HTMLEncode(getguid)
end function
function showalert(sError,sURL)
response.write "<script>"&vbcrlf
response.write "alert('"&replace(sError,"'","\'")&"');"&vbcrlf
if len(""&sURL) = 0 then
response.write "window.history.go(-1);"&vbcrlf
else
response.write "window.location.href='"&sURL&"';"&vbcrlf
end if
response.write "</script>"&vbcrlf
if len(""&sURL) = 0 then
response.write "<input type='button' value='Back' onclick='window.history.go(-1);'>"
else
response.write "<input type='button' value='Continue' onclick=""window.location.href='"&sURL&"'"">"
end if
end function
function isemail(email)
isemail = true
if instr(email,"@") = 0 then isemail = false
if instr(email,".") = 0 then isemail = false
end function
sub getrs(grs,gsql,gparams)
set gcom = server.createobject("adodb.command")
gcom.activeconnection = constr
gcom.commandtext = gsql
gcom.prepared = true
if isarray(gparams) then
for gi = 0 to ubound(gparams)
gcom.parameters.append gcom.createparameter("p"&gi,12,1,65535,gparams(gi))
next
end if
'response.write gsql
set grs = server.CreateObject("adodb.recordset")
grs.cursortype = 1
grs.open gcom
end sub
function getcount(grs)
getcount = 0
while not grs.eof
getcount = getcount+1
grs.movenext
wend
grs.requery
end function
class sendmail
Public fromaddr
Public toaddr
Public cc
Public bcc
Public subject
Public body
Public attach
Public htmlbody
Public replyto
Public sub send()
Set em=CreateObject("CDO.Message")
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "127.0.0.1"
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
em.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
em.Configuration.Fields.Update
em.Subject=subject
em.From=fromaddr
em.To=toaddr
if len(""&cc) > 0 then em.Cc=cc
if len(""&bcc) > 0 then em.Bcc=bcc
if len(""&body) > 0 then
em.TextBody=body
end if
if len(""&replyto) > 0 then em.replyto = replyto
if len(""&htmlbody) > 0 then
em.HTMLBody = htmlbody
end if
if len(""&attach) > 0 then
set fs = server.createobject("scripting.filesystemobject")
arrA = split(attach,",")
for a = 0 to ubound(arrA)
if fs.fileexists(arrA(a)) then em.AddAttachment arrA(a)
next
set fs = nothing
end if
em.Send
set em=nothing
end sub
end class
function getAge(dtDOB)
dim iAge, dtTmp, dtToday
dtToday = Date()
iAge = CInt(DateDiff("yyyy",FormatDateTime(dtDOB,1),Date()))
dtTmp = CDate((Day(dtDOB) & "/" & Month(dtDOB) & "/" & Year(Date())))
if (dtTmp > Date) then iAge = iAge - 1
getAge = iAge
end function
function makepassword(plength)
chars = "abcdefghjkmnpqrstuvwxyz23456789"
randomize()
ul = len(chars)
for p = 1 to plength
makepassword = makepassword & mid(chars,int(ul*Rnd()+1),1)
next
end function
function makejsid()
chars = "abcdefghijklmnopqrstuvwxyx"
nums = "0123456789"
randomize()
for i = 0 to 2
makejsid = makejsid & mid(chars,int(len(chars)*Rnd()+1),1)
next
for i = 0 to 3
makejsid = makejsid & mid(nums,int(len(nums)*Rnd()+1),1)
next
makejsid = ucase(makejsid)
end function
sub addtosql(thearray,thekey,thevalue,thedest)
if isarray(thearray) then
oldcount = ubound(thearray,2)
newcount = oldcount + 1
redim preserve thearray(2,newcount)
thearray(0,newcount) = thekey
thearray(1,newcount) = thevalue
thearray(2,newcount) = thedest
else
execute("Dim thearray()")
redim thearray(2,0)
thearray(0,0) = thekey
thearray(1,0) = thevalue
thearray(2,0) = thedest
end if
end sub
sub exesql(esql,eparams)
set com = server.createobject("adodb.command")
com.activeconnection = constr
com.commandtext = esql
com.prepared = true
if isarray(eparams) then
for ei = 0 to ubound(eparams)
'response.write ei & " = " & eparams(ei)&"<br>"
com.parameters.append com.createparameter("param"&ei,201,1,65535,eparams(ei))
next
end if
com.execute
set com = nothing
end sub
function getColumnType(ct,cc)
getrs gr,"SELECT "&cc&" FROM " & ct,""
'response.write cc
getColumnType = gr.fields(0).type
gr.close
set gr = nothing
end function
Class sql_insert
'set temp = new sql_insert
'temp.table = "s_security"
'temp.addparam "s_username","fish",""
'temp.addparam "s_password","cod",""
'temp.run
'set temp = nothing
private sip
private sis
private sia
private t
public sub addparam(pcol,pval,psrc)
addtosql sip,pcol,pval,psrc
end sub
public property let table(st)
t = st
end property
sub run
for i = 0 to ubound(sip,2)
'add column
a=a&sip(0,i)&","
'add value
if len(""&sip(2,i)) = 0 then
b=b&"?,"
addtoarray sia,sip(1,i)
addtoarray inscols,sip(0,i)
else
b=b&sip(2,i)&","
if instr(sip(2,i),"?")>0 then
addtoarray sia,sip(1,i)
addtoarray inscols,sip(0,i)
end if
end if
next
a=left(a,len(a)-1)
b=left(b,len(b)-1)
sis = "INSERT INTO "&t&" ("&a&") VALUES ("&b&")"
set com = server.createobject("adodb.command")
com.activeconnection = constr
com.commandtext = sis
com.prepared = true
if isarray(sia) then
for i = 0 to ubound(sia)
'response.write inscols(i) & " = " & sia(i) & " - " & getColumnType(t,inscols(i)) & "<br>"
com.parameters.append com.createparameter("param"&i,getColumnType(t,inscols(i)),1,65535,sia(i))
next
end if
com.execute
set com = nothing
end sub
end class
Class sql_update
'set temp = new sql_update
'temp.table = "s_security"
'temp.where "WHERE s_username='fish2'",""
'temp.addparam "s_username","fish22",""
'temp.addparam "s_password","cod22",""
'temp.run
'set temp = nothing
private params
private arrsql
private t
private wheresql
private whereval
private wherestr
public sub addparam(pcol,pval,psrc)
addtosql arrsql,pcol,pval,psrc
end sub
public property let table(st)
t = st
end property
public sub where(whsql,whval)
addtoarray wheresql, whsql
addtoarray whereval, whval
end sub
public property let wherestring(whst)
wherestr = whst
end property
public sub run
sus = "UPDATE "&t&" SET "
for i = 0 to ubound(arrsql,2)
sus = sus & arrsql(0,i)&"="
if len(""&arrsql(2,i)) = 0 then
sus=sus&"?,"
addtoarray sua,arrsql(1,i)
addtoarray updatecols,arrsql(0,i)
else
sus=sus&arrsql(2,i)&","
end if
next
sus=left(sus,len(sus)-1)
if isarray(wheresql) then
for i = 0 to ubound(wheresql)
if instr(sus,"WHERE") = 0 then
sus = sus & " WHERE "
else
sus = sus & " AND "
end if
sus=sus&" "&wheresql(i)&" = ? "
addtoarray sua,whereval(i)
addtoarray updatecols,wheresql(i)
next
end if
if len(""&wherestr) > 0 then
sus = sus & wherestr
end if
';exesql sus,sua
set com = server.createobject("adodb.command")
com.activeconnection = constr
com.commandtext = sus
com.prepared = true
for i = 0 to ubound(sua)
com.parameters.append com.createparameter("param"&i,getColumnType(t,updatecols(i)),1,65535,sua(i))
next
com.execute
set com = nothing
end sub
end class
function randomnumber(rmin,rmax)
randomize
randomnumber = int((rmax-rmin+1)*rnd+rmin)
end function
%>
Many thanks for the help.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
That worked great - many thanks for the help.
ASKER
Just one quick question if that's ok; do you know how I can remove the date (day and month) from the starttime and endtime options?
The format is currently: Day, Month, Year, Hour, Minute
But I'd like it to just be Hour & Minute if possible..
Many thanks.
The format is currently: Day, Month, Year, Hour, Minute
But I'd like it to just be Hour & Minute if possible..
Many thanks.
Inside the database? You probably could use a time type but I'm not sure how that would affect the code. On the page, it probably needs some tweaking to the function CreateDateTimeSelectionBox but that's not in your posted code, probably in one of the other includes.
ASKER
Hello, yep the database is fine; just the time, it's this include file I believe with the CreateTimeDateSelectionBox function; I'm just not sure how best to tweak it...
Shall I open a new one for it and award points?
Here's the code for the time and date funcitons (first one is the time and date one):
If you had any ideas it's be great as I haven't been able to change it successfully..
Many thanks:
Shall I open a new one for it and award points?
Here's the code for the time and date funcitons (first one is the time and date one):
If you had any ideas it's be great as I haven't been able to change it successfully..
Many thanks:
<%
Sub CreateSelectOption(byVal Value, byVal Display, byVal CurrentValue)
%><option value="<% = Value %>" <% = GetSelectStatus_FromValues(Value,CurrentValue) %>><% = Display %></option><%
End Sub
Public Sub CreateDateTimeSelectionBox(strObjectName, dtCurrentDateTime, AllowNone)
Dim iHour
Dim iMin
Dim i
Dim strSelected
if dtCurrentDateTime = "0" then
dtCurrentDateTime = Now()
end if
If IsNull(dtCurrentDateTime) then
iHour = ""
iMin = ""
Else
dtCurrentDateTime = CDate(dtCurrentDateTime)
iHour = Hour(dtCurrentDateTime)
iMin = Minute(dtCurrentDateTime)
End If
CreateDateSelectionBox strObjectName, dtCurrentDateTime, AllowNone
%>
<select name="<% = strObjectName %>_Hour" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
End if
For i = 0 to 23
if i = iHour then
strSelected = " SELECTED "
Else
strSelected = ""
end if
%><option value="<% = Right("00" & Trim(CStr(i)), 2) %>" <% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
Next
%>
</select>
<select name="<% = strObjectName %>_Min" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
End if
For i = 0 to 59
if i = iMin then
strSelected = " SELECTED "
Else
strSelected = ""
end if
%><option value="<% = Right("00" & Trim(CStr(i)), 2) %>" <% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
Next
%>
</select>
<%
End Sub
Public Sub CreateDateSelectionBox(strObjectName, dtCurrentDate, AllowNone)
Dim iDay
Dim iMonth
Dim iYear
Dim iYearCount
Dim strSelected
Dim i
if dtCurrentDate = "0" then
dtCurrentDate = Date()
end if
if len(""&dtCurrentDate) > 0 then
iDay = Day(dtCurrentDate)
iMonth = Month(dtCurrentDate)
iYear = Year(dtCurrentDate)
else
iDay = 0
iMonth = 0
iYear = 0
end if
%>
<select name="<% = strObjectName %>_Day" ID="Select1" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
end if
For i = 1 to 31
if i = iDay then
strSelected = " SELECTED "
else
strSelected = ""
end if
%><option value="<% = i %>"<% = strSelected %>><% = i %></option><%
Next
%>
</select>
<select name="<% = strObjectName %>_Month" ID="Select2" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
end if
For i = 1 to 12
if i = iMonth then
strSelected = " SELECTED "
else
strSelected = ""
end if
%><option value ="<% = i %>"<% = strSelected %>><% = MonthName(i) %></option><%
Next
%>
</select>
<select name="<% = strObjectName %>_Year" ID="Select3" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
end if
loopyear = iyear
if loopyear = 0 then loopyear = year(now)
For i = Year(Now) - 1 To Year(Now) + 10
if i = iYear then
strSelected = " SELECTED "
else
strSelected = ""
end if
%><option value="<% = i %>"<% = strSelected %>><% = i %></option><%
Next
%>
</select>
<%
End Sub
Public Sub CreateCCDateSelectionBox(strObjectName, dtCurrentDate, AllowNone, IsFromDate)
Dim iDay
Dim iMonth
Dim iYear
Dim iYearCount
Dim strSelected
Dim iYearStart
Dim iYearEnd
Dim i
if dtCurrentDate = "0" then
dtCurrentDate = Date()
end if
if IsNull(dtCurrentDate) then
iDay = ""
iMonth = ""
iYear = ""
' iYear = Year(Date())
iYearCount = Year(Date())
else
iDay = Day(dtCurrentDate)
iMonth = Month(dtCurrentDate)
iYear = Year(dtCurrentDate)
iYearCount = iYear
end if
If IsFromDate = True then
iYearStart = iYearCount - 1
iYearEnd = Year(Date())
Else
iYearStart = Year(Date())
iYearEnd = iYearCount + 10
End if
%>
<input type="hidden" name="<% = strObjectName %>_Day" value="1" />
<select name="<% = strObjectName %>_Month" ID="Select5" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
end if
For i = 1 to 12
if i = iMonth then
strSelected = " SELECTED "
else
strSelected = ""
end if
%><option value ="<% = i %>"<% = strSelected %>><% = Right("00" & Trim(CStr(i)), 2) %></option><%
Next
%>
</select> /
<select name="<% = strObjectName %>_Year" ID="Select6" class="input-list">
<%
If AllowNone = True then
%><option value=""> - </option><%
end if
For i = iYearStart to iYearEnd
if i = iYear then
strSelected = " SELECTED "
else
strSelected = ""
end if
%><option value="<% = i %>"<% = strSelected %>><% = Right(i, 4) %></option><%
Next
%>
</select>
<%
End Sub
Public Function GetFormDate(byVal strObjectName)
Dim sDate
if IsNull(Request(strObjectName & "_Day")) or IsNull(Request(strObjectName & "_Month")) or IsNull(Request(strObjectName & "_Year")) then
sDate = Null
elseif Trim(CStr(Request(strObjectName & "_Day"))) = "0" or Trim(CStr(Request(strObjectName & "_Month"))) = "0" or Trim(CStr(Request(strObjectName & "_Year"))) = "0" then
sDate = Null
elseif Trim(CStr(Request(strObjectName & "_Day"))) = "" or Trim(CStr(Request(strObjectName & "_Month"))) = "" or Trim(CStr(Request(strObjectName & "_Year"))) = "" then
sDate = Null
else
sDate = CleanResponseText(Request(strObjectName & "_Day")) & " " & MonthName(CleanResponseText(Request(strObjectName & "_Month"))) & " " & CleanResponseText(Request(strObjectName & "_Year"))
end if
If IsDate(sDate) then
GetFormDate = sDate
else
GetFormDate = Null
end if
End Function
Public Function GetFormDateTime(byVal strObjectName)
Dim sDate
if IsNull(Request(strObjectName & "_Day")) or IsNull(Request(strObjectName & "_Month")) or IsNull(Request(strObjectName & "_Year")) or IsNull(Request(strObjectName & "_Hour")) or IsNull(Request(strObjectName & "_Min")) then
sDate = Null
elseif Trim(CStr(Request(strObjectName & "_Day"))) = "0" or Trim(CStr(Request(strObjectName & "_Month"))) = "0" or Trim(CStr(Request(strObjectName & "_Year"))) = "0" then
sDate = Null
elseif Trim(CStr(Request(strObjectName & "_Day"))) = "" or Trim(CStr(Request(strObjectName & "_Month"))) = "" or Trim(CStr(Request(strObjectName & "_Year"))) = "" or Trim(CStr(Request(strObjectName & "_Hour"))) = "" or Trim(CStr(Request(strObjectName & "_Min"))) = "" then
sDate = Null
else
sDate = CleanResponseText(Request(strObjectName & "_Day")) & " " & MonthName(CleanResponseText(Request(strObjectName & "_Month"))) & " " & CleanResponseText(Request(strObjectName & "_Year")) & " " & CleanResponseText(Request(strObjectName & "_Hour")) & ":" & CleanResponseText(Request(strObjectName & "_Min"))
end if
If IsDate(sDate) then
GetFormDateTime = sDate
else
GetFormDateTime = Null
end if
End Function
Public Function StartHoverClickDiv(byVal strText)
Dim sDivStream
Dim strTitle
Dim strAlert
' Sort out the LineBreaks for JS and HTML
strTitle = strText
strAlert = strText
strTitle = Replace(strTitle, "<br>", vbCrLf)
strTitle = Replace(strTitle, "\n", vbCrLf)
strAlert = Replace(strAlert, "<br>", "\n")
strAlert = Replace(strAlert, vbCrLF, "\n")
' Sort out JS {'} Quote problem
strTitle = Replace(strTitle, "'", "\'")
strTitle = Replace(strTitle, """", "\'")
strAlert = Replace(strAlert, "'", "\'")
strAlert = Replace(strAlert, """", "\'")
sDivStream = "<div title=""" & strTitle & """ onClick=""javascript:alert('" & strAlert & "');"" style=""cursor: help;"">"
StartHoverClickDiv = sDivStream
End Function
Public Function StartHoverDiv(byVal strText)
Dim sDivStream
Dim strTitle
' Sort out the LineBreaks for JS and HTML
strTitle = strText
strTitle = Replace(strTitle, "<br>", vbCrLf)
strTitle = Replace(strTitle, "\n", vbCrLf)
' Sort out JS {'} Quote problem
strTitle = Replace(strTitle, "'", "\'")
strTitle = Replace(strTitle, """", "\'")
sDivStream = "<div title=""" & strTitle & """ style=""cursor: help;"">"
StartHoverDiv = sDivStream
End Function
Public Function MakeJavaSafeText(byVal Message)
Message = Replace(Message, "\", "\\")
Message = Replace(Message, "\\n", "\n")
Message = Replace(Message, "<br>", "\n")
Message = Replace(Message, vbCrLf, "\n")
MakeJavaSafeText = Message
End Function
Public Sub DoJavaAlert(byVal Message)
%>
<script language="javascript" type="text/javascript">
<!--
alert('<% = MakeJavaSafeText(Message) %>');
//-->
</script>
<%
End Sub
Public Sub DoJavaRedirect(byVal URL)
%>
<script language="javascript" type="text/javascript">
<!--
document.location='<% = URL %>';
//-->
</script>
<%
End Sub
%>
ASKER
Hi Robert, I just added a new question if you'd like to take a look and can award points separately for you:
https://www.experts-exchange.com/questions/28009786/Help-tweaking-a-function-for-a-time-and-date-option-select.html
Cheers.
https://www.experts-exchange.com/questions/28009786/Help-tweaking-a-function-for-a-time-and-date-option-select.html
Cheers.
ASKER
** Dupe comment
No it's ok, no problem to look at it here.
You could copy the function and take out the date part, then call that copy when you want only the time.
Or, based on the fields you call it with in the page, you could change line 22 to (untested):
EDIT: forget that last part, I thought it was being called with the current value from the database, but it isn't.
You could copy the function and take out the date part, then call that copy when you want only the time.
Or, based on the fields you call it with in the page, you could change line 22 to (untested):
If InStr(strObjectName, "date") = 0 And InStr(strObjectName, "time") > 0 Then
CreateDateSelectionBox strObjectName, dtCurrentDateTime, AllowNone
End If
Maybe a better check could be:
If Not Date(dtCurrentDateTime) = #1/1/1900# Then
But that would need some checking.EDIT: forget that last part, I thought it was being called with the current value from the database, but it isn't.
Oh, hadn't seen you already posted. I'll post a proposed implementation for the first option there.
Open in new window
On the other hand, you may need to make sure it's always 2 digits?