%@LANGUAGE=VBScript%>
<%Option Explicit
Response.Buffer = True
Response.CacheControl = "Private"
Response.Expires = -1 'We don't want this to be cached anywhere
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Printer friendly script is essentially the textonly script but with some
'processing left out and some extra processing added.
'Graphics are left in but all href links are removed.
'A width option is added to allow different widths to be defined.
'Version 1.0 based on version 1.5 31-October-2002 of textonly script
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Globals
Dim STRTHISDIR, STRCONTENT, STRSERVERNAME
Dim tagStart, tagEnd, strEmailTo, strEmailFrom
Dim strImportance, strSubject, strText
Dim strFileID, strHomePage, strHomeRoot, strHomeRoot1
Dim strRefer 'the referer
Dim strWidth
'Uses the XMLHTTP Module
'Search for 'XMLHTTP Module' in www.microsoft.com
'-------------------------------------------
'SET UP CONFIGURATIONS
strEmailTo = "paulgibbs@o2.co.uk" 'The to address
strEmailFrom = "textonly@webconcerns.co.uk" 'the from address
strImportance = "2"
'
'
tagStart = ""
tagEnd = ""
'
'
'tagStart = ""
'tagEnd = ""
'To define the menu use :
'
'
'define the home site
'these are needed because you can call a web site by
'http://www.server.com/ and it assumes default.asp
'this can confuse the program later on
strHomePage = "http://www.webconcerns.co.uk/default.asp" 'the home page
strHomeRoot = "http://www.webconcerns.co.uk/" 'the root directory with '/'
strHomeRoot1 = "http://www.webconcerns.co.uk" 'the root directory without '/'
'-------------------------------------------
'-------------------------------------
sub main()
Dim xml_http, post_item
Dim MyItem, strPostInfo, i
Dim strType, url
strWidth = Request.QueryString ("width")
if strWidth = "" then strWidth = 650 end if
'Response.Write Request.ServerVariables ("ALL_HTTP")
'Response.End
strRefer = Request.ServerVariables("HTTP_REFERER")
'Response.Write strRefer
'Response.End
If strRefer <> "" Then 'If this didn't come from anywhere, ignore.
if strRefer = strHomeRoot or strRefer = strHomeRoot1 then
strRefer = strHomePage
end if
strType = Request.ServerVariables ("REQUEST_METHOD") 'this will be POST or GET
strPostInfo = ""
i = 0
For Each MyItem in Request.Form
if i = 0 then
strPostInfo = MyItem & "=" & Request.Form(MyItem).Item
i = i + 1
else
strPostInfo = strPostInfo & "&" & MyItem & "=" & Request.Form(MyItem).Item
end if
Next
For Each MyItem in Request.QueryString
if i = 0 then
strPostInfo = MyItem & "=" & Request.QueryString(MyItem).Item
i = i + 1
else
strPostInfo = strPostInfo & "&" & MyItem & "=" & Request.QueryString(MyItem).Item
end if
Next
if instr(1,strPostInfo,"?") > 0 then
strPostInfo = mid(strPostInfo,instr(1,strPostInfo,"?") + 1)
end if
STRSERVERNAME = Request.ServerVariables ("SERVER_NAME")
Set xml_http = Server.CreateObject("Microsoft.XMLHTTP")
url = Request.QueryString ("url") 'if this is a query string then reconstruct the url with any gets.
if instr(1,url,"?") > 0 then
url = mid(url,1,instr(1,url,"?") - 1)
end if
if url <> "" then
STRTHISDIR = mid(url,1,inStrRev(url,"/") )
if strType = "POST" then
xml_http.Open "POST", url, False
else
xml_http.Open "GET", url & "?" & strPostInfo, False
strFileID = url & "?" & strPostInfo
end if
else
STRTHISDIR = mid(strRefer,1,inStrRev(strRefer,"/"))
if strType = "POST" then
xml_http.Open "POST", strRefer, False
else
xml_http.Open "GET", strRefer, False
end if
end if
'This is needed to overcome the problem with .htm pages which give an error
'if do xml_http.Send (strPostInfo) Don't understand it though.
if strType = "POST" then
xml_http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
if strPostInfo <> "" then
xml_http.Send (strPostInfo)
else
xml_http.Send
end if
else
xml_http.Send
end if
STRCONTENT = xml_http.responseText
Set xml_http = Nothing
'----------------------
'Handle Response.Status
'200 or 401 is not an error, anything else is an error
'3xx is a redirect
if instr(STRCONTENT, "404 Error") > 0 then
%>
Printer friendly version
The page cannot be found or there is a bug
in the text only display script
Back
<%
strSubject = "Error in Text Only Version"
strText = "Error in " & Request.ServerVariables("HTTP_REFERER")
call sendmail(strEMailTo, strEMailFrom, "", "", strSubject, strImportance, strText)
Response.End
end if
call process()
end if
end sub
'----------------------------------------------
sub process()
Dim strBody, strMenu, strTitle, strHead, strJavascript
strBody = getBody()
strMenu = getMenu()
strTitle = getTitle()
strHead = getHead()
strJavascript = getJavascript(strHead)
strBody = Exclude(strBody) 'remove text which has to be excluded
strBody = Comments(strBody) 'remove comments
strBody = fonts(strBody) 'remove
strBody = span(strBody) 'remove and
strBody = applets(strBody) 'remove applets
strBody = shockwave(strBody) 'remove shockwave
strBody = map(strBody) 'deal with