I am using an ASP script I found in the Internet. I have very little knowledge about ASP but the script worked fine and so I used it. Some days ago suddenly the following error appeared without me having changed anything:
********error start********************
Error Type:
Microsoft JET Database Engine (0x80040E07)
Syntax error in date in query expression 'date_completion<#02.05.2003#'.
/tasks/Common.asp, line 34
**************error stop************************
*******************common.asp start************
<!-- #INCLUDE FILE="adovbs.inc" -->
<!-- #INCLUDE FILE="TemplateObj.asp" -->
<%
Dim cn : Set cn = Server.CreateObject("ADODB.Connection")
Dim strConn, strLogin, strPassword
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("IssueManagerE.mdb") & ";Persist Security Info=False"
strLogin = "Admin"
strPassword = ""
cn.open strConn, strLogin, strPassword
sub openrs(rs, sql)
Set rs = Server.CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseServer
rs.Open sql, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
end sub
sub openStaticRS(rs, sql)
Set rs = Server.CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseServer
rs.Open sql, cn, adOpenStatic, adLockReadOnly, adCmdText
end sub
' Specify Debug mode (true/false)
Dim bDebug : bDebug = false
Dim sAppPath : sAppPath = left(Request("PATH_TRANSLATED"), instrrev(Request("PATH_TRANSLATED"), "\"))
Dim sHeaderFileName : sHeaderFileName = sAppPath & "Header.html"
Dim sFooterFileName : sFooterFileName = sAppPath & "Footer.html"
function ToHTML(strValue)
if IsNull(strValue) then
ToHTML = ""
else
ToHTML = Server.HTMLEncode(strValue)
end if
end function
function ToURL(strValue)
if IsNull(strValue) then strValue = ""
ToURL = Server.URLEncode(strValue)
end function
function GetValueHTML(rs, strFieldName)
GetValueHTML = ToHTML(GetValue(rs, strFieldName))
end function
function GetValue(rs, strFieldName)
on error resume next
if rs is nothing then
GetValue = ""
elseif (not rs.EOF) and (strFieldName <> "") then
res = rs(strFieldName)
if isnull(res) then
res = ""
end if
if VarType(res) = vbBoolean then
if res then res = "1" else res = "0"
end if
GetValue = res
else
GetValue = ""
end if
if bDebug then response.write err.Description
on error goto 0
end function
function GetParam(ParamName)
if Request.QueryString(ParamName).Count > 0 then
Param = Request.QueryString(ParamName)
elseif Request.Form(ParamName).Count > 0 then
Param = Request.Form(ParamName)
else
Param = ""
end if
if Param = "" then
GetParam = Empty
else
GetParam = Param
end if
end function
Function ToSQL(Value, sType)
Dim Param : Param = Value
if Param = "" then
ToSQL = "Null"
else
if sType = "Number" then
ToSQL = replace(CDbl(Param), ",", ".")
else
ToSQL = "'" & Replace(Param, "'", "''") & "'"
end if
end if
end function
function DLookUp(Table, fName, sWhere)
on error resume next
Dim Res : Res = cn.execute("select " & fName & " from " & Table & " where " & sWhere).Fields(0).Value
if IsNull(Res) then Res = ""
DLookUp = Res
if bDebug then response.write err.Description
on error goto 0
end function
function getCheckBoxValue(sVal, CheckedValue, UnCheckedValue, sType)
if isempty(sVal) then
if UnCheckedValue = "" then
getCheckBoxValue = "Null"
else
if sType = "Number" then
getCheckBoxValue = UnCheckedValue
else
getCheckBoxValue = "'" & Replace(UnCheckedValue, "'", "''") & "'"
end if
end if
else
if CheckedValue = "" then
getCheckBoxValue = "Null"
else
if sType = "Number" then
getCheckBoxValue = CheckedValue
else
getCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'"
end if
end if
end if
end function
function getValFromLOV(sVal, aArr)
Dim i
Dim sRes : sRes = ""
if (ubound(aArr) mod 2) = 1 then
for i = 0 to ubound(aArr) step 2
if cstr(sVal) = cstr(aArr(i)) then sRes = aArr(i+1)
next
end if
getValFromLOV = sRes
end function
function ProcessError()
if cn.Errors.Count > 0 then
ProcessError = cn.Errors(0).Description & " (" & cn.Errors(0).Source & ")"
elseif not (Err.Description = "") then
ProcessError = Err.Description
else
ProcessError = ""
end if
end Function
function CheckSecurity(iLevel)
if Session("UserID") = "" then
cn.Close
Set cn = Nothing
response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME")))
else
if CLng(Session("UserRights")) < CLng(iLevel) then
cn.Close
Set cn = Nothing
response.redirect("Login.asp?QueryString=" & toURL(request.serverVariables("QUERY_STRING")) & "&ret_page=" & toURL(request.serverVariables("SCRIPT_NAME")))
end if
End if
end function
function GetNumberOfItems(iCategoryID, sCategoriesTable, sCategoryIDField, sParCategoryIDField, sItemsTable, sItemsCategoryField, sWhereParams)
Dim iCountCategories: iCountCategories = 0
Dim iCountItems: iCountItems = 0
Dim sWhere: sWhere = "=" & iCategoryID
Dim rs
if sWhereParams <> "" then sWhere = " and " & sWhereParams
openrs rs, "select " & sCategoryIDField & " from " & sCategoriesTable & " where " & sParCategoryIDField & sWhere
while not rs.eof
iCountCategories = iCountCategories + GetNumberOfItems(GetValue(rs, sCategoryIDField), sCategoriesTable, sCategoryIDField, sParCategoryIDField, sItemsTable, sItemsCategoryField, sWhereParams)
rs.movenext
wend
iCountItems = DLookUp(sItemsTable, "count(*)", sItemsCategoryField & sWhere)
GetNumberOfItems = iCountCategories + iCountItems
end function
sub SendEMail(mailFrom,mailTo,mailSubject,mailBody)
Set newMsg = CreateObject("CDONTS.NewMail")
newMsg.BodyFormat=0
newMsg.MailFormat=0
newMsg.From=mailFrom
newMsg.To=mailTo
newMsg.Subject = mailSubject
newMsg.Body =mailBody
newMsg.Send
end sub
sub SendEMail(email_from, email_to, email_subject, email_body)
email_body = replace(email_body,vbCRLF,"<br>")
email_body = replace(email_body,chr(13),"<br>")
if smtp_host = "" then
smtp_host = Dlookup("settings","smtp_host","settings_id=1")
end if
select case Dlookup("settings","email_component","settings_id= 1")
case "1"
response.write "TO:" & email_to & "<br>FROM:" & email_from & "<br>SUBJECT:" & email_subject & "<br>BODY:" & email_body & "<br><hr>"
case "2" 'CDONTS
Set objCDO = Server.CreateObject("CDONTS.NewMail")
objCDO.From = email_from
objCDO.To = email_to
objCDO.Subject = email_subject
objCDO.Body = email_body
objCDO.MailFormat = 0
objCDO.BodyFormat = 0
objCDO.Send
set objCDO=Nothing
case "3" 'ASPMail
Set Mailer = Server.CreateObject("SMTPsvg.Mailer")
Mailer.FromName = email_from
Mailer.FromAddress= email_from
Mailer.RemoteHost = smtp_host
Mailer.ContentType = "text/html"
Mailer.AddRecipient email_to, email_to
Mailer.Subject = email_subject
Mailer.BodyText = email_body
Mailer.SendMail
set Mailer = Nothing
case "4" 'JMail
Set jmail = Server.CreateObject ("JMail.SMTPMail")
jmail.ServerAddress = smtp_host
jmail.Sender = email_from
jmail.Subject = email_subject
jmail.AddRecipient email_to
jmail.ContentType = "text/html"
jmail.Body = email_body
jmail.Execute
set jmail = nothing
case "5" 'SimpleMail
Set o = Server.CreateObject("ADISCON.SimpleMail.1")
o.MailServer = smtp_host
o.Sender = email_from
o.Subject = email_subject
o.Recipient email_to
o.MessageText = email_body
o.Send
set o = nothing
case "6" 'AspEmail (
http://www.aspemail.com/)
Set Mailer = Server.CreateObject("Persits.MailSender")
Mailer.From = email_from
Mailer.AddAddress email_to
Mailer.Host = smtp_host
Mailer.IsHTML = True
Mailer.Subject = email_subject
Mailer.Body = email_body
Mailer.Send
set Mailer = Nothing
end select
end sub
sub proc_cus_fields(form_name)
Dim sql_sys_fields : sql_sys_fields = "SELECT sys_field_name, sys_field_label, sys_field_visible FROM sys_fields"
openrs rs_sys_fields, sql_sys_fields
while not rs_sys_fields.EOF
if GetValue(rs_sys_fields, "sys_field_visible")=1 then
SetVar "l_" & GetValue(rs_sys_fields, "sys_field_name"),GetValue(rs_sys_fields, "sys_field_label")
else
SetVar "Form" & form_name & "Head" & GetValue(rs_sys_fields, "sys_field_name"),""
SetVar "Form" & form_name & "Field" & GetValue(rs_sys_fields, "sys_field_name"),""
end if
rs_sys_fields.MoveNext
wend
set rs_sys_fields= nothing
end sub
sub build_issue_search_sql(i_sql, i_where)
if GetParam("issue_name")<>"" and i_sql<>"" then
kword = GetParam("issue_name")
i_sql = "SELECT DISTINCT " & right(i_sql,len(i_sql)-7) & " LEFT JOIN responses AS r ON i.issue_id = r.issue_id"
if IsNumeric(kword) then
i_where = i_where & " AND (i.issue_id=" & kword & " OR i.issue_name like '%" & kword & "%' OR i.issue_desc like '%" & kword & "%' OR r.response like '%" & kword & "%')"
else
i_where = i_where & " AND (i.issue_name like '%" & kword & "%' OR i.issue_desc like '%" & kword & "%' OR r.response like '%" & kword & "%')"
end if
end if
end sub
upload_enabled=Dlookup("settings","upload_enabled" ,"settings_id=1")
Dim oUpload
if upload_enabled=1 and Dlookup("users","allow_upload","user_id=" & Session("UserID"))=1 and (sFileName = "IssueNew.asp" or sFileName = "IssueChange.asp") then
on error resume next
sFileErrorText=""
im sFile:sFile=""
Set oUpload = Server.CreateObject("Dundas.Upload.2")
if Err.Description <> "" then
response.write "File Upload could not be performed. Install Dundas Upload Component."
response.end
end if
sDir=Dlookup("settings","file_path","settings_id=1 ")
oUpload.Save Server.MapPath(sDir)
on error goto 0
end if
function ToNum(var)
if Len(var & "")=0 then ToNum=0 else ToNum=CLng(var)
end function
%>
****************common.asp stop***************************
dBforums
>
Microsoft JET Database Engine (0x80040E07)
05-02-03, 14:51
Microsoft JET Database Engine (0x80040E07)
Linear Mode
