Projects‎ > ‎OLD STUFF‎ > ‎QBASIC‎ > ‎

CGI-BIN Reddit Clone!

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):




And here is the source code for the two deals.  You can also scroll to the bottom and click on the attached file.

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='&uarr;'></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='&darr;'></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

ċ
Ryan Broomfield,
Feb 8, 2010, 5:10 AM
Comments