<%@language="VBScript"%>
<%option explicit%>
<!--#include file="easylife.inc"-->
<!--#include file="..\custom.inc"-->
<%
'it will be interesting to add the following features:
'control board remotely using a separate file
'separate flag "last refreshed ID" to check even after warning ...
'DEFINITIONS:
dim wmessage, message_file, take_stored, lenstored, time_stamp, stored_file_limit
dim post_thread_ID, warn_about_missed_messages
dim remote_host
dim ID_mark, fresh
dim this_page
dim atop,ftime,fntred,fmess,fremote,furl,fscript,fpath,fprot,fquery,fbend, fend
dim ws, wii,i
dim hide_mask
dim preformatted
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' CONSTANTS ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'CONTROLLING:
preformatted = true
stored_file_limit = 200000 'do not let file be too big;
message_file = "hidden.txt"
'PLAIN CONSTANTS:
ID_mark = ve & "<!post_thread_ID=>" 'message ID keyword locating ID in web page;
warn_about_missed_messages = false 'used when informing user about new messages;
atop = "<td valign=top width=150>"
ftime = "<font color=aa00aa size=1>"
fntred = "<font color=ff00aa size=1>"
if preformatted then
fmess = _
"<td width=500 valign=top>" & _
"<font color=0000ff size=2><pre>"
fbend = " </pre></font></td>"
else
fmess = "<td width=500 valign=top><font color=0000ff size=2><b>"
fbend = " </b></font></td>"
end if
fremote = atop & "<font color=aa00aa size=1>"
furl = atop & "<font color=444400 size=1>"
fscript = atop & "<font color=aa00aa size=1>"
fpath = atop & "<font color=aa00aa size=1>"
fprot = atop & "<font color=aa00aa size=1>"
fquery = atop & "<font color=aa00aa size=1>"
fend = " </font></td>"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' SESSION PARAMETERS ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
remote_host = Request.ServerVariables("remote_host")
'if you have problems with "ServerVariables" in php, just use the following string:
'this_page = "index.php"
this_page = Request.ServerVariables("path_info")
time_stamp = "" & date & " " & time
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' READ DATA ''
'' read stored board take_stored
'' look for recent ID
'' depending on problems application terminates or board = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
post_thread_ID = "0" 'INITIATING "POST_THREAD_ID" ("session" - not in ASP meaning session)
on error resume next
take_stored = read_file(message_file)
if err.number > 0 then
response.write "when reading a file " & ve & _
err.number & " " & err.description
response.end
else
'find last ID:
wi = instr(take_stored, ID_mark )
if wi <> 0 then
wii = instr(wi,take_stored,"&")
WII = CLNG(WII)
if wii <> 0 then
'retrieve last known ID:
err.clear
post_thread_ID = CStr(Cint(mid(take_stored,wi+len(ID_mark),(wii-len(ID_mark)-wi) )))
if err.number > 0 then
response.write "Exception when retrieving last message number." & err.number & " " & err.description
response.end
end if
else
take_stored = ""
end if
else
take_stored = ""
end if
end if
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' the end of data reading
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' HANDLE REQUESTES: ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'TAKE MESSAGE:
wmessage = Trim(request.form("txaMessage"))
'slow:
'escape from HTML calls in the message:
'rem this string out if you want to let your clients exchange html-pages ...
wmessage =replace(replace(replace(replace(wmessage,"&","&"),">", ">"), "<","<"),"""",""")
if not preformatted then
wmessage = replace(wmessage,ve, vr)
wmessage = replace(wmessage,vblf, vr)
wmessage = replace(wmessage,vr, vh)
'wmessage = replace(replace(replace(wmessage,ve, vr),vblf, vr),vr, vh)
end if
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' MANAGE YOUR BOARD REMOTELY ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'CLEAN UP AND SEND MESSAGE ABOUT THIS
if instr(wmessage,"refresh the board") > 0 then
'before purging out all messages archive them in file with date stamp:
on error resume next
write_file message_file & "." & month(date) & "." & day(date) & "." & hour(time) & "." & minute(time) & "." & second(time) & ".txt" , take_stored
if err.number > 0 then
response.write "when writing to a file " & ve & _
err.number & " " & err.description
response.end
end if
'now purge the board:
take_stored = ""
'tell client that board was cleaned up ...
wmessage = "board has been refreshed ..."
end if
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' END OF REMOTE MANAGEMENT ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INCLUDE (MESSAGE IF ANY) INTO TAKE_STORED:
if wmessage <> "" then
'advance post_thread_ID BECAUSE A NEW MESSAGE ...
post_thread_ID = CStr(Cint(post_thread_ID) + 1)
'if you like to masquerade some addresses: '''''''''''''''''''''''''''''''''''
hide_mask = "127.0.0"
if instr(remote_host,hide_mask) > 0 then remote_host = hide_mask & "****"
'end if masquerading '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
take_stored = replace(take_stored,"color=0000ff", "color=0066bf") ' too much resources ...
take_stored = "<tr>" & _
atop & fntred & ID_mark & post_thread_ID & " </font>" & _
ftime & TIME_STAMP & fend & _
fmess & vbcrlf & WMESSAGE & vbcrlf & fbend & _
fremote & " from " & remote_host & fend & _
"</tr>" & ve & ve & ve & ve & _
take_stored
'RESTRICT SIZE:
lenstored = len(take_stored)
if lenstored > stored_file_limit then
take_stored = left(take_stored,stored_file_limit)
i = instrrev(take_stored, "</tr>")
if i>0 then take_stored = left(take_stored,i-1)
end if
'end to restrict size''''''''''''''''''''''
'RESAVE MSSAGE:
'coll = write_file( message_file, take_stored ) 'coll = write_file( "C:\Inetpub\wwwroot\messenger\" & message_file, take_stored )
write_file message_file, take_stored
'if coll <> "" then
' response.write coll
' response.end
'end if
end if
if wmessage = "" then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' CHECK FOR NEW MESSAGES FROM INACTIVE CLIENTS ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
if Request.QueryString("hdnCheckMessages")="checking" then
'yes, client is inactive;
'take an ID of last message which client knows:
ws = Request.QueryString("hdnLastID")
if post_thread_ID <> ws then warn_about_missed_messages = true 'client needs warning;
end if
end if
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' MAKE A RESPONSE: ''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
%>
<html><head><title><%
if warn_about_missed_messages then response.write "new message(s) ..." else response.write "server time: " & time
%></title>
<script language="JavaScript"> <!--
function refreshment() {
setTimeout("make_refreshment()",10000);
}
function make_refreshment() {
//document.forms["check_messages"].submit(); 'it asks client to submit, not good ...
if ( document.forms[0].txaMessage.value == "" ){
document.location = "<%=this_page%>?hdnCheckMessages=checking&hdnLastID=<%=post_thread_ID%>&server_time=<%=time%>";
}
}
//-->
</script>
</head><body link=ff0000 vlink=009900
<%
if warn_about_missed_messages then
response.write " bgcolor=aaffaa "
else
response.write " bgcolor=aadddd "
response.write " onLoad=""refreshment()"" "
end if
%> >
<table width=700><tr><td align=center>
<form action="<%=this_page%>" method=post name=somename><input type=hidden name=submitted value=yes>
<font color=0099cc size=2><b> you can post your message here: <br></b></font>
<textarea name=txaMessage cols=60 rows=5></textarea><br>
<input type=submit value="post"><input type=submit value="refresh without post" onClick="this.form.txaMessage.value=''; return true;">
</form>
</td></tr></table>
<!--form action="<%=this_page%>" method=post name=check_messages>
<input type=hidden name=hdnCheckMessages value=checking>
<input type=hidden name=hdnLastID value=<%=post_thread_ID%> >
</form-->
<%
if warn_about_missed_messages then _
response.write "<font color=00aa00 size=3><b>" & _
"you may have more new messages ... </b></font><br><br>"
'OUTPUT THE BORD:
response.write "<table border=1 cellpadding=0 cellspacing==0 width=810> " & take_stored & "</table>"
%>
</body></html>