' QInstall! Version 1.0
' (C) 2006 i-TECH and Kristopher Windsor
DEFINT A-Z
DECLARE FUNCTION ClipboardText$ ()
DECLARE SUB OpenClipboard ()
DECLARE SUB CloseClipboard ()
'$INCLUDE: 'qb.bi'
COMMON SHARED ecommand$: SCREEN 0: WIDTH 80, 25: CLS
LOCATE 3, 5: PRINT "The QBasic Auto-Installer!"
LOCATE 5, 5: PRINT "(C) 2006 i-TECH and Kristopher Windsor"
SHELL "CD >path.tmp": OPEN "path.tmp" FOR INPUT AS #1: INPUT #1, drive$: CLOSE #1: drive$ = LEFT$(drive$, 3)
path$ = drive$ + "ITECH\MISC\QINSTALL"
ON ERROR GOTO resumenext: MKDIR drive$ + "ITECH": MKDIR drive$ + "ITECH\MISC": MKDIR path$: MKDIR path$ + "\PROGRAMS"
ON ERROR GOTO handling: CHDIR path$
ON ERROR GOTO missingdata: OPEN "data.txt" FOR INPUT AS #1
ON ERROR GOTO handling: INPUT #1, pcount: INPUT #1, wpath$: CLOSE #1
ON ERROR GOTO missingbat: OPEN "launch.txt" FOR INPUT AS #1
ON ERROR GOTO handling: INPUT #1, lcommand$: INPUT #1, ecommand$: CLOSE #1
DIM SHARED regs AS RegTypeX
aname = 1: pname$ = wpath$ + STRING$(1 + (LEN(wpath$) = 3), "\") + LTRIM$(STR$(pcount))
'Access clipboard
OpenClipboard
ct$ = ClipboardText$
CloseClipboard
WHILE LEFT$(ct$, 2) = CHR$(13) + CHR$(10): ct$ = RIGHT$(ct$, LEN(ct$) - 2): WEND
'Name program
IF LEFT$(ct$, 2) = "' " AND INSTR(ct$, "!") > 3 AND INSTR(ct$, "!") < 12 THEN pname$ = wpath$ + STRING$(1 + (LEN(wpath$) = 3), "\") + MID$(ct$, 3, INSTR(ct$, "!") - 3): aname = 0
IF LEFT$(ct$, 2) = "'\" AND INSTR(3, ct$, "\") > 0 AND INSTR(3, ct$, "\") < INSTR(ct$, CHR$(13) + CHR$(10)) AND INSTR(ct$, CHR$(13) + CHR$(10)) > 0 THEN
pname$ = drive$ + MID$(ct$, 3, INSTR(3, ct$, CHR$(13) + CHR$(10)) - 3)
aname = 0: ct$ = RIGHT$(ct$, LEN(ct$) - INSTR(ct$, CHR$(13) + CHR$(10)) - 1)
ON ERROR GOTO resumenext
FOR a = 5 TO LEN(pname$)
IF MID$(pname$, a, 1) = "\" THEN MKDIR LEFT$(pname$, a - 1)
NEXT a: ON ERROR GOTO handling
END IF
IF aname = 0 THEN ON ERROR GOTO badname: OPEN pname$ + ".BAS" FOR OUTPUT AS #1: ON ERROR GOTO handling: CLOSE #1
IF aname = 1 THEN OPEN "data.txt" FOR OUTPUT AS #1: WRITE #1, pcount + 1, wpath$: CLOSE #1
'Write program
OPEN pname$ + ".BAS" FOR OUTPUT AS #1: PRINT #1, ct$: CLOSE #1
LOCATE 11, 5: PRINT "The program (" + LTRIM$(STR$(LEN(ct$))) + " characters) has been saved as"
LOCATE 13, 5: PRINT pname$ + ".bas"
OPEN "log.txt" FOR APPEND AS #1: PRINT #1, pname$: CLOSE #1
'Run Program
SLEEP 2
SHELL lcommand$ + " " + pname$ + ".BAS"
SYSTEM
badname:
pname$ = wpath$ + STRING$(1 + (LEN(wpath$) = 3), "\") + LTRIM$(STR$(pcount)): aname = 1
RESUME
handling:
LOCATE 20, 5: SELECT CASE ERR
CASE 14: PRINT "Out of string space.": SHELL ecommand$
CASE 62: PRINT "Input past end of file."
CASE 76: PRINT "The path was not found."
CASE ELSE: PRINT "Error" + STR$(ERR) + " has occured."
END SELECT
LOCATE 22, 5: PRINT "Support is available at kristopherwindsor@gmail.com"
SLEEP: SYSTEM
missingbat:
OPEN "launch.txt" FOR OUTPUT AS #1
CLS : LOCATE 3, 5: PRINT "Please setup your QInstaller..."
LOCATE 5, 5: PRINT "Type the file name for your QBasic EXE (such as C:\QBasic.exe)."
LOCATE 7, 5: INPUT "File name: ", qbname$
LOCATE 9, 5: INPUT "Are you using NT, Windows 2000, or XP? (Y/N): ", os$
IF LTRIM$(RTRIM$(UCASE$(os$))) = "Y" THEN
PRINT #1, "CMD /C START " + qbname$ + " /RUN"
PRINT #1, "CMD /C START NOTEPAD"
ELSE
PRINT #1, "COMMAND " + qbname$ + " /RUN"
PRINT #1, "COMMAND NOTEPAD"
END IF
PRINT #1, "The first line handles valid QBasic programs."
PRINT #1, "The second line runs if the program is invalid."
CLOSE #1
RESUME
missingdata:
CLS : LOCATE 3, 5: PRINT "Please setup your QInstaller..."
LOCATE 5, 5: PRINT "Type the path for saving programs."
LOCATE 7, 5: PRINT "Leave the input field empty to use " + path$ + "\PROGRAMS."
LOCATE 9, 5: INPUT "Path: ", dpath$
OPEN "data.txt" FOR OUTPUT AS #1
WRITE #1, 1
IF dpath$ <> "" THEN WRITE #1, dpath$ ELSE WRITE #1, path$ + "\PROGRAMS"
CLOSE #1
RESUME
resumenext:
RESUME NEXT
FUNCTION ClipboardText$
regs.ax = &H1704
regs.dx = 1
CALL INTERRUPTX(&H2F, regs, regs)
IF regs.dx <> 0 OR regs.ax < 0 THEN LOCATE 20, 5: PRINT "There is too much data in the clipboard, or NTOLDAPP is not installed.": SLEEP 2: SHELL ecommand$: SYSTEM
IF regs.ax = 0 THEN ClipboardText$ = "": EXIT FUNCTION
buffer$ = SPACE$(regs.ax)
regs.ax = &H1705
regs.dx = 1
regs.es = VARSEG(buffer$)
regs.bx = SADD(buffer$)
CALL INTERRUPTX(&H2F, regs, regs)
IF regs.ax = 0 THEN LOCATE 20, 5: PRINT "There was an error accessing the clipboard data.": SLEEP: SYSTEM
ClipboardText$ = LEFT$(buffer$, INSTR(buffer$, CHR$(0)) - 1)
END FUNCTION
SUB CloseClipboard
regs.ax = &H1708
CALL INTERRUPTX(&H2F, regs, regs)
IF regs.ax = 0 THEN LOCATE 20, 5: PRINT "The clipboard will not close.": SLEEP: SYSTEM
END SUB
SUB OpenClipboard
regs.ax = &H1701
CALL INTERRUPTX(&H2F, regs, regs)
IF regs.ax = 0 THEN LOCATE 20, 5: PRINT "The clipboard will not open.": SLEEP: SYSTEM
END SUB