Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > ASP.NET and ASP > ASP 3 Classic ASP Active Server Pages 3.0 > Classic ASP Professional
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
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 Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old September 17th, 2009, 03:51 PM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default 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>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p></?xml:namespace></div></?xml:namespace></p></?xml:namespace></p>
Reply With Quote
  #2 (permalink)  
Old September 18th, 2009, 12:12 AM
Friend of Wrox
 
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,649
Thanks: 3
Thanked 141 Times in 140 Posts
Default

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).
Reply With Quote
  #3 (permalink)  
Old September 18th, 2009, 12:40 AM
Friend of Wrox
Points: 2,473, Level: 20
Points: 2,473, Level: 20 Points: 2,473, Level: 20 Points: 2,473, Level: 20
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: May 2004
Location: India
Posts: 642
Thanks: 0
Thanked 43 Times in 42 Posts
Default

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
Click the "Thanks" button if this post helped you.
Reply With Quote
  #4 (permalink)  
Old September 18th, 2009, 10:39 AM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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 11:50 AM..
Reply With Quote
  #5 (permalink)  
Old September 18th, 2009, 10:49 AM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default 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>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p>
<p>&nbsp;</p></?xml:namespace></div></?xml:namespace></p></?xml:namespace></p>
________________________________________
Last edited by mehere : Yesterday at 05:23 PM.
Reply With Quote
  #6 (permalink)  
Old September 18th, 2009, 10:59 AM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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??
Reply With Quote
  #7 (permalink)  
Old September 18th, 2009, 11:48 AM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Quote:
Originally Posted by Old Pedant View Post
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;'>&nbsp;<span style='background:white'>(working)</span></span>"
sWorkingNotYetOnline = "<span style='text-decoration:none;color:orange;font-size:9px;font-weight:bold;'>&nbsp;<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;'>&nbsp;<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;'>&nbsp;<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;'>&nbsp;<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;'>&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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 & "&nbsp;<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>&nbsp;</P>" then
						Response.Write "<br>" & adoRs2("caption") & "<a href='" & adoRs2("template") & "?active_page_id=" & adoRs2("page_id") & "'>More</a>"
					else
						Response.Write " &nbsp;<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'>&nbsp;</td><td style='padding-left:3;'>"		
			response.Write "<a href='"&sLink&"'>"
			response.Write sTitle
			response.Write "</a>&nbsp;"			
			
			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 "&nbsp;&nbsp;" & _
					"<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 "&nbsp;&nbsp;" & _
					"<a style='font-weight:normal' href=# " & _
					"onclick=""modalDialogShow('admin/page_edit.asp?active_page_id=" & adoRs("page_id") & "',800,600);"">" & _
					"Edit" & _
					"</a>"
				
			Response.Write "&nbsp;&nbsp;" & _
					"<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'>&nbsp;</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 
%>
Reply With Quote
  #8 (permalink)  
Old September 18th, 2009, 04:34 PM
Friend of Wrox
 
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,649
Thanks: 3
Thanked 141 Times in 140 Posts
Default

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)
???
Reply With Quote
  #9 (permalink)  
Old September 19th, 2009, 06:43 PM
121 121 is offline
Authorized User
 
Join Date: Sep 2009
Posts: 10
Thanks: 0
Thanked 0 Times in 0 Posts
Question

Quote:
Originally Posted by Old Pedant View Post
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??
Reply With Quote
  #10 (permalink)  
Old September 20th, 2009, 03:01 AM
Friend of Wrox
 
Join Date: Jun 2008
Location: Snohomish, WA, USA
Posts: 1,649
Thanks: 3
Thanked 141 Times in 140 Posts
Default

*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.
Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Microsoft VBScript compilation error '800a03f6' jdutwell Classic ASP Basics 3 April 2nd, 2008 01:50 PM
Microsoft VBScript compilation error '800a03f6' ksrhyd Classic ASP Professional 0 October 11th, 2007 07:53 AM
Microsoft VBScript compilation error '800a03f6' dondavanzo Access ASP 1 May 30th, 2006 02:11 PM
Microsoft VBScript compilation error karlzoe Classic ASP Databases 2 December 29th, 2004 10:44 AM
Microsoft VBScript compilation error '800a03f6' stevesole Access ASP 2 June 8th, 2004 02:04 PM



All times are GMT -4. The time now is 03:09 AM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.