This is probably the most ridiculous project I've ever done. I made a CGI-BIN reddit clone (with some quirks and obviously unsafe against all sorts of dumb hacks) in the spirit of the latest coding competitions on Reddit. Is it possible to make web applications using a real mode DOS QBASIC application? Yes! Yes it is! Depending on the httpd the person is using, it may require an additional helper program that I wrote called prclone.cgi. It's a very very very short C++ program that pipes stdout correctly from DOS because Apache does it wrong for some reason. I haven't tested it with IIS but I figure IIS will do it correctly since it's Microsoft and all. INSTRUCTIONS: Copy prclone.cgi and rclone.exe into a properly configured cgi-bin directory. Make sure cgi stuff has permissions to write files. Attempt to load up rclone.exe. If that doesn't work, it probably means your httpd doesn't pipe in DOS apps correctly so you can load up prclone.cgi and it should work from there. rclone.exe will happily work either way. Here's a screenshot (click on it to enlarge):  PRCLONE.CPP - LISTING #include <iostream> #include <string> #include <stdio.h> int main(int argc, char *argv[]) { std::string piper; FILE* data = popen("rclone.exe","r"); for(char c = getc(data);c != EOF;c = getc(data)) { piper.push_back(c); } pclose(data); std::cout << piper; return 0; } RCLONE.BAS - LISTING DECLARE FUNCTION HexDec& (txt1$, txt2$) DECLARE FUNCTION GetNextVar& (txt$) CONST PEMPTY = 0 CONST pVAR = 1 CONST pval = 2 CONST PHEX1 = 3 CONST PHEX2 = 4 TYPE DataBaseRec link AS STRING * 256 title AS STRING * 256 votes AS INTEGER END TYPE DIM SHARED query AS STRING DIM SHARED qtitle AS STRING DIM SHARED qlink AS STRING DIM SHARED qvote AS STRING DIM SHARED voterec AS LONG DIM SHARED dat AS DataBaseRec DIM SHARED script AS STRING DIM SHARED retvar AS STRING DIM SHARED retval AS STRING script = ENVIRON$("SCRIPT_NAME") PRINT "Content-type:text/html" PRINT "" PRINT "<html>" PRINT "<head><title>Reddit clone in QBASIC!</title></head>" PRINT "<body>" PRINT "<form action='" + script + "' method='GET'>" PRINT "<input type='text' name='title' value='title'>" PRINT "<input type='text' name='link' value='link'>" PRINT "<input type='submit' name='Submit'>" PRINT "</form><br /><br />" query = ENVIRON$("QUERY_STRING") a% = 1 voterec = 0 WHILE a% > 0 a% = GetNextVar&(query) IF a% > 0 OR a% = -2 THEN IF retvar = "title" THEN qtitle = retval IF retvar = "link" THEN qlink = retval IF retvar = "upvote" THEN qvote = "up": voterec = VAL(retval) IF retvar = "downvote" THEN qvote = "down": voterec = VAL(retval) IF a% > 0 THEN query = MID$(query, a%) END IF WEND IF query <> "" THEN IF voterec <> 0 THEN OPEN "reddit.txt" FOR RANDOM AS #1 LEN = LEN(dat) maxrec = LOF(1) / LEN(dat) IF voterec >= 1 AND voterec <= maxrec THEN GET #1, voterec, dat IF qvote = "up" THEN dat.votes = dat.votes + 1 IF qvote = "down" THEN dat.votes = dat.votes - 1 PUT #1, voterec, dat ELSE PRINT "INVALID VOTE RECORD" END IF CLOSE #1 END IF IF qtitle <> "" AND qlink <> "" THEN OPEN "reddit.txt" FOR RANDOM AS #1 LEN = LEN(dat) maxrec = LOF(1) / LEN(dat) dat.votes = 1 dat.title = LEFT$(qtitle, 256) dat.link = LEFT$(qlink, 256) PUT #1, maxrec + 1, dat CLOSE #1 END IF END IF OPEN "reddit.txt" FOR RANDOM AS #1 LEN = LEN(dat) maxrec = LOF(1) / LEN(dat) REM print STR$(maxrec) + " records to read" IF maxrec >= 1 THEN FOR countrec = 1 TO maxrec GET #1, countrec, dat PRINT "<form action='" + script + "' method='GET'><input type='hidden' name='upvote' value=" + STR$(countrec) + "><input type='submit' value='↑'></form>" PRINT " " + STR$(dat.votes) + " : <a href='" + RTRIM$(dat.link) + "'>" + RTRIM$(dat.title) + "</a><br />" PRINT "<form action='" + script + "' method='GET'><input type='hidden' name='downvote' value=" + STR$(countrec) + "><input type='submit' value='↓'></form>" NEXT END IF CLOSE #1 PRINT "</body>" PRINT "</html>" FUNCTION GetNextVar& (txt$) parsestate = PEMPTY retvar = "" retval = "" convval1$ = "" convval2$ = "" conv% = 0 prevstate% = PEMPTY FOR i& = 1 TO LEN(txt$) a$ = MID$(txt$, i&, 1) SELECT CASE a$ CASE "a" TO "z", "G" TO "Z", ".", "-", "~": IF parsestate = PEMPTY THEN retvar = retvar + a$ parsestate = pVAR ELSEIF parsestate = pVAR THEN retvar = retvar + a$ ELSEIF parsestate = pval THEN retval = retval + a$ ELSEIF parsestate = PHEX1 OR parsestate = PHEX2 THEN PRINT "EXPECTING HEX VALUE GOT NONHEX" GetNextVar& = -1 EXIT FUNCTION END IF CASE "=" IF parsestate = PEMPTY THEN PRINT "ERROR PARSING VALUE" GetNextVar& = -1 EXIT FUNCTION ELSEIF parsestate = pVAR THEN parsestate = pval ELSEIF parsestate = pval OR parsestate = PHEX1 OR parsestate = PHEX2 THEN PRINT "ERROR PARSING VALUE" GetNextVar& = -1 EXIT FUNCTION END IF CASE "+" IF parsestate = PEMPTY OR parsestate = PHEX1 OR parsestate = PHEX2 THEN PRINT "ERROR PARSING VALUE" GetNextVar& = -1 EXIT FUNCTION ELSEIF parsestate = pVAR THEN retvar = retvar + " " ELSEIF parsestate = pval THEN retval = retval + " " END IF CASE "0" TO "9", "A" TO "F": IF parsestate = PEMPTY THEN retvar = retvar + a$ parsestate = pVAR ELSEIF parsestate = pVAR THEN retvar = retvar + a$ ELSEIF parsestate = pval THEN retval = retval + a$ ELSEIF parsestate = PHEX1 THEN convval1$ = a$ parsestate = PHEX2 ELSEIF parsestate = PHEX2 THEN convval2$ = a$ parsestate = prevstate% IF prevstate% = pVAR THEN retvar = retvar + CHR$(HexDec(convval1$, convval2$)) ELSEIF prevstate% = pval THEN retval = retval + CHR$(HexDec(convval1$, convval2$)) END IF END IF CASE "&": IF parsestate = PEMPTY THEN PRINT "ERROR EXPECTING VARIABLE NAME GOT A & INSTEAD" GetNextVar& = -1 EXIT FUNCTION ELSEIF parsestate = pVAR OR parsestate = pval THEN GetNextVar& = i& + 1 EXIT FUNCTION ELSEIF parsestate = PHEX1 OR parsestate = PHEX2 THEN PRINT "ERROR EXPECTING HEX VALUE GOT A & INSTEAD" GetNextVar& = -1 EXIT FUNCTION END IF CASE "%": IF parsestate = PEMPTY THEN prevstate% = pVAR parsestate = PHEX1 ELSEIF parsestate = pVAR OR parsestate = pval THEN prevstate% = parsestate parsestate = PHEX1 ELSEIF parsestate = PHEX1 OR parsestate = PHEX2 THEN PRINT "ERROR PARSING VALUE" GetNextVar& = -1 EXIT FUNCTION END IF END SELECT NEXT GetNextVar& = -2 END FUNCTION FUNCTION HexDec& (txt1$, txt2$) val1% = 0 val2% = 0 SELECT CASE ASC(txt1$) CASE 48 TO 57: val1% = ASC(txt1$) - 48 CASE 65 TO 70: val1% = ASC(txt1$) - 55 CASE ELSE: PRINT "ERROR" END SELECT SELECT CASE ASC(txt2$) CASE 48 TO 57: val2% = ASC(txt2$) - 48 CASE 65 TO 70: val2% = ASC(txt2$) - 55 CASE ELSE: PRINT "ERROR" END SELECT HexDec& = val1% * 16 + val2% END FUNCTION |
 | |
CGI-BIN Reddit Clone! |