This software was developed for account money management for a non-for-profit radio station. Below is the source code:
CLS
DIM title$(1000000), debit$(1000000), credit$(1000000), alloc$(1000000), note$(1000000)
DIM total$(1000000), filrec$(1000000)
SHELL "./down.xfr"
'SHELL "scp -B:ftp.txt"
check = 1
'SHELL "dir/b *.acc > accounts.dat"
'OPEN "accounts.dat" FOR INPUT AS #2
'IF NOT EOF(2) THEN INPUT #2, ot$
'CLOSE #2
'SHELL "ls --format=single-column --sort=time > test.txt"
dtr = 1
DO
IF check = 1 THEN
SCREEN 12
COLOR 0, 15
CLS
PRINT "Account ver 0.6Mac for Q4 Radio rev/June-24-2015"
IF dtr = 1 THEN dtr$ = "auto/sign" ELSE dtr$ = "manual/no sign"
PRINT "Date set = "; dtr$
OPEN "accounts.dat" FOR INPUT AS #4
debs = 0
creds = 0
DO
IF NOT (EOF(4)) THEN INPUT #4, title$, debit$, credit$, alloc$, note$, dt$
'IF debit$ = "" THEN debit$ = "0"
'IF credit$ = "" THEN credit$ = "0"
debs = debs + VAL(debit$)
creds = creds + VAL(credit$)
LOOP UNTIL EOF(4)
total = creds - debs
CLOSE #4
LOCATE 1, 54: PRINT " "
LOCATE 1, 54: PRINT "Total:"; total
LOCATE 5, 1:
PRINT "1. Deposit, Withdraw, or [M]ember Payment"
LOCATE 6, 1
PRINT "2. Tax-Deducted Donation* [T]oggle Date / Sign"
LOCATE 7, 1
PRINT "3. Search Account or find [R]eceipt"
LOCATE 8, 1
PRINT "4. Monthly Report*"
LOCATE 9, 1
PRINT "Q. Quit [B]ackup [E]xport to Excel"
check = 0
CLOSE #4
END IF
SELECT CASE UCASE$(INKEY$)
CASE "T": IF dtr = 1 THEN dtr = 0 ELSE dtr = 1: check = 1
CASE "E"
SHELL "cp accounts.dat accounts.csv"
PRINT "File is saved as accounts.csv"
SLEEP 3
check = 1
CASE "B"
PRINT "[R]estore from backup or [C]reat backup"
SLEEP
SELECT CASE UCASE$(INKEY$)
CASE "R"
SHELL "ls *.bak"
INPUT "Restore from what file?>", restor$
IF MID$(restor$, LEN(restor$) - 3, 3) = "bak" THEN fl$ = restor$ ELSE fl$ = restor$ + ".bak"
PRINT "[A]ppend or [R]eplace or any other key to cancel?"
SLEEP
SELECT CASE INKEY$
CASE "A", "a": SHELL "cp accounts.dat+" + fl$ + " accounts.dat": SHELL "rm " + fl$
CASE "R", "r": SHELL "rm accounts.dat": SHELL "mv " + fl$ + " accounts.dat"
END SELECT
CASE "C"
SHELL "cp accounts.dat " + DATE$ + "hr" + MID$(TIME$, 1, 2) + ".bak"
PRINT "Backup made as " + DATE$ + "hr" + MID$(TIME$, 1, 2) + ".bak"
SLEEP 3
END SELECT
check = 1
CASE "2"
CASE "R"
SHELL "ls rec*.txt --format=single-column --sort=time > payrecords.txt"
'SHELL "dir/b/O:-D rec*.txt > payrecords.txt"
'SHELL "dir/b 0*.txt >> payrecords.txt"
OPEN "payrecords.txt" FOR INPUT AS #21
filrec = 0
DO
filrec = filrec + 1
IF NOT (EOF(21)) THEN INPUT #21, filrec$(filrec)
LOOP UNTIL EOF(21)
CLOSE #21
endfil = filrec
c = 0
DO
c = c + 1
LOCATE 15, 2
PRINT filrec$(c)
LOCATE 16, 1
PRINT "[ENTER] to open, '<-' key to go back, any other key to continue forward or [I]mage."
SLEEP
LOCATE 15, 2: PRINT " "
SELECT CASE INKEY$
CASE CHR$(13): SHELL "nano " + filrec$(c)
CASE CHR$(0) + CHR$(75): IF c > 1 THEN c = c - 2 ELSE SOUND 1000, 1
CASE CHR$(27): c = endfil
CASE "I", "i":
SCREEN 12
COLOR 0, 15
CLS
' SHELL "type " + filrec$(c)
OPEN filrec$(c) FOR INPUT AS #25
DO
IF NOT (EOF(25)) THEN INPUT #25, hey$
COLOR 0, 15
PRINT hey$
LOOP UNTIL EOF(25)
CLOSE #25
PRINT "The image of this receipt was generated on " + DATE$ + " at " + TIME$
SaveImage 0, MID$(filrec$(c), 1, LEN(filrec$(c)) - 4) + ".bmp" 'saves entire program screen as "screenshot.bmp"
' command to generate bitmap
END SELECT
LOOP UNTIL c >= endfil
c = 0
check = 1
LOCATE 15, 1: PRINT " "
LOCATE 16, 1: PRINT " "
CASE "M"
IF dtr = 0 THEN LOCATE 14, 1: INPUT "MM:DD:YYYY>", dta$
LOCATE 15, 1
INPUT "Host name>", host$
LOCATE 16, 1
INPUT "Payment Amount>", amnt$
LOCATE 17, 1
INPUT "Signed by>", sign$
LOCATE 18, 1
INPUT "Check Number>", chknum$
LOCATE 19, 1
INPUT "Note>", note$
OPEN "accounts.dat" FOR APPEND AS #15
IF dtr = 1 THEN dt$ = DATE$ + " " + TIME$ ELSE dt$ = dta$ + " " + TIME$
debit$ = ""
credit$ = amnt$
alloc$ = "member fee"
IF NOT (EOF(15)) THEN PRINT #15, "#" + host$ + "," + debit$ + "," + credit$ + "," + alloc$ + "," + note$ + "," + dt$
CLOSE #15
LOCATE 20, 1
PRINT "Creating the recipt..."
recfil$ = "rec" + DATE$ + MID$(TIME$, 1, 2) + "_" + host$ + ".txt"
PRINT recfil$: SLEEP
SHELL "echo > " + recfil$
OPEN recfil$ FOR APPEND AS #11
PRINT #11, "This is a receipt for donation in the amount of " + credit$ + " from " + host$
IF dtr = 0 THEN PRINT #11, "to Q4 Radio AM1680 on " + DATE$ ELSE PRINT #11, "to Q4 Radio AM1680 on " + dta$
PRINT #11, "processed by " + sign$ + " for check number " + chknum$ + " with the following note:"
PRINT #11, note$
PRINT #11, " "
PRINT #11, " "
IF dtr = 1 THEN PRINT #11, "Host " + host$ + " sign X__________________________"
PRINT #11, ""
IF dtr = 1 THEN PRINT #11, "Q4 Board Member " + sign$ + " sign X__________________________"
PRINT #11, ""
PRINT #11, ""
CLOSE #11
INPUT "Open file for print (T)extpad, (N)ano, (I)gnore>", wni$
inw$ = UCASE$(wni$)
SELECT CASE UCASE$(inw$)
CASE "T": SHELL "textpad " + recfil$
CASE "N": SHELL "nano " + recfil$
CASE "I"
END SELECT
check = 1
CASE "1"
debit$ = ""
credit$ = ""
again: check = 1
INPUT "[D],[W],[T]? ", type$
IF UCASE$(type$) = "T" THEN PRINT "Transfer currently not available.": GOTO again:
IF UCASE$(type$) <> "D" AND UCASE$(type$) <> "W" THEN PRINT "Please type D or W for Deposit or Withdraw.": GOTO again:
LOCATE 15, 1
INPUT "Title>", title$
LOCATE 16, 1
INPUT "Amount>", amount$
LOCATE 17, 1
INPUT "Account Allocation>", alloc$
LOCATE 18, 1
INPUT "Note>", note$
OPEN "accounts.dat" FOR APPEND AS #3
dt$ = DATE$ + " " + TIME$
IF UCASE$(type$) = "D" THEN credit$ = amount$
IF UCASE$(type$) = "W" THEN debit$ = amount$
IF NOT (EOF(3)) THEN PRINT #3, title$ + "," + debit$ + "," + credit$ + "," + alloc$ + "," + note$ + "," + dt$
LOCATE 19, 1
PRINT "Value stored. Enter another value?";
INPUT "Y/N", yn$
IF UCASE$(yn$) = "Y" THEN GOTO again:
CLOSE #3
CASE "2": check = 1
CASE "-": check = 1
CASE "4": check = 1
CASE "3": check = 1
ot$ = "accounts.dat"
LOCATE 12, 1: PRINT "Loading Database..."
OPEN ot$ FOR INPUT AS #1
c = 0
DO
c = c + 1
IF NOT (EOF(1)) THEN INPUT #1, title$(c), debit$(c), credit$(c), alloc$(c), note$(c), dt$
LOOP UNTIL EOF(1) OR c > 999999
IF c > 999999 THEN LOCATE 12, 1: PRINT "File size limit reached. Please start a new file."
CLOSE #1
LOCATE 12, 1: PRINT " "
LOCATE 12, 1: INPUT "Search string>", search$
searchsize1 = LEN(search$)
r = 0
FOR i = 1 TO c
total$(i) = title$(i) + "-" + debit$(i) + "-" + credit$(i) + "-" + alloc$(i) + "-" + note$(i) + "-" + dt$
PRINT total$(i): SLEEP 1
totalsize2 = LEN(total$(i))
FOR t = 1 TO totalsize2
chk$ = MID$(total$(i), t, totalsize2)
IF UCASE$(chk$) = UCASE$(search$) THEN
r = r + 1: results$(r) = total$(i)
COLOR 14: LOCATE 14, 1
PRINT results$(r)
COLOR 7
SHELL "echo " + results$(r) + " >> search_" + dt$ + ".csv"
END IF
NEXT t
NEXT i
PRINT "File saved as search_" + dt$ + ".csv"
SLEEP 5
CASE "Q"
SHELL "cp accounts.dat accounts.html"
' SHELL "ftps -s:ftpacc.txt"
SHELL "./up.xfr"
check = 1: SYSTEM
END SELECT
LOOP
SUB Delay (dlay!)
start! = TIMER
DO WHILE start! + dlay! >= TIMER
IF start! > TIMER THEN start! = start! - 86400
LOOP
END SUB
SUB SaveImage (image AS LONG, filename AS STRING)
bytesperpixel& = _PIXELSIZE(image&)
IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
x& = _WIDTH(image&)
y& = _HEIGHT(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
IF bytesperpixel& = 1 THEN
FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
NEXT
END IF
MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
lastsource& = _SOURCE
_SOURCE image&
IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
r$ = ""
FOR px& = 0 TO x& - 1
c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
NEXT px&
d$ = d$ + r$ + padder$
NEXT py&
_SOURCE lastsource&
MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
b$ = b$ + d$ ' total file data bytes to create file
MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
f& = FREEFILE
OPEN filename$ + ext$ FOR OUTPUT AS #f&:
CLOSE #f& ' erases an existing file
OPEN filename$ + ext$ FOR BINARY AS #f&
PUT #f&, , b$
CLOSE #f&
END SUB