|
|
 |
| Classic ASP Professional For advanced coder questions in ASP 3. NOT for ASP.NET 1.0, 1.1, or 2.0. |
Welcome to the p2p.wrox.com Forums.
You are currently viewing the Classic ASP Professional section of the Wrox p2p Programmer to Programmer discussion community. This is a community of more than 40,000 computer programmers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining our free Wrox p2p community you can post your own programming questions and respond to other programmers’ questions. Registered users also don't have to see the ads that are displayed to guests. Registration is fast, simple and absolutely free so please, join today!
Join today and post to win prizes! Post more to increase your chances of being Wrox’s top poster of the month.
|
 |
|
September 17th, 2009, 04:51 PM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Microsoft VBScript compilation error '800a03f6'
Can someone help me please!! totally new to scripts but cannot get this to work... i've got no hair left....
error:: Microsoft VBScript compilation error '800a03f6'
Expected 'End'
/admin/includes/common.asp, line 790
script:
<%
'Two varibles are passed into the db
'u_input is the value if the user entered a response to
'the vote/poll question....IP is the address of the user
u_input=request.form("u_input")
u_ip=request.servervariables("remote_addr")
' if the user did not enter anything in the poll on this visit
' then display the poll question and possible choices
if u_input = "" then
%>
<form action="<%= request.servervariables(" method="post" % script_name?)><span style="COLOR: #ffffff">"> </span>
<p><strong>Arts Category<br />
<br />
</strong>
<input type="radio" checked="checked" value="1" name="u_input" />Arts 1<br />
<input type="radio" value="2" name="u_input" />Arts 2<br />
<input type="radio" value="3" name="u_input" />Arts 3<br />
<input type="radio" value="4" name="u_input" />Arts 4<br />
<input type="radio" value="5" name="u_input" />Arts 5<br />
<input type="radio" value="6" name="u_input" />Arts 6<br />
<input type="submit" value="Submit" /></p>
</form>
<%
else
' if the user did input a choice on the vote/ballot
' check to see if their ip address is already in the db
' if the directory your .asp page is in does not have user
' write authority the accessdb variable and access db may
' need to be moved to your /cgi-bin/ directory and add that to the code below
accessdb="arts"
cn="driver={Microsoft Access Driver (*.mdb)};"
cn=cn & "dbq=" & server.mappath(accessdb)
set rs = server.createobject("ADODB.Recordset")
sql = "select ip from ballot where ip ='" & u_ip & "'"
rs.Open sql, cn
if rs.eof then
' if the user has not voted previously indicate it
been_here_before="No"
end if
rs.close
if been_here_before = "No" then
' Since the user has not voted previously their input
' their vote will be added to the db
sql = "insert into ballot (ip, selection" & u_input &") "
sql = sql & "values ('" & u_ip & "',1)"
rs.Open sql, cn
end if
'This will summerize and count the records in the db
sql= "select distinctrow "
sql= sql & "sum(selection1) as sum_selection1, "
sql= sql & "sum(selection2) as sum_selection2, "
sql= sql & "sum(selection3) as sum_selection3, "
sql= sql & "sum(selection4) as sum_selection4, "
sql= sql & "sum(selection5) as sum_selection5, "
sql= sql & "sum(selection6) as sum_selection6, "
sql= sql & "count(*) AS total_votes "
sql= sql & "FROM ballot;"
rs.Open sql, cn
total1=rs ("sum_selection1")
total2=rs ("sum_selection2")
total3=rs ("sum_selection3")
total4=rs ("sum_selection4")
total5=rs ("sum_selection5")
total6=rs ("sum_selection6")
count=rs ("total_votes")
%>
Arts Category <br />
<img height="10" src="black.jpg" width="<%= formatnumber((total1/count)*100,0) %>" />
<%
= formatnumber((total1/count)*100,1)
%>
%<br />
Arts 1 <br />
<img height="10" src="yellow.jpg" width="<%= formatnumber((total2/count)*100,0) %>" />
<%
= formatnumber((total2/count)*100,1)
%>
%<br />
Arts 2 <br />
<img height="10" src="pink.jpg" width="<%= formatnumber((total3/count)*100,0) %>" />
<%
= formatnumber((total3/count)*100,1)
%>
%<br />
Arts 3 <br />
<img height="10" src="blue.jpg" width="<%= formatnumber((total4/count)*100,0) %>" />
<%
= formatnumber((total4/count)*100,1)
%>
%<br />
Arts 4 <br />
<img height="10" src="green.jpg" width="<%= formatnumber((total5/count)*100,0) %>" />
<%
= formatnumber((total5/count)*100,1)
%>
%<br />
Arts 5 <br />
<img height="10" src="red.jpg" width="<%= formatnumber((total6/count)*100,0) %>" />
<%
= formatnumber((total6/count)*100,1)
%>
%<br />
Arts 6 <br />
Total Votes:
<%
= formatnumber(count,0,0)
%>
<br />
<%
end if
%>
</o:p>
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<p> </p></?xml:namespace></div></?xml:namespace></p></?xml:namespace></p>
|
September 18th, 2009, 01:12 AM
|
|
Friend of Wrox
|
|
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,323
Thanks: 3
Thanked 70 Times in 69 Posts
|
|
Once again, one of my posts gets eaten by this *&#*!@& forum.
Okay, try again.
None of the code you show there is causing that error. At least, I certainly don't see how it can.
Did you not notice that the error is in the *INCLUDE* file? common.asp??
You don't show, in the code you posted, *where* in your code the #include of that file occurs.
Nor do you show any of the lines in the vicinity of line 790 in that "common.asp" file.
If and when you post here again, *PLEASE* make sure to post code wrapped in [ code ] ... [ /code ] tags (without the spaces in the tags, of course).
|
September 18th, 2009, 01:40 AM
|
|
Friend of Wrox
|
|
Join Date: May 2004
Location: India
Posts: 563
Thanks: 0
Thanked 14 Times in 14 Posts
|
|
Also, check this line which seems to be incorrect which may not be related to error you posted
Code:
<form action="<%= request.servervariables(" method="post" % script_name?)><span style="COLOR: #ffffff">"> </span>
The code works if you correct above line and the error what you are getting is in the include file as mentioned by Old Pedant
__________________
Om Prakash Pant
|
September 18th, 2009, 11:39 AM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
I am still lost peeps... line 790 is highlighted below (else)
Code:
'Execute ( Mid(str,1,a2-1))
if Mid(Trim(Mid(str,1,a2-1)),1,1) = "=" then
Execute("Response.Write " & Mid(Trim(Mid(str,1,a2-1)),2))
else
Execute ( Mid(str,1,a2-1))
end if
str = Mid(str,a2+2)
a1 = InStr(1,str,"<%")
if a1=0 then
response.write Mid(str,1)
str=""
else
response.write Mid(str,1,a1-1)
str=Mid(str,a1+2)
end if
loop
End Function
%>
Last edited by 121 : September 18th, 2009 at 12:50 PM.
|
September 18th, 2009, 11:49 AM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
code
Code:
<%
'Two varibles are passed into the db
'u_input is the value if the user entered a response to
'the vote/poll question....IP is the address of the user
u_input=request.form("u_input")
u_ip=request.servervariables("remote_addr")
' if the user did not enter anything in the poll on this visit
' then display the poll question and possible choices
if u_input = "" then
%>
<form action="<%= request.servervariables(" method="post" % script_name?)><span style="COLOR: #ffffff">"> </span>
<p><strong>Arts Category<br />
<br />
</strong>
<input type="radio" checked="checked" value="1" name="u_input" />Arts 1<br />
<input type="radio" value="2" name="u_input" />Arts 2<br />
<input type="radio" value="3" name="u_input" />Arts 3<br />
<input type="radio" value="4" name="u_input" />Arts 4<br />
<input type="radio" value="5" name="u_input" />Arts 5<br />
<input type="radio" value="6" name="u_input" />Arts 6<br />
<input type="submit" value="Submit" /></p>
</form>
<%
else
' if the user did input a choice on the vote/ballot
' check to see if their ip address is already in the db
' if the directory your .asp page is in does not have user
' write authority the accessdb variable and access db may
' need to be moved to your /cgi-bin/ directory and add that to the code below
accessdb="arts"
cn="driver={Microsoft Access Driver (*.mdb)};"
cn=cn & "dbq=" & server.mappath(accessdb)
set rs = server.createobject("ADODB.Recordset")
sql = "select ip from ballot where ip ='" & u_ip & "'"
rs.Open sql, cn
if rs.eof then
' if the user has not voted previously indicate it
been_here_before="No"
end if
rs.close
if been_here_before = "No" then
' Since the user has not voted previously their input
' their vote will be added to the db
sql = "insert into ballot (ip, selection" & u_input &") "
sql = sql & "values ('" & u_ip & "',1)"
rs.Open sql, cn
end if
'This will summerize and count the records in the db
sql= "select distinctrow "
sql= sql & "sum(selection1) as sum_selection1, "
sql= sql & "sum(selection2) as sum_selection2, "
sql= sql & "sum(selection3) as sum_selection3, "
sql= sql & "sum(selection4) as sum_selection4, "
sql= sql & "sum(selection5) as sum_selection5, "
sql= sql & "sum(selection6) as sum_selection6, "
sql= sql & "count(*) AS total_votes "
sql= sql & "FROM ballot;"
rs.Open sql, cn
total1=rs ("sum_selection1")
total2=rs ("sum_selection2")
total3=rs ("sum_selection3")
total4=rs ("sum_selection4")
total5=rs ("sum_selection5")
total6=rs ("sum_selection6")
count=rs ("total_votes")
%>
Arts Category <br />
<img height="10" src="black.jpg" width="<%= formatnumber((total1/count)*100,0) %>" />
<%
= formatnumber((total1/count)*100,1)
%>
%<br />
Arts 1 <br />
<img height="10" src="yellow.jpg" width="<%= formatnumber((total2/count)*100,0) %>" />
<%
= formatnumber((total2/count)*100,1)
%>
%<br />
Arts 2 <br />
<img height="10" src="pink.jpg" width="<%= formatnumber((total3/count)*100,0) %>" />
<%
= formatnumber((total3/count)*100,1)
%>
%<br />
Arts 3 <br />
<img height="10" src="blue.jpg" width="<%= formatnumber((total4/count)*100,0) %>" />
<%
= formatnumber((total4/count)*100,1)
%>
%<br />
Arts 4 <br />
<img height="10" src="green.jpg" width="<%= formatnumber((total5/count)*100,0) %>" />
<%
= formatnumber((total5/count)*100,1)
%>
%<br />
Arts 5 <br />
<img height="10" src="red.jpg" width="<%= formatnumber((total6/count)*100,0) %>" />
<%
= formatnumber((total6/count)*100,1)
%>
%<br />
Arts 6 <br />
Total Votes:
<%
= formatnumber(count,0,0)
%>
<br />
<%
end if
%>
</o:p>
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<p> </p>
<p> </p></?xml:namespace></div></?xml:namespace></p></?xml:namespace></p>
________________________________________
Last edited by mehere : Yesterday at 05:23 PM.
|
September 18th, 2009, 11:59 AM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Quote:
|
Originally Posted by mehere
it appears that you're missing an End If ... count all of your if/then statements and make sure you have an end if for all of them.
|
I've searched but cannot find prob there are 6 "if" 3 "end if".. where should I put the rest?? |
September 18th, 2009, 12:48 PM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Quote:
Originally Posted by Old Pedant
Once again, one of my posts gets eaten by this *&#*!@& forum.
Okay, try again.
None of the code you show there is causing that error. At least, I certainly don't see how it can.
Did you not notice that the error is in the *INCLUDE* file? common.asp??
You don't show, in the code you posted, *where* in your code the #include of that file occurs.
Nor do you show any of the lines in the vicinity of line 790 in that "common.asp" file.
If and when you post here again, *PLEASE* make sure to post code wrapped in [ code ] ... [ /code ] tags (without the spaces in the tags, of course).
|
this is the common.asp. line 790 is 15 from the bottom
Code:
<!-- #INCLUDE FILE='settings.asp' -->
<%
If Not Session("site")=nSite Then 'CHECK FOR DIFFERENT SITE
Session("user_id")="" 'logout
Session("fullname")=""
End If
active_page_id = request("active_page_id")
if len(active_page_id)=0 then
active_page_id = 1
end if
active_page_id = CInt(active_page_id )
sWorking = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(working)</span></span>"
sWorkingNotYetOnline = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(working, not yet online)</span></span>"
sWorking_HideFromNav = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(working, not included in the site navigation)</span></span>"
sWorkingNotYetOnline_HideFromNav = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(working, not yet online, not included in the site navigation)</span></span>"
sHideFromNav = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(online, not included in the site navigation)</span></span>"
sOnline = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'> <span style='background:white'>(online)</span></span>"
Class Page
private adoCn
private sub class_Initialize
set adoCn = createobject("ADODB.Connection")
adoCn.Open strConn
set adoRs = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM pages WHERE page_id=" & active_page_id
adoRs.Open strSQL, adoCn
if not adoRs.EOF then
status=adoRs("status")
access_using_SSL=adoRs("SSL")
If access_using_SSL = "Yes" AND Request.ServerVariables("SERVER_PORT")=80 Then
adoRs.Close
set adoRs = nothing
adoCn.close
set adoCn = nothing
strSecureURL = "https://" & Request.ServerVariables("SERVER_NAME") & _
Request.ServerVariables("URL") & "?active_page_id=" & _
Request.QueryString("active_page_id")
Response.Redirect strSecureURL
ElseIf access_using_SSL = "No" AND Request.ServerVariables("SERVER_PORT")=443 Then
adoRs.Close
set adoRs = nothing
adoCn.close
set adoCn = nothing
strSecureURL = "http://" & Request.ServerVariables("SERVER_NAME") & _
Request.ServerVariables("URL") & "?active_page_id=" & _
Request.QueryString("active_page_id")
Response.Redirect strSecureURL
End If
'secure~~~~~~~~
If Session("user_id")="" Then
if IsNull(adoRs("date_online")) then
adoRs.Close
set adoRs = nothing
adoCn.close
set adoCn = nothing
response.Write "This page is not published yet."
response.end
end if
end if
'~~~~~~~~~~~~~~
'Custom Script
If Session("user_id")="" Then
if Not IsNull(adoRs("script")) then
sScript=adoRs("script")
Execute(sScript)
end if
End If
else
adoRs.Close
set adoRs = nothing
adoCn.close
set adoCn = nothing
response.Write "Page not found."
response.end
end if
adoRs.Close
end sub
private sub class_Terminate
adoCn.close
set adoCn = nothing
end sub
'****************************************************************
' Menu
'****************************************************************
'Menu Templates
private sTemplate_Menu_Header
private sTemplate_Menu_Footer
private sTemplate_Menu_Link
private sTemplate_Menu_OpenedLink
private sTemplate_Menu_SelectedLink
public property let Template_Menu_Header(val)
sTemplate_Menu_Header = val
end property
public property let Template_Menu_Footer(val)
sTemplate_Menu_Footer = val
end property
public property let Template_Menu_Link(val)
sTemplate_Menu_Link = val
end property
public property let Template_Menu_OpenedLink(val)
sTemplate_Menu_OpenedLink = val
end property
'Show Search
public sub Show_Search()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "SELECT * FROM pages WHERE title='%Search_Internal%'"
adoRs.Open strSQL, adoCn
if not adoRs.EOF then
Response.Write "<form style='margin:0' action='" & adoRs("template") & "?active_page_id=" & adoRs("page_id") & "' method=post id=frmSearch><input type=text name=inpSearch id=inpSearch><input type=submit value=search></form>"
end if
adoRs.Close
set adoRs = nothing
end sub
'Show Menu
public sub show_Menu()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
'Header
Response.Write VbCrLf & sTemplate_Menu_Header & VbCrLf
'Show 1st level (HOME)
strSQL = "SELECT * FROM pages WHERE parent_page_id=0 AND pos<>0"
adoRs.Open strSQL, adoCn
if not adoRs.EOF then
sTemplate = adoRs("template")
url = sTemplate & "?active_page_id=1"
if active_page_id = adoRs("page_id") then
sTmp = sTemplate_Menu_OpenedLink
else
sTmp = sTemplate_Menu_Link
sTmp = replace(sTmp ,"[url]",url)
end if
sTitle=adoRs("title")
'secure~~~~~~~~
If Session("user_id")<>"" Then
if adoRs("status")="Working" AND IsNull(adoRs("date_online")) then
sTitle = sTitle & sWorking 'sWorkingNotYetOnline (tdk perlu)
elseif adoRs("status")="Working" AND Not IsNull(adoRs("date_online")) then
sTitle = sTitle & sWorking
end if
End If
'~~~~~~~~~~~~~~
sTmp = replace(sTmp ,"[title]",sTitle)
Response.Write sTmp
end if
adoRs.Close
'Show 2nd level (under Home)
'secure~~~~~~~~
If Session("user_id")<>"" Then
strSQL = "SELECT * FROM pages WHERE parent_page_id=1 AND pos<>0 order by pos"
else
strSQL = "SELECT * FROM pages WHERE parent_page_id=1 AND pos<>0 AND date_online<>null AND include_in_site_navigation='Yes' order by pos"
end if
'~~~~~~~~~~~~~~
adoRs.Open strSQL, adoCn
do while not adoRs.eof
sTemplate = adoRs("template")
url = sTemplate & "?active_page_id=" & adoRs("page_id")
if active_page_id = adoRs("page_id") then
sTmp = sTemplate_Menu_OpenedLink
else
sTmp = sTemplate_Menu_Link
sTmp = replace(sTmp ,"[url]",url)
end if
sTitle=adoRs("title")
'secure~~~~~~~~
If Session("user_id")<>"" Then
if adoRs("status")="Working" AND IsNull(adoRs("date_online")) then
sTmp = sTmp & sWorking 'sWorkingNotYetOnline (tdk perlu)
elseif adoRs("status")="Working" AND Not IsNull(adoRs("date_online")) then
sTmp = sTmp & sWorking
end if
End If
'~~~~~~~~~~~~~~
sTmp = replace(sTmp ,"[title]",sTitle)
Response.Write sTmp
adoRs.MoveNext
loop
'Footer
Response.Write VbCrLf & sTemplate_Menu_Footer & VbCrLf & VbCrLf
adoRs.Close
set adoRs = nothing
end sub
'****************************************************************
' Title
'****************************************************************
private sTemplate_PageTitle
public property let Template_PageTitle(val)
sTemplate_PageTitle = val
end property
public sub Show_Title()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "SELECT title FROM pages WHERE page_id=" & active_page_id
adoRs.Open strSQL, adoCn
if not adoRs.eof then
if adoRs(0) = "%Search_Internal%" then
Response.Write "Search"
else
response.Write adoRs(0)
end if
end if
adoRs.Close
set adoRs = nothing
end sub
public sub Show_PageTitle()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "SELECT * FROM pages WHERE page_id=" & active_page_id
adoRs.Open strSQL, adoCn
if not adoRs.eof then
if active_page_id<>1 OR (active_page_id=1 AND Session("user_id")<>"") then
sTmp = sTemplate_PageTitle
if adoRs("title") = "%Search_Internal%" then
sTmp = replace(sTmp ,"[title]","Search")
else
sTmp = replace(sTmp ,"[title]",adoRs("title"))
end if
Response.Write sTmp
end if
'secure~~~~~~~~
If Session("user_id")<>"" AND active_page_id<>2 AND adoRs("Title")<>"%Search_Internal%" Then '*** Not a Site Map & Search Result ***
Response.Write "<script>" & _
"function modalDialogShow(url,width,height)" & _
" {" & _
" var left = screen.availWidth/2 - width/2;" & _
" var top = screen.availHeight/2 - height/2;" & _
" activeModalWin = window.open(url, """", ""width=""+width+"",height=""+height+"",left=""+left+"",top=""+top);" & _
" window.onfocus = function(){if (activeModalWin.closed == false){activeModalWin.focus();};};" & _
" }" & _
"</script>"
Response.Write VbCrLf & " <span style='vertical-align:1'>" & _
"<a style='font-size:18px' href=# " & _
"onclick=""modalDialogShow('admin/page_new.asp?active_page_id=" & active_page_id & "',800,600);"">" & _
"<span style='text-decoration:none'>[</span>" & _
"New Page" & _
"<span style='text-decoration:none'>]</span>" & _
"</a></span>"
Response.Write VbCrLf & " <span style='vertical-align:1'>" & _
"<a style='font-size:18px' href=# " & _
"onclick=""modalDialogShow('admin/page_edit.asp?active_page_id=" & active_page_id & "',800,600);"">" & _
"<span style='text-decoration:none'>[</span>" & _
"Edit" & _
"<span style='text-decoration:none'>]</span>" & _
"</a></span>"
If active_page_id<>1 Then
Response.Write VbCrLf & " <span style='vertical-align:1'>" & _
"<a style='font-size:18px' href=# " & _
"onclick=""modalDialogShow('admin/page_delete.asp?action=confirm&active_page_id=" & active_page_id & "',300,150);"">" & _
"<span style='text-decoration:none'>[</span>" & _
"Delete" & _
"<span style='text-decoration:none'>]</span>" & _
"</a></span>"
End if
'Response.Write VbCrLf & " <span style='vertical-align:1'>" & _
' "<a style='font-size:18px' href='default_login.asp?action=logout'>" & _
' "<span style='text-decoration:none'>[</span>" & _
' "Logout" & _
' "<span style='text-decoration:none'>]</span>" & _
' "</a></span>"
End If
'~~~~~~~~~~~~~~
end if
adoRs.Close
set adoRs = nothing
end sub
'****************************************************************
' Position
'****************************************************************
'Position Templates
private sTemplate_Position_Header
private sTemplate_Position_Footer
private sTemplate_Position_Link
private sTemplate_Position_OpenedLink
public property let Template_Position_Header(val)
sTemplate_Position_Header = val
end property
public property let Template_Position_Footer(val)
sTemplate_Position_Footer = val
end property
public property let Template_Position_Link(val)
sTemplate_Position_Link = val
end property
public property let Template_Position_OpenedLink(val)
sTemplate_Position_OpenedLink = val
end property
'Show
Sub Show_Position()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
response.Write VbCrLf & sTemplate_Position_Header & VbCrLf 'Header
Show_Position_Recur(active_page_id)
response.Write VbCrLf & sTemplate_Position_Footer & VbCrLf & VbCrLf 'Footer
End Sub
public sub Show_Position_Recur(page_id)
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "SELECT * FROM pages WHERE page_id=" & page_id
adoRs.Open strSQL, adoCn
if not adoRs.eof then
parent_page_id = adoRs("parent_page_id")
if CInt(parent_page_id) <> 0 then
call Show_Position_Recur(parent_page_id)
end if
sTemplate = adoRs("template")
url = sTemplate & "?active_page_id=" & adoRs("page_id")
if adoRs("title") = "%Search_Internal%" then
sTitle = "Search"
else
sTitle = adoRs("title")
end if
if active_page_id = adoRs("page_id") then
sTmp = sTemplate_Position_OpenedLink
sTmp = replace(sTmp ,"[title]",sTitle)
else
sTmp = sTemplate_Position_Link
sTmp = replace(sTmp ,"[url]",url)
sTmp = replace(sTmp ,"[title]",sTitle)
end if
Response.Write sTmp
end if
adoRs.Close
set adoRs = nothing
end sub
'****************************************************************
' Members
'****************************************************************
'Member Templates
private sTemplate_Member_Header
private sTemplate_Member_Footer
private sTemplate_Member_Link
private sTemplate_Member_Title
public property let Template_Member_Header(val)
sTemplate_Member_Header = val
end property
public property let Template_Member_Footer(val)
sTemplate_Member_Footer = val
end property
public property let Template_Member_Link(val)
sTemplate_Member_Link = val
end property
public property let Template_Member_Title(val)
sTemplate_Member_Title = val
end property
'Members
public sub Show_Member()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
if active_page_id = 1 then
set adoRs = nothing
exit sub
end if
'secure~~~~~~~~
If Session("user_id")<>"" Then
strSQL = "SELECT * FROM pages WHERE parent_page_id=" & active_page_id & " AND pos<>0 order by pos"
else
strSQL = "SELECT * FROM pages WHERE parent_page_id=" & active_page_id & " AND pos<>0 AND date_online<>null AND include_in_site_navigation='Yes' order by pos"
end if
'~~~~~~~~~~~~~~
adoRs.Open strSQL, adoCn
if not adoRs.eof then
'Header
Response.Write VbCrLf & sTemplate_Member_Header & VbCrLf
do while not adoRs.eof
sTemplate = adoRs("template")
url = sTemplate & "?active_page_id=" & adoRs("page_id")
sTmp = sTemplate_Member_Link
sTmp = replace(sTmp ,"[url]",url)
'secure~~~~~~~~
If Session("user_id")<>"" AND adoRs("status")="Working" Then
if Len(CStr(adoRs("caption_working")&""))<>0 then
sTmp = replace(sTmp ,"[caption]",adoRs("caption_working"))
else
sTmp = replace(sTmp ,"[caption]","")
end if
Else
if Len(CStr(adoRs("caption")&""))<>0 then
sTmp = replace(sTmp ,"[caption]",adoRs("caption"))
else
sTmp = replace(sTmp ,"[caption]","")
end if
End If
'~~~~~~~~~~~~~~
sTitle=adoRs("title")
'secure~~~~~~~~
If Session("user_id")<>"" Then
if adoRs("status")="Working" then
if adoRs("include_in_site_navigation")="Yes" then
if IsNull(adoRs("date_online")) then
sTitle = sTitle & sWorkingNotYetOnline
else IsNull(adoRs("date_online"))
sTitle = sTitle & sWorking
end if
else
if IsNull(adoRs("date_online")) then
sTitle = sTitle & sWorkingNotYetOnline_HideFromNav
else IsNull(adoRs("date_online"))
sTitle = sTitle & sWorking_HideFromNav
end if
end if
else
if adoRs("include_in_site_navigation")="No" then
sTitle = sTitle & sHideFromNav
end if
end if
End If
'~~~~~~~~~~~~~~
sTmp = replace(sTmp ,"[title]",sTitle)
Response.Write sTmp
adoRs.MoveNext
loop
'Footer
Response.Write VbCrLf & sTemplate_Member_Footer & VbCrLf & VbCrLf
end if
adoRs.Close
set adoRs = nothing
end sub
'****************************************************************
' Content
'****************************************************************
public sub Show_PageContent()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim adoRs2
set adoRs2 = Server.CreateObject("ADODB.Recordset")
dim strSQL
'*** Site Map ***
if active_page_id=2 then
If Session("user_id")<>"" then
Recur_Admin(0)
else
Recur(0)
end if
response.Write "<input type=hidden name=idSiteMap value='Yes'>"
exit sub
end if
strSQL = "SELECT * FROM pages WHERE page_id=" & active_page_id
adoRs.Open strSQL, adoCn
if not adoRs.eof then
'*** Search ***
if adoRs("Title") = "%Search_Internal%" then
sSearchKeywords = Request.Form("inpSearch")
if sSearchKeywords="" then
Response.Write "Please enter keywords."
adoRs.Close
set adoRs = nothing
exit sub
end if
strSQL = "SELECT * FROM pages WHERE content like '%" & sSearchKeywords & "%' AND include_in_site_navigation='Yes' AND status='Online'"
adoRs2.Open strSQL, adoCn
if adoRs2.eof then
Response.Write "No Search Result."
adoRs2.Close
set adoRs2 = nothing
exit sub
end if
Response.Write "<ul>"
while not adoRs2.eof
Response.Write "<li>" & adoRs2("title")
if adoRs2("caption") & "" <> "" AND adoRs2("caption") & ""<>"<P> </P>" then
Response.Write "<br>" & adoRs2("caption") & "<a href='" & adoRs2("template") & "?active_page_id=" & adoRs2("page_id") & "'>More</a>"
else
Response.Write " <a href='" & adoRs2("template") & "?active_page_id=" & adoRs2("page_id") & "'>More</a>"
end if
Response.Write "</li>"
adoRs2.MoveNext
wend
Response.Write "</ul>"
adoRs2.Close
set adoRs2 = nothing
adoRs.Close
set adoRs = nothing
exit sub
end if
'*** /Search ***
'response.Write adoRs("content")
writeContent adoRs("content")
end if
adoRs.Close
set adoRs = nothing
end sub
'****************************************************************
' Site Map
'****************************************************************
public function Recur_Admin(parent_page_id)
Dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "select * from pages where parent_page_id=" & parent_page_id & " AND pos<>0 order by pos ASC"
adoRs.Open strSQL, adoCn
if parent_page_id=0 then
response.Write "<table cellpadding=0 cellspacing=0 style=''>"
else
response.Write "<table cellpadding=0 cellspacing=0 style='margin-left:10;margin-top:3'>"
end if
do while not adoRs.EOF
sTitle=adoRs("title")
sParentPageID=adoRs("page_id")
sLink=adoRs("template")&"?active_page_id="&adoRs("page_id")
response.Write "<tr><td valign=top style='padding-top:5'> </td><td style='padding-left:3;'>"
response.Write "<a href='"&sLink&"'>"
response.Write sTitle
response.Write "</a> "
if adoRs("status")="Working" then
if adoRs("include_in_site_navigation")="Yes" then
if IsNull(adoRs("date_online")) then
response.Write sWorkingNotYetOnline
else IsNull(adoRs("date_online"))
response.Write sWorking
end if
else
if IsNull(adoRs("date_online")) then
response.Write sWorkingNotYetOnline_HideFromNav
else IsNull(adoRs("date_online"))
response.Write sWorking_HideFromNav
end if
end if
else
if adoRs("include_in_site_navigation")="No" then
response.Write sHideFromNav
else
response.Write sOnline
end if
end if
'~~~~
Response.Write "<script>" & _
"function modalDialogShow(url,width,height)" & _
" {" & _
" var left = screen.availWidth/2 - width/2;" & _
" var top = screen.availHeight/2 - height/2;" & _
" activeModalWin = window.open(url, """", ""width=""+width+"",height=""+height+"",left=""+left+"",top=""+top);" & _
" window.onfocus = function(){if (activeModalWin.closed == false){activeModalWin.focus();};};" & _
" }" & _
"</script>"
Response.Write " " & _
"<a style='font-weight:normal' href=# " & _
"onclick=""modalDialogShow('admin/page_new.asp?active_page_id=" & adoRs("page_id") & "',800,600);"">" & _
"New Page" & _
"</a>"
Response.Write " " & _
"<a style='font-weight:normal' href=# " & _
"onclick=""modalDialogShow('admin/page_edit.asp?active_page_id=" & adoRs("page_id") & "',800,600);"">" & _
"Edit" & _
"</a>"
Response.Write " " & _
"<a style='font-weight:normal' href=# " & _
"onclick=""modalDialogShow('admin/page_delete.asp?action=confirm&active_page_id=" & adoRs("page_id") & "',300,150);"">" & _
"Delete" & _
"</a>"
'~~~~
call(Recur_Admin(sParentPageID))
response.Write "</td><tr>"
adoRs.MoveNext
loop
response.Write "</table>"
adoRs.Close
set adoRs = nothing
end function
public function Recur(parent_page_id)
Dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "select * from pages where parent_page_id=" & parent_page_id & " AND pos<>0 AND include_in_site_navigation='Yes' order by pos ASC"
adoRs.Open strSQL, adoCn
if parent_page_id=0 then
response.Write "<table cellpadding=0 cellspacing=0 style=''>"
else
response.Write "<table cellpadding=0 cellspacing=0 style='margin-left:10;margin-top:3'>"
end if
do while not adoRs.EOF
sTitle=adoRs("title")
sParentPageID=adoRs("page_id")
sLink=adoRs("template")&"?active_page_id="&adoRs("page_id")
response.Write "<tr><td valign=top style='padding-top:5'> </td><td style='padding-left:3;'>"
response.Write "<a href='"&sLink&"'>"
response.Write sTitle
response.Write "</a>"
call(Recur(sParentPageID))
response.Write "</td><tr>"
adoRs.MoveNext
loop
response.Write "</table>"
adoRs.Close
set adoRs = nothing
end function
private sTemplate_SiteMap_Link
public property let Template_SiteMap_Link(val)
sTemplate_SiteMap_Link = val
end property
public sub Show_SiteMap()
dim adoRs
set adoRs = Server.CreateObject("ADODB.Recordset")
dim strSQL
strSQL = "SELECT * FROM pages WHERE page_id=2"
adoRs.Open strSQL, adoCn
if not adoRs.eof then
sTemplate = adoRs("template")
end if
adoRs.Close
set adoRs = nothing
url = sTemplate&"?active_page_id=2"
sTmp = sTemplate_SiteMap_Link
sTmp = replace(sTmp ,"[url]",url)
response.Write sTmp
end sub
'****************************************************************
' Print
'****************************************************************
private sTemplate_Print_Link
public property let Template_Print_Link(val)
sTemplate_Print_Link = val
end property
public sub Show_Print()
url = "printed.asp?active_page_id="&active_page_id
sTmp = sTemplate_Print_Link
sTmp = replace(sTmp ,"[url]",url)
response.Write sTmp
end sub
End Class
Function writeContent(str)
if IsNull(str) then str=""
a1 = InStr(1,str,"<%")
if a1=0 then
response.write Mid(str,1)
str=""
else
response.write Mid(str,1,a1-1)
str=Mid(str,a1+2)
end if
do while not str=""
a2 = InStr(1,str,"%" & ">")'pasti ada
'Execute ( Mid(str,1,a2-1))
if Mid(Trim(Mid(str,1,a2-1)),1,1) = "=" then
Execute("Response.Write " & Mid(Trim(Mid(str,1,a2-1)),2))
else
Execute ( Mid(str,1,a2-1))
end if
str = Mid(str,a2+2)
a1 = InStr(1,str,"<%")
if a1=0 then
response.write Mid(str,1)
str=""
else
response.write Mid(str,1,a1-1)
str=Mid(str,a1+2)
end if
loop
End Function
%>
|
September 18th, 2009, 05:34 PM
|
|
Friend of Wrox
|
|
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,323
Thanks: 3
Thanked 70 Times in 69 Posts
|
|
Oh, well...all bets are off.
You are using VBScript's EXECUTE statement, which takes some arbitrary string and executes it. And so it's quite possible--likely even--that you have a bogus string. When you try to Execute it, the error is in the code in that string, that we can't see.
In my opinion, the VBS creators should be *SHOT* for ever putting EXECUTE into the language. It promotes *HORRIBLE* coding practices and even worse performance.
Anyway, ASP error line numbers are often off by 1 or 2 (buggy VBScript compiler?), so I'm sure the error is actually in this line:
Execute ( Mid(str,1,a2-1))
I know I'll be sorry, but I just have to ask: WHY would you use EXECUTE for *this* line:
Execute("Response.Write " & Mid(Trim(Mid(str,1,a2-1)),2))
Instead of simply
Response.Write Mid(Trim(Mid(str,1,a2-1)),2)
???
|
September 19th, 2009, 07:43 PM
|
|
Registered User
|
|
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Quote:
Originally Posted by Old Pedant
Oh, well...all bets are off.
You are using VBScript's EXECUTE statement, which takes some arbitrary string and executes it. And so it's quite possible--likely even--that you have a bogus string. When you try to Execute it, the error is in the code in that string, that we can't see.
In my opinion, the VBS creators should be *SHOT* for ever putting EXECUTE into the language. It promotes *HORRIBLE* coding practices and even worse performance.
Anyway, ASP error line numbers are often off by 1 or 2 (buggy VBScript compiler?), so I'm sure the error is actually in this line:
Execute ( Mid(str,1,a2-1))
I know I'll be sorry, but I just have to ask: WHY would you use EXECUTE for *this* line:
Execute("Response.Write " & Mid(Trim(Mid(str,1,a2-1)),2))
Instead of simply
Response.Write Mid(Trim(Mid(str,1,a2-1)),2)
???
|
So am I correct in thinking that if i change all of the Execute("Response.Write " & Mid(Trim(Mid(str,1,a2-1)),2)) to Response.Write Mid, it will work??
|
September 20th, 2009, 04:01 AM
|
|
Friend of Wrox
|
|
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,323
Thanks: 3
Thanked 70 Times in 69 Posts
|
|
*THOSE* lines will work. But the ones do *NOT* have "Response.Write" in them won't.
There's not other way in VBS to accomplish
Code:
Execute ( Mid(str,1,a2-1))
, for example.
I don't see how anybody can help you debug this without being able to see what is in str when Function writeContent(str) is called.
Were I in your shoes, I would want to SHOOT the person who wrote this code. |
| Thread Tools |
Search this Thread |
|
|
|
| Display Modes |
 Linear Mode
|
Posting Rules
|
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts
HTML code is Off
|
|
|
|
|
