Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Forum using CGI written in QBASIC

33 views
Skip to first unread message

dean.m...@gmail.com

unread,
Jun 4, 2008, 9:11:55 AM6/4/08
to
I made a forum using CGI in QBASIC. It allows HTML as well as text
posts. The url is:

http://samanddeanus.no-ip.org/forum

dean.m...@gmail.com

unread,
Jun 4, 2008, 9:14:02 AM6/4/08
to

Here is the source code for the reply.exe CGI daemon:

contentlength = VAL(ENVIRON$("CONTENT_LENGTH"))
x$ = INPUT$(7)
contentlength = contentlength - 7
x$ = UCASE$(x$)
IF x$ <> "AUTHOR=" THEN
PRINT "Content-type: text/plain"
PRINT
PRINT "Invalid input"
END
END IF
x$ = ""
author$ = ""
DO
x$ = INPUT$(1): contentlength = contentlength - 1
IF x$ = "&" THEN EXIT DO
IF x$ = "+" THEN
author$ = author$ + "&#32;"
ELSEIF x$ = "%" THEN
author$ = author$ + "&#x" + INPUT$(2) + ";"
contentlength = contentlength - 2
ELSE
author$ = author$ + "&#x" + HEX$(ASC(x$)) + ";"
END IF
LOOP
x$ = INPUT$(6)
contentlength = contentlength - 6
x$ = UCASE$(x$)
IF x$ <> "TITLE=" THEN
PRINT "Content-type: text/plain"
PRINT
PRINT "Invalid input"
END
END IF
x$ = ""
title$ = ""
DO
x$ = INPUT$(1): contentlength = contentlength - 1
IF x$ = "&" THEN EXIT DO
IF x$ = "+" THEN
title$ = title$ + "&#32;"
ELSEIF x$ = "%" THEN
title$ = title$ + "&#x" + INPUT$(2) + ";"
contentlength = contentlength - 2
ELSE
title$ = title$ + "&#x" + HEX$(ASC(x$)) + ";"
END IF
LOOP
x$ = INPUT$(8)
contentlength = contentlength - 8
x$ = UCASE$(x$)
IF x$ <> "CONTENT=" THEN
PRINT "Content-type: text/plain"
PRINT
PRINT "Invalid input"
END
END IF
x$ = ""
content$ = ""
DO
x$ = INPUT$(1): contentlength = contentlength - 1
IF x$ = "&" THEN EXIT DO
IF x$ = "+" THEN
content$ = content$ + " "
ELSEIF x$ = "%" THEN
content$ = content$ + CHR$(VAL("&h" + INPUT$(2)))
contentlength = contentlength - 2
ELSE
content$ = content$ + x$
END IF
LOOP
x$ = INPUT$(8)
contentlength = contentlength - 8
x$ = UCASE$(x$)
IF x$ <> "REPLYTO=" THEN
PRINT "Content-type: text/plain"
PRINT
PRINT "Invalid input"
END
END IF
x$ = ""
replyto$ = ""
DO
x$ = INPUT$(1): contentlength = contentlength - 1
IF x$ = "&" THEN EXIT DO
IF x$ = "+" THEN
replyto$ = replyto$ + " "
ELSEIF x$ = "%" THEN
replyto$ = replyto$ + CHR$(VAL("&h" + INPUT$(2)))
contentlength = contentlength - 2
ELSE
replyto$ = replyto$ + x$
END IF
LOOP
x$ = INPUT$(11)
contentlength = contentlength - 11
x$ = UCASE$(x$)
IF x$ <> "REPLYLEVEL=" THEN
PRINT "Content-type: text/plain"
PRINT
PRINT "Invalid input"
END
END IF
x$ = ""
replylevel$ = ""
html = 0
FOR i = 1 TO contentlength
PRINT x$;
x$ = INPUT$(1)
IF x$ = "&" THEN html = 1: EXIT FOR
IF x$ = "+" THEN
replylevel$ = replylevel$ + " "
ELSEIF x$ = "%" THEN
replylevel$ = replylevel$ + CHR$(VAL("&h" + INPUT$(2)))
i = i + 2
ELSE
replylevel$ = replylevel$ + x$
END IF
NEXT
replylevel = VAL(replylevel$)

OPEN "c:\apache\apache\htdocs\threads\cur.txt" FOR INPUT AS #1
INPUT #1, z&
CLOSE #1
OPEN "c:\apache\apache\htdocs\threads\cur.txt" FOR OUTPUT AS #1
PRINT #1, z& + 1
CLOSE #1
OPEN "c:\apache\apache\htdocs\threads\" + HEX$(z&) + ".htm" FOR OUTPUT
AS #1
PRINT #1, "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' "
PRINT #1, "'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>"
PRINT #1, "<html lang='en' xmlns='http://www.w3.org/1999/xhtml'
xml:lang='en'>"
PRINT #1, "<head>"
PRINT #1, "<title>" + title$ + "</title>"
PRINT #1, "</head>"
PRINT #1, "<body>"
PRINT #1, "<h1>" + title$ + "</h1>"
PRINT #1, "<p>by " + author$ + "</p>"
IF html THEN
PRINT #1, content$
ELSE
PRINT #1, "<pre>"
FOR i = 1 TO LEN(content$)
a$ = MID$(content$, i, 1)
IF a$ = ">" THEN
PRINT #1, "&gt;";
ELSEIF a$ = "<" THEN
PRINT #1, "&lt;";
ELSEIF a$ = "&" THEN
PRINT #1, "&amp;";
ELSE
PRINT #1, a$;
END IF
NEXT
PRINT #1, "</pre>"
END IF
PRINT #1, "<form method='post' action='/cgi-bin/reply.exe'>"
PRINT #1, "<p>Your Name <input type='text' name='author' size='50'
maxlength='50' /></p>"
PRINT #1, "<p>Post Title <input type='text' name='title' size='50'
maxlength='50' /></p>"
PRINT #1, "<p><textarea name='content' rows='25' cols='80'></
textarea></p>"
PRINT #1, "<p>Enable HTML <input type='hidden' name='replyto' value='"
+ HEX$(z&) + "' />"
PRINT #1, "<input type='hidden' name='replylevel' value='" + LTRIM$
(RTRIM$(STR$(replylevel + 1))) + "' />"
PRINT #1, "<input type='checkbox' name='html' />"
PRINT #1, "<input type='submit' value='Post Response' /></p>"
PRINT #1, "</form>"
PRINT #1, "</body></html>"
CLOSE #1
OPEN "..\htdocs\forum.htm" FOR INPUT AS #1
OPEN "c:\apache\apache\htdocs\temp.tmp" FOR OUTPUT AS #2
DO
LINE INPUT #1, x$
PRINT #2, x$
LOOP UNTIL x$ = "<!--" + replyto$ + "-->"
PRINT #2, "<pre>" + SPACE$(4 * replylevel) + "<a href='/threads/" + HEX
$(z&) + ".htm'>" + title$ + " by " + author$ + "</a></pre>"
PRINT #2, "<!--" + HEX$(z&) + "-->"
WHILE NOT EOF(1)
LINE INPUT #1, x$
PRINT #2, x$
WEND
CLOSE
SHELL "cat c:\apache\apache\htdocs\temp.tmp > c:\apache\apache\htdocs
\forum.htm"
PRINT "Status: 302 Found"
PRINT "Location: http://" + ENVIRON$("SERVER_NAME") + "/forum.htm"
PRINT
END

dean.m...@gmail.com

unread,
Jun 4, 2008, 9:14:46 AM6/4/08
to
On Jun 4, 8:11 am, dean.mene...@gmail.com wrote:


Here is the code for the start.exe CGI daemon that starts a new
thread.

html = 0
FOR i = 1 TO contentlength

x$ = INPUT$(1)
IF x$ = "&" THEN html = 1: EXIT FOR
IF x$ = "+" THEN

content$ = content$ + " "
ELSEIF x$ = "%" THEN
content$ = content$ + CHR$(VAL("&h" + INPUT$(2)))

i = i + 2
ELSE

content$ = content$ + x$
END IF

NEXT

PRINT #1, "<input type='hidden' name='replylevel' value='1' />"


PRINT #1, "<input type='checkbox' name='html' />"
PRINT #1, "<input type='submit' value='Post Response' /></p>"
PRINT #1, "</form>"
PRINT #1, "</body></html>"
CLOSE #1

SHELL "tidy -f nul -m -asxml c:\apache\apache\htdocs\threads\" + HEX$
(z&) + ".htm"


OPEN "..\htdocs\forum.htm" FOR INPUT AS #1
OPEN "c:\apache\apache\htdocs\temp.tmp" FOR OUTPUT AS #2
DO
LINE INPUT #1, x$
PRINT #2, x$

LOOP UNTIL x$ = "<!-- stuff here -->"
PRINT #2, "<pre><a href='/threads/" + HEX$(z&) + ".htm'>" + title$ + "

0 new messages