DataGram/Curse

This software was developed for a cemetery designed to read data files from a software that was no longer supported for their platform. Here is the source code:

DIM fields$(40) ' fields per row
DIM sh$(653300, 2) ' database load
DIM rst$(653300, 3) 'search storage
DIM loading$(7) ' loading animation
DIM flist$(255) ' file list
CLS
PRINT "Generating help file..."
SHELL _HIDE "echo. > dchelp.txt"
OPEN "dchelp.txt" FOR APPEND AS #10

PRINT #10, "Help for DataCurse 2.0, by Jason Scott Page (PageTelegram.com) Copyright 2018.  "
PRINT #10, "                                                                                "
PRINT #10, "System: Datacurse takes a data file up to 40 fields and 600k+ records, allowing "
PRINT #10, "the user search and print/file collection of such records.                      "
PRINT #10, "                                                                                "
PRINT #10, "Program has some basic intelligence for parsing problem data files into fields. "
PRINT #10, "Dataparse will use special chars and consecutive spaces as field seperators.    "
PRINT #10, "This is involked at the beginning of program load when the user chooses 'Y' to  "
PRINT #10, "'Data Cleanup.'                                                                 "
PRINT #10, "                                                                                "
PRINT #10, "At program load the user chooses files that have the CSV extension              "
PRINT #10, "using up and down arrow keys.                                                   "
PRINT #10, "                                                                                "
PRINT #10, "If you cleanedup a data file you are asked to give it a new filename.           "
PRINT #10, "Be sure to add the '.csv' at the end of the filename otherwise DataCurse will   "
PRINT #10, "not see it when it is time to load it again.                                    "
PRINT #10, "After file is loaded in the system array, the search and print module loads.    "
PRINT #10, "The following operations are available per keystroke after intial search:       "
PRINT #10, "Up/Down Arrow Keys = Scroll records based on search.                            "
PRINT #10, "[ENTER] key = Export current selection from search to print.txt file.           "
PRINT #10, "'E' key = Clear out the print.txt file. Useful if you want to print one or few. "
PRINT #10, "'X' key = Export search query results to a file (ie 'Save As').                 "
PRINT #10, "'R' key = Rename the Export file.                                               "
PRINT #10, "'P' key = Print all records in search query. Don't forget to clear print file.  "
PRINT #10, "[ESC] key = Start a new search. If you want to exit program enter 'Q' at search."
CLOSE #10
COLOR 14, 9
PRINT "Help for DataCurse 2.0, by Jason Scott Page (PageTelegram.com) Copyright 2018.  "
PRINT "                                                                                "
PRINT "System: Datacurse takes a data file up to 40 fields and 600k+ records, allowing "
PRINT "the user search and print/file collection of such records.                      "
PRINT "                                                                                "
PRINT "Program has some basic intelligence for parsing problem data files into fields. "
PRINT "Dataparse will use special chars and consecutive spaces as field seperators.    "
PRINT "This is involked at the beginning of program load when the user chooses 'Y' to  "
PRINT "'Data Cleanup.'                                                                 "
PRINT "                                                                                "
COLOR 7, 0: PRINT "Press any key to continue ....": SLEEP: COLOR 14, 9
PRINT "At program load the user chooses files that have the CSV extension              "
PRINT "using up and down arrow keys.                                                   "
PRINT "                                                                                "
PRINT "If you cleanedup a data file you are asked to give it a new filename.           "
PRINT "Be sure to add the '.csv' at the end of the filename otherwise DataCurse will   "
PRINT "not see it when it is time to load it again.                                    "
PRINT "After file is loaded in the system array, the search and print module loads.    "
PRINT "The following operations are available per keystroke after intial search:       "
PRINT "Up/Down Arrow Keys = Scroll records based on search.                            "
PRINT "[ENTER] key = Export current selection from search to print.txt file.           "
PRINT "'E' key = Clear out the print.txt file. Useful if you want to print one or few. "
PRINT "'X' key = Export search query results to a file (ie 'Save As').                 "
PRINT "'R' key = Rename the Export file.                                               "
PRINT "'P' key = Print all records in search query. Don't forget to clear print file.  "
PRINT "[ESC] key = Start a new search. If you want to exit program enter 'Q' at search."
COLOR 7, 0
PRINT "Press [ENTER] to continue or 'P' to print this help file. 'Q' to quit.    "
hlp = 0

DO
    SELECT CASE UCASE$(INKEY$)
        CASE "P": SHELL "notepad dchelp.txt": hlp = 1
        CASE CHR$(13): hlp = 1
        CASE "Q": SYSTEM
    END SELECT
LOOP UNTIL hlp = 1
hlp = 0
CLS
loading$(1) = "|"
loading$(2) = "/"
loading$(3) = "-"
loading$(4) = "\"
loading$(5) = "."
SHELL _HIDE "echo. > " + "oldrec.csv"
OPEN "output.csv" FOR APPEND AS #2
PRINT "DataCurse v2.0b by Page Telegram 2018"
PRINT "          :: Make sure you have dumped the text of the file from a hex editor ::"
SHELL _HIDE "dir/b *.dml > list.dat"
SHELL _HIDE "dir/b *.csv >> list.dat"
'fil$ = "old.csv":
cont = 1
OPEN "list.dat" FOR INPUT AS #3
fit = 0
DO
    fit = fit + 1
    IF NOT (EOF(3)) THEN INPUT #3, fl$
    'PRINT fl$; "   ş   ";
    flist$(fit) = fl$
LOOP UNTIL EOF(3)
qt = 0
COLOR 12
LOCATE 5, 8: PRINT "Use up and down arrow keys"
DO
    SELECT CASE INKEY$
        CASE CHR$(0) + "H": LOCATE 5, 1: PRINT "                                  ": IF ar > 1 THEN ar = ar - 1
        CASE CHR$(0) + "P": LOCATE 5, 1: PRINT "                                  ": IF ar < fit - 1 THEN ar = ar + 1
        CASE CHR$(13): qt = 1
        CASE CHR$(27): SYSTEM
    END SELECT
    COLOR 14
    LOCATE 5, 1: PRINT "File > "; flist$(ar)
LOOP UNTIL qt = 1
COLOR 7
fil$ = flist$(ar)
PRINT
'INPUT "Enter file to open or [Q]uit>", fil$
IF UCASE$(fil$) = "Q" THEN SYSTEM
INPUT "Does file need cleaning up? (Y/N)>", yorn$
IF fil$ = "" THEN fil$ = "old.csv"
IF UCASE$(yorn$) <> "Y" THEN rn$ = fil$
IF UCASE$(yorn$) = "Y" THEN
    FOR l = 4 TO 19
        LOCATE l, 1
        PRINT "                                                                                "
    NEXT l
    CLOSE #3
    SHELL _HIDE "del list.dat"
    OPEN fil$ FOR INPUT AS #1
    DO
        IF NOT (EOF(1)) THEN LINE INPUT #1, ot$

        max_length = LEN(ot$)
        f1 = 0: f = 0
        FOR i = 1 TO max_length - 1
            ott$ = MID$(ot$, i, 1)
            t3$ = MID$(ot$, i, 2)
            IF ott$ = "^" THEN

            END IF
            IF t3$ <> "  " THEN
                f1 = 1
                t$ = t$ + ott$
            END IF
            IF f1 = 1 THEN
                IF t3$ = "  " OR ott$ = "^" THEN
                    f1 = 0
                    f = f + 1
                    fields$(f) = t$
                    t$ = ""
                END IF
            END IF
        NEXT i
        FOR i = 1 TO f

            at$ = LTRIM$(RTRIM$(fields$(i)))
            IF at$ = "^" THEN at$ = ""
            IF ASC(at$) > 31 AND ASC(at$) < 127 THEN
                ab$ = ab$ + at$ + "ş"
            END IF
        NEXT i

        IF co = 1 THEN co = 0 ELSE co = 1
        IF co = 1 THEN COLOR 15 ELSE COLOR 7
        'PRINT MID$(ab$, 1, LEN(ab$) - 1)
        IF co = 1 THEN
            LOCATE 3, 1: PRINT "                                                                                                                                                                                                                                                                                                                                                                           "
            '     IF cb = 1 THEN cb = 0 ELSE cb = 1: ii = i   ' procedure to involk two line data sets
            IF cb = 1 THEN COLOR 15 ELSE COLOR 7
            LOCATE 3, 1: PRINT MID$(ab$, 1, LEN(ab$) - 1);:

            out$ = "ş" + MID$(ab$, 1, LEN(ab$) - 1)
            PRINT #2, out$ + "ş" + STR$(cont) + " #Record"
            COLOR 14
            PRINT i + ii
            cont = cont + 1
            LOCATE 2, 1: PRINT cont
            ab$ = ""
            'SLEEP 1
            COLOR 7
        END IF


    LOOP UNTIL EOF(1)
    CLOSE #1
    CLOSE #2
    CLS
    PRINT "Cleaned up file saved as output.csv. Please rename (include extension .csv):"
    INPUT ">", rn$
    IF rn$ = "" THEN rn$ = "output.csv"
    SHELL _HIDE "ren output.csv " + rn$
    '    IF RIGHT$(rn$, 4) <> ".csv" THEN r2$ = ren$: SHELL _HIDE "ren " + rn$ + " " + rn$ + ".csv": rn$ = r2$ + ".csv"
END IF
CLS
OPEN rn$ FOR INPUT AS #4
LOCATE 5, 1: PRINT "Loading file into an array..."
i = 0: ci = 0
DO
    ci = ci + 1
    i = i + 1
    sh$(i, 1) = "0"
    IF NOT (EOF(4)) THEN LINE INPUT #4, sh$(i, 2)
    LOCATE 5, 26 + LEN(STR$(i)): PRINT loading$(ci)
    IF ci > 5 THEN ci = 0
LOOP UNTIL EOF(4) OR INKEY$ = CHR$(27)
cii = i
CLOSE #4
DO
    CLS
    PRINT "Records:"; cii; "Search and Print Records Module: DataCurse by Page Telegram 2018"
    LINE INPUT "Enter search string (no wildcards) [Q=quit]>", srch$
    IF UCASE$(srch$) = "Q" THEN SYSTEM
    r = 0
    FOR x = 1 TO i
        FOR y = 1 TO LEN(sh$(x, 2))
            seg$ = MID$(sh$(x, 2), y, LEN(srch$))
            IF UCASE$(seg$) = UCASE$(srch$) THEN
                r = r + 1
                rst$(r, 2) = sh$(x, 2)
                rst$(r, 3) = LTRIM$(STR$(x))
                LOCATE 3, 1: PRINT "Results: "; r; "   ş   Record# "; x; "    ş     Cursor# "; y; ". > "; rst$(r, 3); "<"
                'SLEEP 5
            END IF
        NEXT y
    NEXT x

    'INPUT "Print all records or select a record [A]ll [O]ne>", ao$
    'IF UCASE$(ao$) <> "A" THEN
    CLS
    PRINT "[D]elete/[A]dd Record [ESC]ape. [ENTER] to print record. [E]rase Print File."
    PRINT "e[X]port all search records to CSV. [P]rint all records from search. [S]ave."
    PRINT "[R]ename Export File. [ESC] for new search. Print just [1] record from selection"
    ps = 1
    ou = 0
    DO
        SELECT CASE UCASE$(INKEY$)
            CASE CHR$(27): ou = 1
            CASE "Q": ou = 1
            CASE "S"
                CLS
                PRINT "Saving file..."
                OPEN rn$ FOR OUTPUT AS #15

                FOR i = 1 TO cii
                    LOCATE 14, 1: COLOR 14
                    PRINT "Saving record# "; i; " of total "; cii; " records."
                    PRINT #15, sh$(i, 2)
                NEXT i
                COLOR 7
                CLOSE #15
            CASE "d"
                CLS
                PRINT "Deleting Record in Array (Not Saved Yet)..."
                i = 0
                OPEN rn$ FOR INPUT AS #16
                DO



                    IF NOT (EOF(16)) THEN
                        LINE INPUT #16, chks$
                        i = i + 1
                        IF UCASE$(chks$) = UCASE$(sh$(i, 2)) THEN
                            sh$(i, 1) = chks$
                            COLOR 14: LOCATE 1, 1: PRINT chks$
                            SLEEP
                            i = i - 1
                        ELSE
                            COLOR 7: LOCATE 1, 1: PRINT chks$
                            sh$(i, 2) = chks$
                        END IF


                    END IF




                LOOP UNTIL EOF(16)


                CLOSE #16
                BEEP

            CASE "D"
                CLS
                PRINT "Deleting Record in Array (Not Saved Yet)..."

                therealrow$ = rst$(ps, 3)
                thereal = INT(VAL(therealrow$)) + 1
                FOR liuf = thereal TO cii
                    liuf2 = liuf - 1
                    'PRINT "Liuf2>"; liuf2
                    sh$(liutf2, 1) = sh$(liutf, 1)
                    sh$(liutf2, 2) = sh$(liutf, 2)
                NEXT liuf
                lntotrecs = lntotrecs - 1
                BEEP

            CASE "A"
                COLOR 14
                PRINT
                PRINT "When adding record, please seperate your fields with an astrist '*':"
                COLOR 7
                LINE INPUT "Add Record>", addrc$
                FOR i = 1 TO LEN(addrc$)
                    rc$ = MID$(addrc$, i, 1)
                    IF rc$ = "*" THEN rc$ = "ş"
                    addrct$ = addrct$ + rc$
                NEXT i

                cii = cii + 1
                sh$(ci, 2) = addrct$
            CASE "P"
                FOR i = 1 TO r
                    FOR y = 1 TO LEN(rst$(i, 2))

                        cel$ = cel$ + MID$(rst$(i, 2), y, 1)
                        IF MID$(rst$(i, 2), y, 1) = "ş" THEN
                            IF LEN(cel$) > 1 AND LTRIM$(RTRIM$(cel$)) <> "" THEN
                                'SHELL _HIDE "echo " + MID$(cel$, 1, LEN(cel$) - 1) + " >> print.txt"
                                OPEN "print.txt" FOR APPEND AS #5
                                outp$ = " " + LTRIM$(RTRIM$(MID$(cel$, 1, LEN(cel$) - 1)))
                                PRINT #5, RIGHT$(outp$, LEN(outp$) - INSTR(outp$, "ş"))
                                'PRINT #5, RIGHT$(outp$, LEN(outp$) - 1)
                                cel$ = ""
                                CLOSE #5

                                cel$ = ""
                            END IF
                        END IF
                    NEXT y
                    SHELL _HIDE "echo ### Record " + STR$(i) + " End ### >> print.txt"
                NEXT i
                SHELL _HIDE "notepad print.txt"
                outp$ = ""


            CASE "R" ' Rename xls file
                SHELL _HIDE "dir/b xls.csv > chk.dat"
                OPEN "chk.dat" FOR INPUT AS #11
                IF NOT (EOF(11)) THEN INPUT #11, chkf$
                IF LCASE$(chkf$) = "xls.csv" THEN
                    INPUT "File to Save As (Please include the '.csv' at end of filename>", svas$
                    SHELL _HIDE "move xls.csv " + svas$
                ELSE
                    BEEP: COLOR 12: PRINT "You have not exported your search results yet.": COLOR 7
                END IF
                CLOSE #11


                SHELL _HIDE "del chk.dat"
            CASE "E": SHELL _HIDE "echo. > print.txt": BEEP: COLOR 12: PRINT "File Erased !": COLOR 7
            CASE CHR$(0) + "H"
                IF ps > 1 THEN ps = ps - 1
                FOR l = 0 TO 11
                    LOCATE 10 + l, 1: PRINT "                                                                                                                                                                                                                                          "
                NEXT l
            CASE CHR$(0) + "P"
                IF ps < r THEN ps = ps + 1
                FOR l = 0 TO 11
                    LOCATE 10 + l, 1: PRINT "                                                                                                                                                                                                                                          "
                NEXT l
            CASE "X"
                PRINT "Exporting..."
                FOR i = 1 TO r
                    FOR y = 1 TO LEN(rst$(i, 2))
                        cel$ = cel$ + MID$(rst$(i, 2), y, 1)
                        IF MID$(rst$(i, 2), y, 1) = "ş" THEN
                            IF LEN(cel$) > 3 AND LTRIM$(RTRIM$(cel$)) <> "" THEN
                                'SHELL _HIDE "echo " + MID$(cel$, 1, LEN(cel$) - 1) + " >> print.txt"

                                outp$ = " " + LTRIM$(RTRIM$(MID$(cel$, 1, LEN(cel$) - 1)))
                                dats$ = dats$ + RIGHT$(outp$, LEN(outp$) - INSTR(outp$, "ş")) + "ş"
                                'PRINT #5, RIGHT$(outp$, LEN(outp$) - 1)
                                cel$ = ""
                                CLOSE #5

                                cel$ = ""
                            END IF
                        END IF
                    NEXT y
                    OPEN "xls.csv" FOR APPEND AS #6
                    PRINT #6, LEFT$(dats$, LEN(dats$) - 1)
                    CLOSE #6
                    dats$ = ""

                    'SHELL _HIDE "echo ### Record " + STR$(i) + " End ### >> print.txt"
                NEXT i
                BEEP: COLOR 12
                PRINT "Exported as xls.csv"
                COLOR 7
            CASE "1"

                FOR y = 1 TO LEN(rst$(ps, 2))
                    cel$ = cel$ + MID$(rst$(ps, 2), y, 1)
                    IF MID$(rst$(ps, 2), y, 1) = "ş" THEN
                        IF LEN(cel$) > 3 AND MID$(cel$, 1, LEN(cel$) - 1) <> "" THEN
                            'SHELL _HIDE "echo " + MID$(cel$, 1, LEN(cel$) - 1) + " >> print.txt"
                            OPEN "print.txt" FOR APPEND AS #5
                            outp$ = " " + LTRIM$(RTRIM$(MID$(cel$, 1, LEN(cel$) - 1)))

                            PRINT #5, outp$
                            'PRINT #5, RIGHT$(outp$, LEN(outp$) - INSTR(outp$, "ş"))

                            '  PRINT #5, RIGHT$(RTRIM$(LTRIM$(MID$(cel$, 1, LEN(cel$) - 1))), 2)
                            cel$ = ""
                            CLOSE #5
                        END IF


                    END IF
                NEXT y
                SHELL _HIDE "echo ### Record " + STR$(ps) + " End ### > print1.txt"
                SHELL "notepad print1.txt"
                outp$ = "": cel$ = ""
                SHELL _HIDE "del print1.txt"

            CASE CHR$(13)

                FOR y = 1 TO LEN(rst$(ps, 2))
                    cel$ = cel$ + MID$(rst$(ps, 2), y, 1)
                    IF MID$(rst$(ps, 2), y, 1) = "ş" THEN
                        IF LEN(cel$) > 3 AND MID$(cel$, 1, LEN(cel$) - 1) <> "" THEN
                            'SHELL _HIDE "echo " + MID$(cel$, 1, LEN(cel$) - 1) + " >> print.txt"


                            'COLOR 12, 14
                            'PRINT "outp:"; outp$
                            'PRINT "cel: "; cel$
                            'SLEEP
                            'COLOR 7, 0
                            ' cel$ = cel$ + MID$(rst$(ps), y, 1)

                            '  PRINT #5, RIGHT$(RTRIM$(LTRIM$(MID$(cel$, 1, LEN(cel$) - 1))), 2)
                            '                outp$ = " " + LTRIM$(RTRIM$(MID$(cel$, 1, LEN(cel$) - 1)))

                            cel$ = ""
                            '    CLOSE #5
                        END IF


                    END IF
                NEXT y

                OPEN "print.txt" FOR APPEND AS #5

                'PRINT #5, RIGHT$(outp$, LEN(outp$) - INSTR(outp$, "ş"))
                PRINT #5, rst$(ps, 2)
                CLOSE #5

                'cel$ = MID$(rst$(ps), y, LEN(rst$(ps)))
                'outp$ = " " + LTRIM$(RTRIM$(MID$(cel$, 1, LEN(cel$) - 1)))
                'OPEN "print.txt" FOR APPEND AS #5
                'PRINT #5, RIGHT$(outp$, LEN(outp$)) ' - INSTR(outp$, "ş"))
                'CLOSE #5
                SHELL _HIDE "echo ### Record " + STR$(ps) + " End ### >> print.txt"
                SHELL "notepad print.txt"
                outp$ = "": cel$ = ""
        END SELECT
        COLOR 14
        LOCATE 10, 1: PRINT STR$(ps) + " > " + rst$(ps, 2)
        COLOR 7
        'IF r < 10 THEN ccc = r ELSE ccc = 10
        FOR l = 1 TO ps + 1
            IF l < 10 AND ps < r THEN LOCATE l + 11, 1: PRINT " * " + rst$(l + ps, 2)
        NEXT l
    LOOP UNTIL ou = 1


    '    ELSE
    '   END IF

LOOP