'===========================================================================
' Subject: QBASIC INTERRUPT TRANSLATOR       Date: 12-25-98 (17:18)       
' Author:  Mark Andryk                       Code: QBasic                 
' Origin:  andryk@xoommail.com             Packet: INTERRPT.ABC
'===========================================================================
'============================================================================
'                             QBasic Translator
'----------------------------------------------------------------------------
'
' Description
' -----------
'
' The QBasic Translator (QT) enables QBasic to call DOS interrupts.  The
' method for calling interrupts is the same method used by QuickBASIC, PDS,
' and Visual Basic for DOS.  With QT you can write QBasic programs that use
' interrupts and convert QuickBASIC/PDS/VBDOS programs to QBasic.
'
' Words
' -----
'
'        COMMAND$                       INTERRUPTX
'        INCLUDE                        REGTYPE
'        INT86OLD                       REGTYPEX
'        INT86XOLD                      SSEG
'        INTERRUPT
'
' Distribution
' ------------
'
' Program donated to the public domain by the author.
'
' Mark Andryk 12/25/1998
'
'============================================================================

DECLARE SUB exitCancel ()
DECLARE SUB exitError (ErrMsgIn AS STRING)
DECLARE SUB exitHelp ()
DECLARE SUB fileClose ()
DECLARE SUB fileGenerate ()
DECLARE SUB fileInit ()
DECLARE SUB fileOpen ()
DECLARE SUB fileScan ()
DECLARE FUNCTION keyGetCh% ()
DECLARE FUNCTION keyGetChoice$ (ChSetIn AS STRING)
DECLARE FUNCTION keyGetStr$ (TxtLenMaxIn AS INTEGER, WinWidthIn AS INTEGER)
DECLARE SUB srcBegin (bCopyFileIn AS INTEGER, StatusLblIn AS STRING)
DECLARE SUB srcEnd ()
DECLARE FUNCTION srcWordFirst% ()
DECLARE FUNCTION srcWordNext% ()
DECLARE FUNCTION strError$ (ErrCodeIn AS INTEGER)
DECLARE SUB zsrcComment ()

CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST cPrgVer = "1.0"
CONST cDefaultSwitch = ""
CONST fgNormal = 7
CONST bgNormal = 0

' Status

CONST cLnTtlFmt = "######"
DIM SHARED mbStatus AS INTEGER
DIM SHARED mStatusCol AS INTEGER
DIM SHARED mStatusRow AS INTEGER

' Output Control

CONST omNone = 0
CONST omBak = 1
CONST omSrc = 2
CONST omDstOld = 3
CONST omDstNew = 4
CONST omCon = 5
CONST omDev = 6

DIM SHARED mbBackup AS INTEGER
DIM SHARED mbOverwrite AS INTEGER
DIM SHARED mbOutputWrite AS INTEGER
DIM SHARED mOutputMode AS INTEGER

' File Parser

CONST brkRightParen = -1
CONST brkNormal = 0
CONST brkLeftParen = 1
CONST brkNone = 2
CONST brkQuote = 3
CONST brkRem = 4
CONST brkColon = 5
CONST brkEol = 6
CONST brkInvalid = 7

CONST itNull = 0
CONST itRegType = 1
CONST itRegTypeX = 2
CONST itCommand = 3
CONST itCommandPrompt = 4
CONST itSSeg = 5
CONST itInt86Old = 6
CONST itInt86XOld = 7
CONST itInterrupt = 8
CONST itInterruptX = 9

CONST iaNone = 0
CONST iaFuncAssign = 1
CONST iaFuncDeclare = 2
CONST iaFuncExist = 4
CONST iaSubCall = 8
CONST iaSubDeclare = 16
CONST iaSubExist = 32
CONST iaTypeDim = 64
CONST iaTypeDef = 128
CONST iaTypeInvalid = 256
CONST iaTypeStr = 512

DIM SHARED maBrk(0 TO 255) AS INTEGER
DIM SHARED maSuffix(0 TO 255) AS INTEGER
DIM SHARED mLn AS STRING
DIM SHARED mLnCh AS INTEGER
DIM SHARED mLnTtl AS INTEGER
DIM SHARED mLnU AS STRING
DIM SHARED mLnBrk AS INTEGER
DIM SHARED miLn AS INTEGER
DIM SHARED miLnFirst AS INTEGER
DIM SHARED miLnMax AS INTEGER
DIM SHARED mParenLvl AS INTEGER
DIM SHARED mWord AS STRING
DIM SHARED mWordLen AS INTEGER
DIM SHARED mWordSuffix AS INTEGER

' Error Handler

CONST etGlobal = 0
CONST etLocal = 1
CONST etRetry = 2

DIM SHARED mErrCode AS INTEGER
DIM SHARED mErrTrap AS INTEGER

DIM erCol AS INTEGER
DIM erColSave AS INTEGER
DIM eriCol AS INTEGER
DIM eriWinSave AS INTEGER
DIM erMsgTxt AS STRING
DIM erRow AS INTEGER
DIM erRowSave AS INTEGER
DIM erWinSave AS STRING
DIM erWinWidth AS INTEGER

' File Info

CONST ciSrcFileMax = 6
DIM SHARED maSrcFile(1 TO ciSrcFileMax) AS STRING
DIM SHARED mahSrc(1 TO ciSrcFileMax) AS INTEGER
DIM SHARED miSrcFileLast AS INTEGER

DIM SHARED mBakFile AS STRING
DIM SHARED mbTmpExist AS INTEGER
DIM SHARED mhDst AS INTEGER
DIM SHARED mDstFile AS STRING
DIM SHARED mDstPath AS STRING
DIM SHARED mhSrc AS INTEGER
DIM SHARED mSrcFile AS STRING
DIM SHARED mSrcPath AS STRING
DIM SHARED mTmpFile AS STRING

' Source File Data

CONST ciDstIdMax = 9
DIM SHARED maDstId(1 TO ciDstIdMax) AS STRING
DIM SHARED maDstIdAttr(1 TO ciDstIdMax) AS INTEGER

' Main Line Code

ON ERROR GOTO ErrorHandler
fileInit
fileOpen
fileScan
fileGenerate
fileClose
END

' Error Handler

ErrorHandler:
   mErrCode = ERR
   IF mErrTrap = etLocal THEN RESUME NEXT
   SELECT CASE mErrCode
      CASE 25
         erMsgTxt = "ERROR:  Device " + ERDEV$ + " is not responding."
      CASE 27
         erMsgTxt = "ERROR:  Printer is not ready."
      CASE 71
         erMsgTxt = "ERROR:  Drive " + ERDEV$ + " is not ready."
      CASE ELSE
         IF mErrTrap = etRetry THEN RESUME NEXT
         exitError strError$(mErrCode)
   END SELECT
   erRowSave = CSRLIN
   erColSave = POS(0)
   erWinWidth = LEN(erMsgTxt) + 4
   erWinSave = SPACE$(erWinWidth * 4)
   eriWinSave = 1
   erCol = (80 - erWinWidth) / 2 + 1
   FOR erRow = 11 TO 14
      FOR eriCol = 0 TO erWinWidth - 1
         MID$(erWinSave, eriWinSave, 1) = CHR$(SCREEN(erRow, erCol + eriCol))
         eriWinSave = eriWinSave + 1
      NEXT eriCol
   NEXT erRow
   COLOR 0, 7
   LOCATE 11, erCol: PRINT CHR$(201); STRING$(erWinWidth - 2, 205); CHR$(187);
   LOCATE 12, erCol: PRINT CHR$(186); SPACE$(erWinWidth - 2); CHR$(186);
   LOCATE 13, erCol: PRINT CHR$(186); SPACE$(erWinWidth - 2); CHR$(186);
   LOCATE 14, erCol: PRINT CHR$(200); STRING$(erWinWidth - 2, 205); CHR$(188);
   LOCATE 12, erCol + 2: PRINT erMsgTxt;
   LOCATE 13, erCol + 2: PRINT "[R]etry, [C]ancel? ";
   DO
      SELECT CASE UCASE$(INKEY$)
         CASE "R"
            mErrCode = 0
            EXIT DO
         CASE "C", CHR$(3), CHR$(27)
            EXIT DO
      END SELECT
   LOOP
   COLOR fgNormal, bgNormal
   eriWinSave = 1
   FOR erRow = 11 TO 14
      LOCATE erRow, erCol: PRINT MID$(erWinSave, eriWinSave, erWinWidth);
      eriWinSave = eriWinSave + erWinWidth
   NEXT erRow
   LOCATE erRowSave, erColSave
   IF mErrCode <> 0 THEN exitCancel
   RESUME

' Library Data

CallIntAryData:
DATA "DEF SEG = VARSEG(A(1))"
DATA "CALL ABSOLUTE(intnum, VARSEG(inarray(1)), VARPTR(inarray(1)), VARSEG(outarray(1)), VARPTR(outarray(1)), VARPTR(A(1)))"
DATA "DEF SEG"
DATA "END SUB"
DATA ""
DATA "$"

CallIntTypeData:
DATA "DEF SEG = VARSEG(A(1))"
DATA "CALL ABSOLUTE(intnum, VARSEG(inreg), VARPTR(inreg), VARSEG(outreg), VARPTR(outreg), VARPTR(A(1)))"
DATA "DEF SEG"
DATA "END SUB"
DATA ""
DATA "$"

CommandPromptData:
DATA "STATIC CmdLn AS STRING * 128"
DATA "STATIC A() AS LONG, bReady AS INTEGER, i AS INTEGER, p AS INTEGER, S1 AS INTEGER, S2 AS INTEGER"
DATA "IF bReady = 0 THEN"
DATA "CmdLn = CHR$(13)"
DATA "i = 445: DIM A(1 TO i) AS LONG: FOR i = 1 TO 445: A(i) = &H0: NEXT i"
DATA "A(1) = &H53EC8B55: A(2) = &H1E575651: A(3) = &H8BFC9C06: A(4) = &H37FF085E"
DATA "A(5) = &HFF065E8B: A(6) = &H1F0E0E37: A(7) = &HCD0FB407: A(8) = &HB23E8810"
DATA "A(9) = &H607BB02: A(10) = &H1076033C: A(11) = &H3C0B0CBB: A(12) = &HC6097407"
DATA "A(13) = &HD02B306: A(14) = &H105E990: A(15) = &H3C028ABE: A(16) = &HBE037701"
DATA "A(17) = &HA2BF0295: A(18) = &HBB902: A(19) = &H3B4A4F3: A(20) = &H510206E8"
DATA "A(21) = &HB4CB8B52: A(22) = &HBF10CD01: A(23) = &HD2330330: A(24) = &HB40198E8"
DATA "A(25) = &H1F1E808: A(26) = &H5FE80AB: A(27) = &H168BF276: A(28) = &HC93302A2"
DATA "A(29) = &HB870B7: A(30) = &HBE10CD06: A(31) = &HA0BF025E: A(32) = &H186E802"
DATA "A(33) = &H2A4168B: A(34) = &H8101BAE8: A(35) = &H720283FE: A(36) = &H2A6BFF7"
DATA "A(37) = &H330173E8: A(38) = &HBFC933F6: A(39) = &H3E8902B3: A(40) = &H3E8902AE"
DATA "A(41) = &HDF8B02B0: A(42) = &HB0A1D78B: A(43) = &H72F83B02: A(44) = &HAC06030D"
DATA "A(45) = &H72F83B02: A(46) = &HAC162B13: A(47) = &H16894202: A(48) = &HDA8B02B0"
DATA "A(49) = &H2AE0E8B: A(50) = &HFFB5CB2B: A(51) = &H302B0A1: A(52) = &H2B02AC06"
DATA "A(53) = &H77C13AC3: A(54) = &H2AC88A02: A(55) = &H77C53AC1: A(56) = &HE3E88A02"
DATA "A(57) = &HFEE8511D: A(58) = &HE3ED3200: A(59) = &HEB4AC08: A(60) = &HE20166E8"
DATA "A(61) = &HCD8A59F8: A(62) = &H6E3ED32: A(63) = &HE80A20B8: A(64) = &HDF8B0157"
DATA "A(65) = &H3200E0E8: A(66) = &H3C16CDE4: A(67) = &HB90C740D: A(68) = &H1B3CFF00"
DATA "A(69) = &H3EE88574: A(70) = &H8B8DEB00: A(71) = &HAA02AE3E: A(72) = &H330330BE"
DATA "A(73) = &HD3E8D2: A(74) = &HB9DC8AAD: A(75) = &H9B40001: A(76) = &H800126E8"
DATA "A(77) = &HED7605FE: A(78) = &H117E85A: A(79) = &HCD01B459: A(80) = &HBE075F10"
DATA "A(81) = &HAAAC02B3: A(82) = &HFA750D3C: A(83) = &H5F1F079D: A(84) = &H5D5B595E"
DATA "A(85) = &H330004CA: A(86) = &H3CDF8BC9: A(87) = &H8B287220: A(88) = &H8102AE1E"
DATA "A(89) = &H73032FFB: A(90) = &HAE06FF17: A(91) = &H2BCB8B02: A(92) = &H510A76CF"
DATA "A(93) = &H88FF578A: A(94) = &HF8E24B17: A(95) = &HC3AA4159: A(96) = &HE80E07B8"
DATA "A(97) = &H3CC300D3: A(98) = &H810A7508: A(99) = &H7602B3FF: A(100) = &HEB4B4F55"
DATA "A(101) = &H75C00A36: A(102) = &H4BFC804D: A(103) = &HFF810875: A(104) = &H427602B3"
DATA "A(105) = &HFC80C34F: A(106) = &H3B08754D: A(107) = &H7302AE3E: A(108) = &H80C34735"
DATA "A(109) = &H5754FFC: A(110) = &H2AE3E8B: A(111) = &H47FC80C3: A(112) = &HB3BF0475"
DATA "A(113) = &HFC80C302: A(114) = &H8B1B7553: A(115) = &H2B02AE0E: A(116) = &HFF1376CF"
DATA "A(117) = &H4902AE0E: A(118) = &H8A510A74: A(119) = &HE2AA0145: A(120) = &H59FB8BFA"
DATA "A(121) = &H3BC301B5: A(122) = &H8B0F74F3: A(123) = &H2BD38BF3: A(124) = &H302B016"
DATA "A(125) = &HE802AA16: A(126) = &HE8C30059: A(127) = &H3A420055: A(128) = &H7602A216"
DATA "A(129) = &HFED23204: A(130) = &H158BC3C6: A(131) = &HFE001DE8: A(132) = &HE8158AC6"
DATA "A(133) = &H8A4E002F: A(134) = &H28E80255: A(135) = &HC6FE4E00: A(136) = &H7203753A"
DATA "A(137) = &H158A46EC: A(138) = &HC30001E8: A(139) = &HE80016E8: A(140) = &HED320021"
DATA "A(141) = &H2A024D8A: A(142) = &HACD102CA: A(143) = &H18E80AB4: A(144) = &H1E800"
DATA "A(145) = &HBE8C3: A(146) = &HAC0001B9: A(147) = &H8E80AB4: A(148) = &HB4C34200"
DATA "A(149) = &H1E802: A(150) = &H3E8A53C3: A(151) = &H10CD02B2: A(152) = &HCDC9C35B"
DATA "A(153) = &HCDC8BABB: A(154) = &H746E45BC: A(155) = &H63207265: A(156) = &H616D6D6F"
DATA "A(157) = &H6C20646E: A(158) = &H20656E69: A(159) = &H61726170: A(160) = &H6574656D"
DATA "A(161) = &HDA3A7372: A(162) = &HC0B3BFC4: A(163) = &H54FD9C4: A(164) = &H2020119"
DATA "A(165) = &H303044D: A(166) = &H505274A: A(167) = &H26020101: A(168) = &H24030204"
DATA "A(445) = &HBDC00000"
DATA "S1 = 0: S2 = 0: p = VARPTR(A(1)): DEF SEG = VARSEG(A(1))"
DATA "FOR i = 0 TO 1779"
DATA "S1 = (S1 + PEEK(p + i)) MOD 255: S2 = (S2 + S1) MOD 255"
DATA "NEXT i"
DATA "IF S1 OR S2 THEN"
DATA "ERROR 2 ' Checksum error"
DATA "ELSE"
DATA "CALL ABSOLUTE(VARSEG(CmdLn), VARPTR(CmdLn), VARPTR(A(1)))"
DATA "END IF"
DATA "DEF SEG"
DATA "ERASE A"
DATA "bReady = -1"
DATA "END IF"
DATA "CommandPrompt$ = UCASE$(LTRIM$(LEFT$(CmdLn, INSTR(CmdLn, CHR$(13)) - 1)))"
DATA "END FUNCTION"
DATA ""
DATA "$"

LoadIntData:
DATA "STATIC A() AS LONG, bReady AS INTEGER, i AS INTEGER, p AS INTEGER, S1 AS INTEGER, S2 AS INTEGER"
DATA "IF bReady = 0 THEN"
DATA "i = 44: DIM A(1 TO i) AS LONG"
DATA "A(1) = &H53EC8B55: A(2) = &H1E575651: A(3) = &H5E8B9C06: A(4) = &HA078B0E"
DATA "A(5) = &HC70774E4: A(6) = &HE9FFFF07: A(7) = &HEC830086: A(8) = &HB3F88A0A"
DATA "A(9) = &HE85E89CD: A(10) = &HCBEA46C7: A(11) = &H74253C90: A(12) = &H75263C04"
DATA "A(13) = &HEA46C714: A(14) = &H46C701E8: A(15) = &HC7CB00EC: A(16) = &H2C2EE46"
DATA "A(17) = &HF046C7: A(18) = &H85E8B90: A(19) = &H5E8B37FF: A(20) = &HE37FF06"
DATA "A(21) = &H50007BB8: A(22) = &HE85E8D16: A(23) = &HD88C1E53: A(24) = &H5E8BC08E"
DATA "A(25) = &H8B378B0A: A(26) = &H1F8E0C5E: A(27) = &H5C8B048B: A(28) = &H44C8B02"
DATA "A(29) = &H8B06548B: A(30) = &H748B0C7C: A(31) = &H9CCB1F0A: A(32) = &H83EC8B55"
DATA "A(33) = &HC55620C5: A(34) = &H489E476: A(35) = &H89025C89: A(36) = &H5489044C"
DATA "A(37) = &HC7C8906: A(38) = &H8F0A448F: A(39) = &H448F0844: A(40) = &HEC4830E"
DATA "A(41) = &H5F1F079D: A(42) = &H5D5B595E: A(43) = &HACA: A(44) = &H887E0000"
DATA "S1 = 0: S2 = 0: p = VARPTR(A(1)): DEF SEG = VARSEG(A(1))"
DATA "FOR i = 0 TO 175"
DATA "S1 = (S1 + PEEK(p + i)) MOD 255: S2 = (S2 + S1) MOD 255"
DATA "NEXT i"
DATA "IF S1 OR S2 THEN"
DATA "ERROR 2: intnum = -1: EXIT SUB ' Checksum Error"
DATA "END IF"
DATA "bReady = -1"
DATA "END IF"
DATA "$"

LoadIntXData:
DATA "STATIC A() AS LONG, bReady AS INTEGER, i AS INTEGER, p AS INTEGER, S1 AS INTEGER, S2 AS INTEGER"
DATA "IF bReady = 0 THEN"
DATA "i = 50: DIM A(1 TO i) AS LONG"
DATA "A(1) = &H53EC8B55: A(2) = &H1E575651: A(3) = &H5E8B9C06: A(4) = &HA078B0E"
DATA "A(5) = &HC70774E4: A(6) = &HE9FFFF07: A(7) = &HEC8300A1: A(8) = &HB3F88A0A"
DATA "A(9) = &HE85E89CD: A(10) = &HCBEA46C7: A(11) = &H74253C90: A(12) = &H75263C04"
DATA "A(13) = &HEA46C714: A(14) = &H46C701E8: A(15) = &HC7CB00EC: A(16) = &H2C2EE46"
DATA "A(17) = &HF046C7: A(18) = &H85E8B90: A(19) = &H5E8B37FF: A(20) = &HE37FF06"
DATA "A(21) = &H50008FB8: A(22) = &HE85E8D16: A(23) = &H8BDA8C53: A(24) = &H378B0A5E"
DATA "A(25) = &H8E0C5E8B: A(26) = &H10448B1F: A(27) = &H75FFFF3D: A(28) = &H50C28B02"
DATA "A(29) = &H3D12448B: A(30) = &H275FFFF: A(31) = &HC08EC28B: A(32) = &H5C8B048B"
DATA "A(33) = &H44C8B02: A(34) = &H8B06548B: A(35) = &H748B0C7C: A(36) = &H9CCB1F0A"
DATA "A(37) = &H83EC8B55: A(38) = &H1E5620C5: A(39) = &H89E476C5: A(40) = &H25C8904"
DATA "A(41) = &H89044C89: A(42) = &H7C890654: A(43) = &H12448C0C: A(44) = &H8F10448F"
DATA "A(45) = &H448F0A44: A(46) = &HE448F08: A(47) = &H9D0EC483: A(48) = &H5E5F1F07"
DATA "A(49) = &HCA5D5B59: A(50) = &H9165000A"
DATA "S1 = 0: S2 = 0: p = VARPTR(A(1)): DEF SEG = VARSEG(A(1))"
DATA "FOR i = 0 TO 199"
DATA "S1 = (S1 + PEEK(p + i)) MOD 255: S2 = (S2 + S1) MOD 255"
DATA "NEXT i"
DATA "IF S1 OR S2 THEN"
DATA "ERROR 2: intnum = -1: EXIT SUB ' Checksum Error"
DATA "END IF"
DATA "bReady = -1"
DATA "END IF"
DATA "$"

RegTypeData:
DATA "   ax    AS INTEGER"
DATA "   bx    AS INTEGER"
DATA "   cx    AS INTEGER"
DATA "   dx    AS INTEGER"
DATA "   bp    AS INTEGER"
DATA "   si    AS INTEGER"
DATA "   di    AS INTEGER"
DATA "   flags AS INTEGER"
DATA "END TYPE"
DATA "$"

RegTypeXData:
DATA "   ax    AS INTEGER"
DATA "   bx    AS INTEGER"
DATA "   cx    AS INTEGER"
DATA "   dx    AS INTEGER"
DATA "   bp    AS INTEGER"
DATA "   si    AS INTEGER"
DATA "   di    AS INTEGER"
DATA "   flags AS INTEGER"
DATA "   ds    AS INTEGER"
DATA "   es    AS INTEGER"
DATA "END TYPE"
DATA "$"

SUB exitCancel

   srcEnd
   IF POS(0) <> 1 THEN PRINT
   PRINT
   PRINT "Cancelled"
   exitError ""

END SUB

SUB exitError (ErrMsgIn AS STRING)

   srcEnd
   IF LEN(ErrMsgIn) <> 0 THEN
      PRINT
      PRINT "ERROR:  "; ErrMsgIn
   END IF
   CLOSE
   IF mbTmpExist = TRUE THEN
      mbTmpExist = FALSE
      KILL mTmpFile
   END IF
   END

END SUB

SUB exitHelp

   PRINT
   PRINT "QT [/B] [/O] SourceFile [TargetFile]"
   PRINT
   PRINT "   /B   Backup source file before overwriting it"
   PRINT "   /O   Overwrite source or target file"
   exitError ""

END SUB

SUB fileClose

   CLOSE #mhDst
   IF mOutputMode = omDstOld THEN
      mOutputMode = omDstNew
      mErrCode = 0
      mErrTrap = etRetry
      KILL mDstFile
      mErrTrap = etGlobal
      IF mErrCode = 55 THEN
         mBakFile = mDstPath + RIGHT$(mBakFile, LEN(mBakFile) - LEN(mSrcPath))
         mSrcPath = mDstPath
         mSrcFile = mDstFile
         mOutputMode = omSrc
         IF mbBackup AND mSrcFile <> mBakFile THEN mOutputMode = omBak
      ELSEIF mErrCode <> 0 THEN
         ERROR mErrCode
      END IF
   END IF
   CLOSE #mhSrc
   SELECT CASE mOutputMode
      CASE omBak
         mErrCode = 0
         mErrTrap = etRetry
         NAME mSrcFile AS mBakFile
         mErrTrap = etGlobal
         IF mErrCode = 58 THEN
            KILL mBakFile
            NAME mSrcFile AS mBakFile
         ELSEIF mErrCode <> 0 THEN
            ERROR mErrCode
         END IF
         PRINT
         PRINT "Original source file saved as "; mBakFile
         NAME mTmpFile AS mSrcFile
         mbTmpExist = FALSE
      CASE omSrc
         KILL mSrcFile
         NAME mTmpFile AS mSrcFile
         mbTmpExist = FALSE
      CASE omDstNew
         NAME mTmpFile AS mDstFile
         mbTmpExist = FALSE
   END SELECT
   PRINT
   PRINT "Done"

   IF mOutputMode = omCon THEN
      PRINT
      OPEN mTmpFile FOR INPUT AS #mhSrc
      OPEN mDstFile FOR OUTPUT AS #mhDst
      DO UNTIL EOF(mhSrc)
         LINE INPUT #mhSrc, mLn
         PRINT #mhDst, mLn
      LOOP
      CLOSE #mhDst
      CLOSE #mhSrc
      KILL mTmpFile
      mbTmpExist = FALSE
   END IF

END SUB

SUB fileGenerate
   CONST cAddSubMask = iaFuncDeclare + iaFuncExist + iaSubCall + iaSubExist + iaTypeInvalid + iaTypeStr
   CONST cDeclareSubMask = cAddSubMask + iaSubDeclare

   DIM bAddInterrupt AS INTEGER
   DIM bAddInterruptX AS INTEGER
   DIM bAddRegType AS INTEGER
   DIM bAddRegTypeX AS INTEGER
   DIM bChgCommand AS INTEGER
   DIM bChgSSeg AS INTEGER
   DIM iTmpFile AS INTEGER
   DIM NewWord AS STRING
   DIM Ln AS STRING
   DIM SafetyCnt AS INTEGER
   DIM TmpPathLen AS INTEGER

   SEEK #mhSrc, 1
   srcBegin TRUE, "Target lines:"

' Create temporary file

   IF mOutputMode <> omDev THEN
      mhDst = FREEFILE
      TmpPathLen = LEN(mTmpFile)
      mTmpFile = mTmpFile + "12345678.TMP"
      SafetyCnt = 3
      mbTmpExist = FALSE
      DO
         FOR iTmpFile = 1 TO 8
            MID$(mTmpFile, TmpPathLen + iTmpFile, 1) = CHR$(INT(26 * RND + 65))
         NEXT iTmpFile
         mErrCode = 0
         mErrTrap = etLocal
         OPEN mTmpFile FOR INPUT AS #mhDst
         mErrTrap = etGlobal
         SELECT CASE mErrCode
            CASE 53
               mErrCode = 0
               mErrTrap = etRetry
               OPEN mTmpFile FOR OUTPUT AS #mhDst LEN = 4096
               mErrTrap = etGlobal
               IF mErrCode = 0 THEN mbTmpExist = TRUE
               EXIT DO
            CASE 0, 70, 75
               IF mErrCode = 0 THEN CLOSE #mhDst
               SafetyCnt = SafetyCnt - 1
               IF SafetyCnt = 0 THEN EXIT DO
            CASE ELSE
               EXIT DO
         END SELECT
      LOOP
      IF mbTmpExist = FALSE THEN exitError "Could not create temporary file"
   END IF

' Analyze source file data

   bAddInterrupt = FALSE
   IF (maDstIdAttr(itInterrupt) AND cAddSubMask) = iaSubCall THEN
      bAddInterrupt = TRUE
   END IF
   bAddRegType = FALSE
   IF (maDstIdAttr(itRegType) AND iaTypeDef) = 0 THEN
      IF (maDstIdAttr(itRegType) AND iaTypeDim) <> 0 OR bAddInterrupt = TRUE THEN
         bAddRegType = TRUE
      END IF
   END IF
   bAddInterruptX = FALSE
   IF (maDstIdAttr(itInterruptX) AND cAddSubMask) = iaSubCall THEN
      bAddInterruptX = TRUE
   END IF
   bAddRegTypeX = FALSE
   IF (maDstIdAttr(itRegTypeX) AND iaTypeDef) = 0 THEN
      IF (maDstIdAttr(itRegTypeX) AND iaTypeDim) <> 0 OR bAddInterruptX = TRUE THEN
         bAddRegTypeX = TRUE
      END IF
   END IF
   IF bAddRegType = TRUE AND bAddRegTypeX = TRUE THEN
      IF UCASE$(maDstId(itRegType)) = UCASE$(maDstId(itRegTypeX)) THEN
         bAddRegType = FALSE
      END IF
   END IF
   bChgCommand = FALSE
   IF maDstIdAttr(itCommand) = (iaFuncAssign + iaTypeStr) THEN
      IF maDstIdAttr(itCommandPrompt) = 0 THEN
         bChgCommand = TRUE
      END IF
   END IF
   bChgSSeg = FALSE
   IF maDstIdAttr(itSSeg) = iaFuncAssign THEN
      bChgSSeg = TRUE
   END IF

' Generate TYPE and DECLARE statements

   IF bAddRegType THEN
      PRINT #mhDst, "TYPE "; maDstId(itRegType)
      GOSUB genStatus
      RESTORE RegTypeData
      GOSUB genPrintData
   END IF

   IF bAddRegTypeX THEN
      PRINT #mhDst, "TYPE "; maDstId(itRegTypeX)
      GOSUB genStatus
      RESTORE RegTypeXData
      GOSUB genPrintData
   END IF

   IF bChgCommand THEN
      PRINT #mhDst, "DECLARE FUNCTION CommandPrompt$ ()"
      GOSUB genStatus
   END IF

   IF (maDstIdAttr(itInt86Old) AND cDeclareSubMask) = iaSubCall THEN
      PRINT #mhDst, "DECLARE SUB "; maDstId(itInt86Old);
      PRINT #mhDst, " (intnum AS INTEGER, inarray() AS INTEGER, outarray() AS INTEGER)"
      GOSUB genStatus
   END IF

   IF (maDstIdAttr(itInt86XOld) AND cDeclareSubMask) = iaSubCall THEN
      PRINT #mhDst, "DECLARE SUB "; maDstId(itInt86XOld);
      PRINT #mhDst, " (intnum AS INTEGER, inarray() AS INTEGER, outarray() AS INTEGER)"
      GOSUB genStatus
   END IF

   IF (maDstIdAttr(itInterrupt) AND cDeclareSubMask) = iaSubCall THEN
      PRINT #mhDst, "DECLARE SUB "; maDstId(itInterrupt); " (intnum AS INTEGER, inreg AS ";
      IF bAddRegType = TRUE THEN
         PRINT #mhDst, maDstId(itRegType); ", outreg AS "; maDstId(itRegType); ")"
      ELSE
         PRINT #mhDst, "ANY, outreg AS ANY)"
      END IF
      GOSUB genStatus
   END IF

   IF (maDstIdAttr(itInterruptX) AND cDeclareSubMask) = iaSubCall THEN
      PRINT #mhDst, "DECLARE SUB "; maDstId(itInterruptX); " (intnum AS INTEGER, inreg AS ";
      IF bAddRegTypeX = TRUE THEN
         PRINT #mhDst, maDstId(itRegTypeX); ", outreg AS "; maDstId(itRegTypeX); ")"
      ELSE
         PRINT #mhDst, "ANY, outreg AS ANY)"
      END IF
      GOSUB genStatus
   END IF

' Change source file

   DO WHILE srcWordFirst
      DO
         IF bChgCommand = TRUE THEN
            IF mWord = "COMMAND" THEN
               NewWord = "CommandPrompt"
               GOSUB genReplaceWord
            END IF
         END IF
         IF bChgSSeg = TRUE THEN
            IF mLnBrk = brkLeftParen THEN
               IF mWord = "SSEG" THEN
                  NewWord = "VARSEG"
                  GOSUB genReplaceWord
               END IF
            END IF
         END IF
      LOOP WHILE srcWordNext
   LOOP
   miLn = LEN(mLn)
   DO
      IF miLn = 0 THEN EXIT DO
      mLnCh = ASC(MID$(mLn, miLn, 1))
      IF mLnCh <> 9 AND mLnCh <> 32 THEN EXIT DO
      miLn = miLn - 1
   LOOP
   IF miLn <> 0 THEN
      PRINT #mhDst,
      GOSUB genStatus
   END IF

' Append functions and subprograms

   IF bChgCommand = TRUE THEN
      PRINT #mhDst, "FUNCTION CommandPrompt$"
      GOSUB genStatus
      RESTORE CommandPromptData
      GOSUB genPrintData
   END IF

   IF (maDstIdAttr(itInt86Old) AND cAddSubMask) = iaSubCall THEN
      PRINT #mhDst, "SUB "; maDstId(itInt86Old);
      PRINT #mhDst, " (intnum AS INTEGER, inarray() AS INTEGER, outarray() AS INTEGER)"
      GOSUB genStatus
      RESTORE LoadIntData
      GOSUB genPrintData
      RESTORE CallIntAryData
      GOSUB genPrintData
   END IF

   IF (maDstIdAttr(itInt86XOld) AND cAddSubMask) = iaSubCall THEN
      PRINT #mhDst, "SUB "; maDstId(itInt86XOld);
      PRINT #mhDst, " (intnum AS INTEGER, inarray() AS INTEGER, outarray() AS INTEGER)"
      GOSUB genStatus
      RESTORE LoadIntXData
      GOSUB genPrintData
      RESTORE CallIntAryData
      GOSUB genPrintData
   END IF

   IF bAddInterrupt = TRUE THEN
      PRINT #mhDst, "SUB "; maDstId(itInterrupt);
      PRINT #mhDst, " (intnum AS INTEGER, inreg AS "; maDstId(itRegType);
      PRINT #mhDst, ", outreg AS "; maDstId(itRegType); ")"
      GOSUB genStatus
      RESTORE LoadIntData
      GOSUB genPrintData
      RESTORE CallIntTypeData
      GOSUB genPrintData
   END IF

   IF bAddInterruptX = TRUE THEN
      PRINT #mhDst, "SUB "; maDstId(itInterruptX);
      PRINT #mhDst, " (intnum AS INTEGER, inreg AS "; maDstId(itRegTypeX);
      PRINT #mhDst, ", outreg AS "; maDstId(itRegTypeX); ")"
      GOSUB genStatus
      RESTORE LoadIntXData
      GOSUB genPrintData
      RESTORE CallIntTypeData
      GOSUB genPrintData
   END IF

   srcEnd

   EXIT SUB

genPrintData:
   READ Ln
   DO UNTIL Ln = "$"
      PRINT #mhDst, Ln
      GOSUB genStatus
      READ Ln
   LOOP
RETURN

genReplaceWord:
   mLn = LEFT$(mLn, miLnFirst - 1) + NewWord + RIGHT$(mLn, miLnMax - miLnFirst - mWordLen + 1)
   mLnU = UCASE$(mLn)
   miLnMax = LEN(mLn)
   miLn = miLn + (LEN(NewWord) - mWordLen)
RETURN

genStatus:
   mLnTtl = mLnTtl + 1
   IF (mLnTtl AND 31) = 0 THEN
      LOCATE mStatusRow, mStatusCol
      PRINT USING cLnTtlFmt; mLnTtl;
   END IF
   DO
   LOOP WHILE keyGetCh <> 0
RETURN

END SUB

SUB fileInit
   DIM i AS INTEGER

   COLOR fgNormal, bgNormal
   LOCATE , , 1, 6, 7
   RANDOMIZE TIMER

   FOR i = 0 TO 255
      maSuffix(i) = iaNone
   NEXT i
   maSuffix(33) = iaTypeInvalid
   maSuffix(35) = iaTypeInvalid
   maSuffix(36) = iaTypeStr
   maSuffix(37) = iaTypeInvalid
   maSuffix(38) = iaTypeInvalid

   FOR i = 0 TO 255
      maBrk(i) = brkInvalid
   NEXT i
   FOR i = 9 TO 13
      maBrk(i) = brkNormal
   NEXT i
   maBrk(26) = brkNormal
   FOR i = 32 TO 126
      maBrk(i) = brkNormal
   NEXT i
   maBrk(34) = brkQuote
   maBrk(39) = brkRem
   maBrk(40) = brkLeftParen
   maBrk(41) = brkRightParen
   maBrk(46) = brkNone
   FOR i = 48 TO 57
      maBrk(i) = brkNone
   NEXT i
   maBrk(58) = brkColon
   FOR i = 65 TO 90
      maBrk(i) = brkNone
      maBrk(i + 32) = brkNone
   NEXT i
   maBrk(95) = brkNone

END SUB

SUB fileOpen
   DIM aFileSpec(1 TO 2) AS STRING
   DIM Arg AS STRING
   DIM ArgLen AS INTEGER
   DIM bDevice AS INTEGER
   DIM bCon AS INTEGER
   DIM bPromptTarget AS INTEGER
   DIM CmdLn AS STRING
   DIM FileExtLen AS INTEGER
   DIM FilePathLen AS INTEGER
   DIM FileSpec AS STRING
   DIM FileSpecLen AS INTEGER
   DIM iCmdLn AS INTEGER
   DIM iCmdLnFirst AS INTEGER
   DIM iCmdLnMax AS INTEGER
   DIM iFileSpec AS INTEGER
   DIM Ln AS STRING

   CLS
   PRINT "QBasic Translator v"; cPrgVer
   bPromptTarget = FALSE
   CmdLn = cDefaultSwitch
'  CmdLn = CmdLn + COMMAND$ ' Read command line paramters (QB/PDS/VBDOS).
   GOSUB foParseCmdLn

   PRINT
   IF iFileSpec = 0 THEN
      bPromptTarget = TRUE
      PRINT "Source file [.BAS]: ";
      Ln = keyGetStr$(255, 0)
      CmdLn = CmdLn + SPACE$(1) + Ln
      GOSUB foParseCmdLn
      IF iFileSpec = 0 THEN exitHelp
   END IF
   FileSpec = aFileSpec(1)
   GOSUB foFormatFileSpec
   IF bPromptTarget = FALSE THEN PRINT "Source file: "; FileSpec

   IF bDevice THEN exitError "Source file cannot be a device"
   mBakFile = LEFT$(FileSpec, FileSpecLen - FileExtLen) + ".BAK"
   mSrcPath = LEFT$(FileSpec, FilePathLen)
   mSrcFile = FileSpec
   mhSrc = FREEFILE
   OPEN mSrcFile FOR INPUT AS #mhSrc LEN = 4096

   IF bPromptTarget AND iFileSpec < 2 THEN
      PRINT "Target file ["; RIGHT$(FileSpec, FileSpecLen - FilePathLen); "]: ";
      Ln = keyGetStr$(255, 0)
      CmdLn = CmdLn + SPACE$(1) + Ln
      GOSUB foParseCmdLn
   END IF
   IF iFileSpec > 1 THEN
      FileSpec = aFileSpec(2)
      GOSUB foFormatFileSpec
   END IF
   IF bPromptTarget = FALSE THEN
      PRINT "Target file: "; FileSpec
   END IF
   mDstFile = FileSpec
   mDstPath = LEFT$(FileSpec, FilePathLen)
   mhDst = FREEFILE
   mTmpFile = mDstPath

   IF bCon THEN
      mOutputMode = omCon
      mTmpFile = mSrcPath
   ELSEIF bDevice THEN
      mOutputMode = omDev
      mTmpFile = mSrcPath
      mErrCode = 0
      mErrTrap = etRetry
      OPEN mDstFile FOR OUTPUT AS #mhDst LEN = 4096
      mErrTrap = etGlobal
      IF mErrCode <> 0 THEN exitError "Could not open device for output"
   ELSEIF mDstFile = mSrcFile THEN
      GOSUB foConfirmOverwrite
   ELSE
      mErrCode = 0
      mErrTrap = etRetry
      OPEN mDstFile FOR INPUT AS #mhDst
      mErrTrap = etGlobal
      IF mErrCode = 0 THEN
         CLOSE #mhDst
         GOSUB foConfirmOverwrite
      ELSEIF mErrCode = 53 THEN
         mOutputMode = omDstNew
      ELSE
         ERROR mErrCode
      END IF
   END IF

   PRINT
   PRINT "Press Esc to cancel"

   GOTO foExit

foConfirmOverwrite:
   IF mSrcFile = mDstFile AND mSrcFile <> mBakFile THEN
      IF mbBackup THEN
         mOutputMode = omBak
      ELSEIF mbOverwrite THEN
         mOutputMode = omSrc
      ELSE
         PRINT
         PRINT "WARNING:  "; mSrcFile; " will be replaced."
         PRINT "[O]verwrite, [B]ackup, [C]ancel? ";
         SELECT CASE keyGetChoice$("OBC")
            CASE "O"
               mOutputMode = omSrc
            CASE "B"
               mOutputMode = omBak
            CASE ELSE
               exitCancel
         END SELECT
      END IF
   ELSE
      IF mbOverwrite = FALSE THEN
         PRINT
         PRINT "WARNING:  "; mDstFile; " will be replaced."
         PRINT "[O]verwrite, [C]ancel? ";
         IF keyGetChoice$("OC") <> "O" THEN exitCancel
      END IF
      mOutputMode = omDstOld
      IF mSrcFile = mDstFile THEN mOutputMode = omSrc
   END IF
RETURN

foFormatFileSpec:
   bDevice = FALSE
   bCon = FALSE
   FileSpecLen = LEN(FileSpec)
   FilePathLen = FileSpecLen
   DO
      IF FilePathLen = 0 THEN EXIT DO
      IF INSTR(":\/", MID$(FileSpec, FilePathLen, 1)) THEN EXIT DO
      FilePathLen = FilePathLen - 1
   LOOP
   FileExtLen = FileSpecLen
   DO
      IF FileExtLen = FilePathLen THEN EXIT DO
      IF MID$(FileSpec, FileExtLen, 1) = "." THEN EXIT DO
      FileExtLen = FileExtLen - 1
   LOOP
   IF FileExtLen = FilePathLen THEN
      FileExtLen = 0
   ELSE
      FileExtLen = FileSpecLen - FileExtLen + 1
   END IF
   IF FileSpecLen = 0 THEN GOTO foExitFormatFileSpec
   IF INSTR(FileSpec, ":") > 2 THEN
      bDevice = TRUE
      SELECT CASE LEFT$(FileSpec, INSTR(FileSpec, ":"))
         CASE "CONS:", "SCRN:"
            bCon = TRUE
      END SELECT
      GOTO foExitFormatFileSpec
   END IF
   SELECT CASE UCASE$(RIGHT$(FileSpec, FileSpecLen - FilePathLen))
      CASE "AUX", "CLOCK$", "COM1", "COM2", "COM3", "COM4", "CONFIG$", "LPT1", "LPT2", "LPT3", "NUL", "PRN"
         bDevice = TRUE
         GOTO foExitFormatFileSpec
      CASE "CON"
         bDevice = TRUE
         bCon = TRUE
         GOTO foExitFormatFileSpec
   END SELECT
   IF FileExtLen = 0 THEN
      FileSpec = FileSpec + ".BAS"
      FileSpecLen = FileSpecLen + 4
      FileExtLen = 4
   END IF
foExitFormatFileSpec:
RETURN

foParseCmdLn:
   CmdLn = UCASE$(CmdLn)
   mbBackup = FALSE
   mbOverwrite = FALSE
   iFileSpec = 0
   iCmdLnMax = LEN(CmdLn)
   iCmdLn = 0
   DO
      DO
         IF iCmdLn = iCmdLnMax THEN GOTO foExitParseCmdLn
         iCmdLn = iCmdLn + 1
         IF ASC(MID$(CmdLn, iCmdLn, 1)) > 32 THEN EXIT DO
      LOOP
      iCmdLnFirst = iCmdLn
      ArgLen = 1
      DO
         IF iCmdLn = iCmdLnMax THEN EXIT DO
         iCmdLn = iCmdLn + 1
         SELECT CASE ASC(MID$(CmdLn, iCmdLn, 1))
            CASE IS <= 32, 47
               EXIT DO
         END SELECT
         ArgLen = ArgLen + 1
      LOOP
      Arg = MID$(CmdLn, iCmdLnFirst, ArgLen)
      IF Arg = "/?" THEN
         exitHelp
      ELSEIF Arg = "/B" THEN
         mbBackup = TRUE
      ELSEIF Arg = "/O" THEN
         mbOverwrite = TRUE
      ELSEIF ASC(LEFT$(Arg, 1)) = 47 THEN
         exitError "Invalid switch - " + Arg
      ELSEIF iFileSpec = 2 THEN
         exitError "Too many parameters"
      ELSE
         iFileSpec = iFileSpec + 1
         aFileSpec(iFileSpec) = Arg
      END IF
   LOOP
foExitParseCmdLn:
RETURN

foExit:

END SUB

SUB fileScan
   CONST ciRegIdMax = 2
   CONST ciSrcIdMax = 250

   DIM bDimFirst AS INTEGER
   DIM bUserType AS INTEGER
   DIM DimParenLvl AS INTEGER
   DIM DstIdAttr AS INTEGER
   DIM iDstId AS INTEGER
   DIM iRegId AS INTEGER
   DIM iSrcId AS INTEGER
   DIM iSrcIdDef AS INTEGER
   DIM iSrcIdFuncSub AS INTEGER
   DIM iSrcIdLast AS INTEGER
   DIM RegId AS STRING
   DIM TypeId AS STRING * 40
   DIM TypeIdTtl AS INTEGER
   DIM VarId AS STRING * 40
   DIM VarIdTtl AS INTEGER

   PRINT
   srcBegin FALSE, "Source lines:"

' Initialize variables

   iSrcId = ciSrcIdMax
   DIM aiSrcId(1 TO iSrcId) AS INTEGER
   DIM aSrcId(1 TO iSrcId) AS STRING * 40
   FOR iSrcId = 1 TO ciSrcIdMax
      aiSrcId(iSrcId) = 0
      aSrcId(iSrcId) = ""
   NEXT iSrcId

   iRegId = ciRegIdMax
   DIM aRegIdCall(1 TO iRegId) AS STRING * 40
   DIM aRegIdDeclare(1 TO iRegId) AS STRING * 40
   FOR iRegId = 1 TO ciRegIdMax
      aRegIdCall(iRegId) = ""
      aRegIdDeclare(iRegId) = ""
   NEXT iRegId

   FOR iDstId = 1 TO ciDstIdMax
      maDstId(iDstId) = ""
      maDstIdAttr(iDstId) = iaNone
   NEXT iDstId

   TypeId = ""
   VarId = ""
   iSrcIdLast = 0
   iSrcIdDef = -1
   iSrcIdFuncSub = -1

' Scan source file

   DO WHILE srcWordFirst
      SELECT CASE mWord
         CASE "CALL"
            IF srcWordNext THEN GOSUB scanCall
         CASE "DECLARE"
            IF srcWordNext THEN GOSUB scanDeclare
         CASE "DEF"
            IF srcWordNext THEN GOSUB scanDef
         CASE "COMMON", "DIM", "REDIM", "SHARED"
            IF srcWordNext THEN GOSUB scanDim
         CASE "END"
            IF srcWordNext THEN GOSUB scanEnd
         CASE "FUNCTION"
            IF srcWordNext THEN GOSUB scanFunc
         CASE "STATIC"
            IF srcWordNext THEN GOSUB scanStatic
         CASE "SUB"
            IF srcWordNext THEN GOSUB scanSub
         CASE "TYPE"
            IF srcWordNext THEN GOSUB scanType
         CASE ELSE
            GOSUB scanCall
      END SELECT
   LOOP

   srcEnd

' Find type names

   maDstId(itRegType) = "RegType"
   maDstId(itRegTypeX) = "RegTypeX"
   FOR iRegId = 1 TO ciRegIdMax
      RegId = RTRIM$(aRegIdDeclare(iRegId))
      IF LEN(RegId) <> 0 THEN
         maDstId(iRegId) = RegId
      ELSE
         RegId = RTRIM$(aRegIdCall(iRegId))
         IF LEN(RegId) <> 0 THEN
            maDstId(iRegId) = RegId
         END IF
      END IF
   NEXT iRegId

' Find references to defined types

   FOR iSrcId = 1 TO iSrcIdLast
      IF aiSrcId(iSrcId) = -1 THEN
         RegId = UCASE$(RTRIM$(aSrcId(iSrcId)))
         FOR iRegId = 1 TO ciRegIdMax
            IF RegId = UCASE$(maDstId(iRegId)) THEN
               maDstIdAttr(iRegId) = maDstIdAttr(iRegId) OR iaTypeDef
            END IF
         NEXT iRegId
      END IF
   NEXT iSrcId

   EXIT SUB

scanCall:
   DstIdAttr = iaNone
   GOSUB scanFindDstId
   IF iDstId = itNull THEN
      DO
         IF srcWordNext = FALSE THEN GOTO scanExitCall
         GOSUB scanFindDstId
         IF iDstId <> itNull THEN
            IF (maDstIdAttr(iDstId) AND iaFuncAssign) = 0 THEN
               maDstIdAttr(iDstId) = maDstIdAttr(iDstId) OR iaFuncAssign
               maDstId(iDstId) = MID$(mLn, miLnFirst, mWordLen)
            END IF
         END IF
      LOOP
   END IF
   IF (maDstIdAttr(iDstId) AND iaSubCall) = 0 THEN
      maDstIdAttr(iDstId) = maDstIdAttr(iDstId) OR iaSubCall
      maDstId(iDstId) = MID$(mLn, miLnFirst, mWordLen)
   END IF
   IF iDstId < itInterrupt THEN GOTO scanExitCall
   iRegId = iDstId - itInterrupt + 1
   IF LEN(RTRIM$(aRegIdCall(iRegId))) <> 0 THEN GOTO scanExitCall
   VarIdTtl = 0
   DO WHILE srcWordNext
      VarId = mWord
      VarIdTtl = VarIdTtl + 1
      GOSUB scanFindDstId
      IF iDstId <> itNull THEN
         IF (maDstIdAttr(iDstId) AND iaFuncAssign) = 0 THEN
            maDstIdAttr(iDstId) = maDstIdAttr(iDstId) OR iaFuncAssign
            maDstId(iDstId) = MID$(mLn, miLnFirst, mWordLen)
         END IF
      END IF
   LOOP
   IF VarIdTtl < 3 THEN GOTO scanExitCall
   iSrcId = iSrcIdLast
   DO
      IF iSrcId = 0 THEN EXIT DO
      IF aiSrcId(iSrcId) > 0 THEN
         IF VarId = aSrcId(iSrcId) THEN
            aRegIdCall(iRegId) = aSrcId(aiSrcId(iSrcId))
            EXIT DO
         END IF
      END IF
      iSrcId = iSrcId - 1
   LOOP
scanExitCall:
RETURN

scanDeclare:
   IF mWord = "FUNCTION" THEN
      IF srcWordNext = FALSE THEN GOTO scanExitDeclare
      DstIdAttr = iaFuncDeclare
      GOSUB scanFindDstId
      GOTO scanExitDeclare
   END IF
   IF mWord <> "SUB" THEN GOTO scanExitDeclare
   IF srcWordNext = FALSE THEN GOTO scanExitDeclare
   DstIdAttr = iaSubDeclare
   GOSUB scanFindDstId
   IF iDstId < itInterrupt THEN GOTO scanExitDeclare
   iRegId = iDstId - itInterrupt + 1
   IF LEN(RTRIM$(aRegIdDeclare(iRegId))) <> 0 THEN GOTO scanExitDeclare
   TypeIdTtl = 0
   DO
      IF srcWordNext = FALSE THEN EXIT DO
      IF mWord = "AS" THEN
         IF srcWordNext = FALSE THEN EXIT DO
         GOSUB scanIsUserType
         IF bUserType THEN
            TypeId = MID$(mLn, miLnFirst, mWordLen)
            TypeIdTtl = TypeIdTtl + 1
         END IF
      END IF
   LOOP
   IF TypeIdTtl = 2 THEN
      aRegIdDeclare(iRegId) = TypeId
   END IF
scanExitDeclare:
RETURN

scanDef:
   IF LEFT$(mWord, 2) = "FN" THEN
      iSrcIdDef = iSrcIdLast
   END IF
RETURN

scanDim:
   DO
      bDimFirst = TRUE
      DO
         IF mWord <> "AS" THEN
            DstIdAttr = iaTypeInvalid
            GOSUB scanFindDstId
            IF bDimFirst OR DimParenLvl = mParenLvl THEN
               VarId = mWord
               DimParenLvl = mParenLvl
               bDimFirst = FALSE
            END IF
         ELSE
            IF srcWordNext = FALSE THEN GOTO scanExitDim
            GOSUB scanIsUserType
            IF bUserType THEN
               DstIdAttr = iaTypeDim
               GOSUB scanFindDstId
               IF bDimFirst = FALSE THEN EXIT DO
            END IF
            bDimFirst = TRUE
         END IF
         IF srcWordNext = FALSE THEN GOTO scanExitDim
      LOOP
      iSrcId = 0
      DO
         IF iSrcId = iSrcIdLast THEN
            IF iSrcIdLast = ciSrcIdMax THEN GOTO scanExitDim
            iSrcIdLast = iSrcIdLast + 1
            aSrcId(iSrcIdLast) = MID$(mLn, miLnFirst, mWordLen)
            aiSrcId(iSrcIdLast) = 0
            iSrcId = iSrcIdLast
            EXIT DO
         END IF
         iSrcId = iSrcId + 1
         IF aiSrcId(iSrcId) < 1 THEN
            IF mWord = UCASE$(RTRIM$(aSrcId(iSrcId))) THEN EXIT DO
         END IF
      LOOP
      IF iSrcIdLast = ciSrcIdMax THEN GOTO scanExitDim
      iSrcIdLast = iSrcIdLast + 1
      aSrcId(iSrcIdLast) = VarId
      aiSrcId(iSrcIdLast) = iSrcId
   LOOP WHILE srcWordNext
scanExitDim:
RETURN

scanEnd:
   SELECT CASE mWord
      CASE "FUNCTION", "SUB"
         IF iSrcIdFuncSub <> -1 THEN
            iSrcIdLast = iSrcIdFuncSub
            iSrcIdFuncSub = -1
         END IF
      CASE "DEF"
         IF iSrcIdDef <> -1 THEN
            iSrcIdLast = iSrcIdDef
            iSrcIdDef = -1
         END IF
   END SELECT
RETURN

scanFindDstId:
   SELECT CASE mWord
      CASE "COMMAND"
         iDstId = itCommand
      CASE "COMMANDPROMPT"
         iDstId = itCommandPrompt
      CASE "INT86OLD"
         iDstId = itInt86Old
      CASE "INT86XOLD"
         iDstId = itInt86XOld
      CASE "INTERRUPT"
         iDstId = itInterrupt
      CASE "INTERRUPTX"
         iDstId = itInterruptX
      CASE "REGTYPE"
         iDstId = itRegType
      CASE "REGTYPEX"
         iDstId = itRegTypeX
      CASE "SSEG"
         iDstId = itSSeg
      CASE ELSE
         iDstId = itNull
         GOTO scanExitFindDstId
   END SELECT
   maDstIdAttr(iDstId) = maDstIdAttr(iDstId) OR DstIdAttr OR mWordSuffix
scanExitFindDstId:
RETURN

scanFunc:
   IF iSrcIdFuncSub <> -1 THEN iSrcIdLast = iSrcIdFuncSub
   iSrcIdFuncSub = iSrcIdLast
   DstIdAttr = iaFuncExist
   GOSUB scanFindDstId
   IF srcWordNext THEN GOSUB scanDim
RETURN

scanIsUserType:
   bUserType = FALSE
   IF mWord = "ANY" THEN GOTO scanExitIsUserType
   IF mWord = "DOUBLE" THEN GOTO scanExitIsUserType
   IF mWord = "INTEGER" THEN GOTO scanExitIsUserType
   IF mWord = "LONG" THEN GOTO scanExitIsUserType
   IF mWord = "SINGLE" THEN GOTO scanExitIsUserType
   IF mWord = "STRING" THEN GOTO scanExitIsUserType
   bUserType = TRUE
scanExitIsUserType:
RETURN

scanStatic:
   SELECT CASE mWord
      CASE "FUNCTION"
         IF srcWordNext THEN GOSUB scanFunc
      CASE "SUB"
         IF srcWordNext THEN GOSUB scanSub
      CASE ELSE
         GOSUB scanDim
   END SELECT
RETURN

scanSub:
   IF iSrcIdFuncSub <> -1 THEN iSrcIdLast = iSrcIdFuncSub
   iSrcIdFuncSub = iSrcIdLast
   DstIdAttr = iaSubExist
   GOSUB scanFindDstId
   IF srcWordNext THEN GOSUB scanDim
RETURN

scanType:
   DstIdAttr = iaTypeDef
   GOSUB scanFindDstId
   iSrcId = 0
   DO
      IF iSrcId = iSrcIdLast THEN
         IF iSrcIdLast <> ciSrcIdMax THEN
            iSrcIdLast = iSrcIdLast + 1
            aSrcId(iSrcIdLast) = MID$(mLn, miLnFirst, mWordLen)
            aiSrcId(iSrcIdLast) = -1
         END IF
         EXIT DO
      END IF
      iSrcId = iSrcId + 1
      IF aiSrcId(iSrcId) < 1 THEN
         IF mWord = UCASE$(RTRIM$(aSrcId(iSrcId))) THEN
            aiSrcId(iSrcId) = -1
            EXIT DO
         END IF
      END IF
   LOOP
RETURN

END SUB

FUNCTION keyGetCh%
   DIM KeyCh AS INTEGER
   DIM KeyStr AS STRING

   KeyStr = INKEY$
   SELECT CASE LEN(KeyStr)
      CASE 1
         KeyCh = ASC(KeyStr)
         IF KeyCh = 3 OR KeyCh = 27 THEN exitCancel
      CASE 2
         KeyCh = 0 - ASC(RIGHT$(KeyStr, 1))
      CASE ELSE
         KeyCh = 0
   END SELECT
   keyGetCh% = KeyCh

END FUNCTION

FUNCTION keyGetChoice$ (ChSetIn AS STRING)
   DIM ChoiceKey AS STRING
   DIM ChSet AS STRING
   DIM iChSet AS INTEGER
   DIM KeyCh AS INTEGER

   IF LEN(ChSetIn) <> 0 THEN
      ChSet = UCASE$(ChSetIn)
      iChSet = 0
      DO
         KeyCh = keyGetCh
         IF KeyCh > 0 THEN iChSet = INSTR(ChSet, UCASE$(CHR$(KeyCh)))
      LOOP WHILE iChSet = 0
      ChoiceKey = MID$(ChSetIn, iChSet, 1)
   ELSE
      DO
         KeyCh = keyGetCh
      LOOP WHILE KeyCh <= 0
      ChoiceKey = CHR$(KeyCh)
   END IF
   IF KeyCh >= 32 THEN
      PRINT ChoiceKey
   ELSE
      PRINT
   END IF
   keyGetChoice$ = ChoiceKey

END FUNCTION

FUNCTION keyGetStr$ (TxtLenMaxIn AS INTEGER, WinWidthIn AS INTEGER)
   DIM Col AS INTEGER
   DIM iTxt AS INTEGER
   DIM iTxtCurs AS INTEGER
   DIM iTxtLimit AS INTEGER
   DIM iTxtMax AS INTEGER
   DIM iTxtPrn AS INTEGER
   DIM iTxtWin AS INTEGER
   DIM KeyCh AS INTEGER
   DIM PrnCnt AS INTEGER
   DIM PrnCntMax AS INTEGER
   DIM Row AS INTEGER
   DIM Txt AS STRING
   DIM WinWidth AS INTEGER
   DIM WinWidthMax AS INTEGER

   Row = CSRLIN
   Col = POS(0)
   Txt = SPACE$(TxtLenMaxIn + 1)
   iTxtMax = TxtLenMaxIn
   iTxt = 1
   iTxtCurs = 1
   iTxtLimit = 1
   iTxtPrn = 1
   iTxtWin = 1
   PrnCnt = 0
   WinWidthMax = 80 - Col
   WinWidth = WinWidthIn
   IF WinWidth < 1 OR WinWidth > TxtLenMaxIn THEN
      IF TxtLenMaxIn <= WinWidthMax THEN WinWidthMax = WinWidthMax + 1
      WinWidth = TxtLenMaxIn + 1
   END IF
   IF WinWidth > WinWidthMax THEN WinWidth = WinWidthMax

   DO
      KeyCh = keyGetCh
      SELECT CASE KeyCh
         CASE 13: EXIT DO
         CASE 32 TO 255: GOSUB kgsAdd
         CASE 8: GOSUB kgsBackspace
         CASE -83: GOSUB kgsDelete
         CASE -79: GOSUB kgsGoEnd
         CASE -71: GOSUB kgsGoHome
         CASE -75: GOSUB kgsGoLeft
         CASE -77: GOSUB kgsGoRight
      END SELECT
   LOOP
   PRINT
   keyGetStr$ = RTRIM$(Txt)
   EXIT FUNCTION

kgsAdd:
   IF iTxtLimit <= iTxtMax THEN
      iTxtLimit = iTxtLimit + 1
      iTxtPrn = iTxt
      PrnCnt = iTxtLimit - iTxt
      IF PrnCnt > 1 THEN
         MID$(Txt, iTxt + 1, PrnCnt - 1) = MID$(Txt, iTxt, PrnCnt - 1)
      END IF
      MID$(Txt, iTxt, 1) = CHR$(KeyCh)
      iTxt = iTxt + 1
      GOSUB kgsPrint
   ELSE
      BEEP
   END IF
RETURN

kgsBackspace:
   IF iTxt > 1 THEN
      GOSUB kgsGoLeft
      GOSUB kgsDelete
   END IF
RETURN

kgsDelete:
   IF iTxt < iTxtLimit THEN
      iTxtPrn = iTxt
      PrnCnt = iTxtLimit - iTxt
      IF PrnCnt > 1 THEN
         MID$(Txt, iTxt, PrnCnt - 1) = MID$(Txt, iTxt + 1, PrnCnt - 1)
      END IF
      iTxtLimit = iTxtLimit - 1
      MID$(Txt, iTxtLimit, 1) = SPACE$(1)
      GOSUB kgsPrint
   END IF
RETURN

kgsGo:
   iTxtPrn = iTxt
   PrnCnt = 0
   GOSUB kgsPrint
RETURN

kgsGoEnd:
   iTxt = iTxtLimit
   GOSUB kgsGo
RETURN

kgsGoHome:
   iTxt = 1
   GOSUB kgsGo
RETURN

kgsGoLeft:
   IF iTxt > 1 THEN
      iTxt = iTxt - 1
      GOSUB kgsGo
   END IF
RETURN

kgsGoRight:
   IF iTxt < iTxtLimit THEN
      iTxt = iTxt + 1
      GOSUB kgsGo
   END IF
RETURN

kgsPrint:
   IF iTxt < iTxtWin THEN
      iTxtWin = iTxt
      iTxtPrn = iTxtWin
      PrnCnt = WinWidth
   ELSEIF iTxt > (iTxtWin + WinWidth - 1) THEN
      iTxtWin = iTxt - WinWidth + 1
      iTxtPrn = iTxtWin
      PrnCnt = WinWidth
   END IF
   PrnCntMax = iTxtWin + WinWidth - iTxtPrn
   IF PrnCnt > PrnCntMax THEN PrnCnt = PrnCntMax
   IF PrnCnt <> 0 THEN
      IF iTxtPrn <> iTxtCurs THEN LOCATE Row, iTxtPrn - iTxtWin + Col
      PRINT MID$(Txt, iTxtPrn, PrnCnt);
      iTxtCurs = iTxtPrn + PrnCnt
   END IF
   IF iTxt <> iTxtCurs THEN
      LOCATE Row, iTxt - iTxtWin + Col
      iTxtCurs = iTxt
   END IF
RETURN

END FUNCTION

SUB srcBegin (bCopyFileIn AS INTEGER, StatusLblIn AS STRING)

   mbOutputWrite = bCopyFileIn
   PRINT StatusLblIn;
   mStatusRow = CSRLIN
   mStatusCol = POS(0)
   mLnTtl = 0
   mbStatus = TRUE
   PRINT USING cLnTtlFmt; mLnTtl;
   miSrcFileLast = 1
   maSrcFile(1) = mSrcFile
   mahSrc(1) = mhSrc
   mParenLvl = 0
   IF NOT EOF(mhSrc) THEN
      LINE INPUT #mhSrc, mLn
      mLnU = UCASE$(mLn)
      miLnMax = LEN(mLn)
      miLn = 0
      mLnBrk = brkColon
   ELSE
      mbOutputWrite = FALSE
      mLn = ""
      mLnU = ""
      miLnMax = 0
      miLn = 0
      mLnBrk = brkEol
   END IF

END SUB

SUB srcEnd

   IF mbStatus THEN
      LOCATE mStatusRow, mStatusCol
      PRINT USING cLnTtlFmt; mLnTtl
      mbStatus = FALSE
   END IF

END SUB

FUNCTION srcWordFirst%

   GOSUB swfFindColon
   DO
      DO
      LOOP WHILE keyGetCh <> 0
      IF mLnBrk = brkInvalid THEN
         exitError "File not in text format - " + maSrcFile(miSrcFileLast)
         srcWordFirst% = FALSE
         GOTO swfExitFunc
      END IF
      IF mLnBrk = brkRem THEN
         zsrcComment
         mLnBrk = brkEol
      END IF
      IF mLnBrk <> brkColon THEN
         IF mbOutputWrite THEN PRINT #mhDst, mLn
         mLnTtl = mLnTtl + 1
         IF (mLnTtl AND 31) = 0 THEN
            LOCATE mStatusRow, mStatusCol
            PRINT USING cLnTtlFmt; mLnTtl;
         END IF
         DO WHILE EOF(mhSrc)
            IF miSrcFileLast = 1 THEN
               mhSrc = mahSrc(1)
               srcWordFirst% = FALSE
               GOTO swfExitFunc
            END IF
            CLOSE #mhSrc
            miSrcFileLast = miSrcFileLast - 1
            mhSrc = mahSrc(miSrcFileLast)
         LOOP
         LINE INPUT #mhSrc, mLn
         mLnU = UCASE$(mLn)
         miLnMax = LEN(mLn)
         miLn = 0
      END IF
      mParenLvl = 0
      mLnBrk = brkNormal
      IF srcWordNext THEN
         IF mWord = "DATA" THEN
            maBrk(39) = brkNone
            GOSUB swfFindColon
            maBrk(39) = brkRem
         ELSEIF mWord = "REM" THEN
            mLnBrk = brkRem
         ELSE
            srcWordFirst% = TRUE
            GOTO swfExitFunc
         END IF
      END IF
   LOOP

swfFindColon:
   DO WHILE mLnBrk < brkRem
      IF miLn = miLnMax THEN
         mLnBrk = brkEol
      ELSEIF mLnBrk = brkQuote THEN
         miLn = INSTR(miLn + 1, mLnU, CHR$(34))
         IF miLn > 0 AND miLn < miLnMax THEN
            miLn = miLn + 1
            mLnBrk = maBrk(ASC(MID$(mLnU, miLn, 1)))
         ELSE
            mLnBrk = brkEol
         END IF
      ELSE
         miLn = miLn + 1
         mLnBrk = maBrk(ASC(MID$(mLnU, miLn, 1)))
      END IF
   LOOP
RETURN

swfExitFunc:

END FUNCTION

FUNCTION srcWordNext%

   DO
      IF mLnBrk >= brkNone THEN EXIT DO
      mParenLvl = mParenLvl + mLnBrk
      IF miLn = miLnMax THEN GOTO swnEol
      miLn = miLn + 1
      mLnCh = ASC(MID$(mLnU, miLn, 1))
      mLnBrk = maBrk(mLnCh)
   LOOP

   IF mLnBrk = brkNone THEN
      miLnFirst = miLn
      DO
         IF miLn = miLnMax THEN GOTO swnWordAll
         miLn = miLn + 1
         mLnCh = ASC(MID$(mLnU, miLn, 1))
         mLnBrk = maBrk(mLnCh)
         IF mLnBrk <> brkNone THEN GOTO swnWordMid
      LOOP
   ELSEIF mLnBrk = brkQuote THEN
      miLnFirst = miLn
      DO
         IF miLn = miLnMax THEN GOTO swnEol
         miLn = INSTR(miLn + 1, mLnU, CHR$(34))
         IF miLn = 0 THEN GOTO swnEol
         IF miLn = miLnMax THEN GOTO swnWordAll
         miLn = miLn + 1
         mLnCh = ASC(MID$(mLnU, miLn, 1))
         mLnBrk = maBrk(mLnCh)
         IF mLnBrk <> brkQuote THEN GOTO swnWordMid
      LOOP
   ELSE
      srcWordNext% = FALSE
      GOTO swnExit
   END IF

swnEol:
   mLnBrk = brkEol
   srcWordNext% = FALSE
GOTO swnExit
         
swnWordMid:
   mWordLen = miLn - miLnFirst
   mWord = MID$(mLnU, miLnFirst, mWordLen)
   mWordSuffix = maSuffix(mLnCh)
   srcWordNext% = TRUE
GOTO swnExit

swnWordAll:
   mWordLen = miLnMax - miLnFirst + 1
   mWord = RIGHT$(mLnU, mWordLen)
   mWordSuffix = iaNone
   mLnBrk = brkEol
   srcWordNext% = TRUE
GOTO swnExit

swnExit:

END FUNCTION

FUNCTION strError$ (ErrCodeIn AS INTEGER)

   SELECT CASE ErrCodeIn
      CASE 2: strError$ = "Syntax error"
      CASE 3: strError$ = "RETURN without GOSUB"
      CASE 4: strError$ = "Out of DATA"
      CASE 5: strError$ = "Illegal function call"
      CASE 6: strError$ = "Overflow"
      CASE 7: strError$ = "Out of memory"
      CASE 9: strError$ = "Subscript out of range"
      CASE 10: strError$ = "Duplicate definition"
      CASE 11: strError$ = "Division by zero"
      CASE 13: strError$ = "Type mismatch"
      CASE 14: strError$ = "Out of string space"
      CASE 16: strError$ = "String formula too complex"
      CASE 19: strError$ = "No RESUME"
      CASE 20: strError$ = "RESUME without error"
      CASE 24: strError$ = "Device timeout"
      CASE 25: strError$ = "Device fault"
      CASE 27: strError$ = "Out of paper"
      CASE 39: strError$ = "CASE ELSE expected"
      CASE 40: strError$ = "Variable required"
      CASE 50: strError$ = "FIELD overflow"
      CASE 51: strError$ = "Internal error"
      CASE 52: strError$ = "Bad file name or number"
      CASE 53: strError$ = "File not found"
      CASE 54: strError$ = "Bad file mode"
      CASE 55: strError$ = "File already open"
      CASE 56: strError$ = "FIELD statement active"
      CASE 57: strError$ = "Device I/O error"
      CASE 58: strError$ = "File already exists"
      CASE 59: strError$ = "Bad record length"
      CASE 61: strError$ = "Disk full"
      CASE 62: strError$ = "Input past end of file"
      CASE 63: strError$ = "Bad record number"
      CASE 64: strError$ = "Bad file name"
      CASE 67: strError$ = "Too many files"
      CASE 68: strError$ = "Device unavailable"
      CASE 69: strError$ = "Communication-buffer overflow"
      CASE 70: strError$ = "Permission denied"
      CASE 71: strError$ = "Disk not ready"
      CASE 72: strError$ = "Disk-media error"
      CASE 73: strError$ = "Advanced feature unavailable"
      CASE 74: strError$ = "Rename across disks"
      CASE 75: strError$ = "Path/File access error"
      CASE 76: strError$ = "Path not found"
      CASE ELSE: strError$ = "Unknown error - " + LTRIM$(STR$(ErrCodeIn))
   END SELECT

END FUNCTION

SUB zsrcComment
   DIM Arg AS STRING
   DIM ArgCh AS INTEGER
   DIM ArgLen AS INTEGER
   DIM BlankLen AS INTEGER
   DIM Cmd AS STRING
   DIM CmdLen AS INTEGER
   DIM FileName AS STRING
   DIM FilePath AS STRING
   DIM FilePathLen AS INTEGER
   DIM hInc AS INTEGER
   DIM iLnArg AS INTEGER
   DIM iLnCmd AS INTEGER
   DIM IncFile AS STRING
   DIM LeftLen AS INTEGER
   DIM RightLen AS INTEGER
   DIM WordTtl AS INTEGER

   miLnFirst = miLn
   DO
      IF miLnFirst = miLnMax THEN GOTO zscExit
      miLnFirst = miLnFirst + 1
      mLnCh = ASC(MID$(mLnU, miLnFirst, 1))
      IF mLnCh > 32 THEN EXIT DO
   LOOP
   IF mLnCh <> 36 THEN GOTO zscExit
   miLnFirst = 0
   mLnCh = 256
   GOSUB zscMetaGet
   DO UNTIL WordTtl = 0
      IF WordTtl = 2 THEN
         IF Cmd = "$INCLUDE" THEN
            GOSUB zscSplitFileSpec
            SELECT CASE FileName
               CASE "QB.BI", "QBX.BI", "VBDOS.BI"
                  GOSUB zscMetaDel
               CASE ELSE
                  miLnFirst = iLnCmd - BlankLen
            END SELECT
         END IF
      END IF
      GOSUB zscMetaGet
   LOOP
   IF miLnFirst = 0 THEN GOTO zscExit
   IF miSrcFileLast = ciSrcFileMax THEN
      exitError "Too many nested include files"
      GOTO zscExit
   END IF
   miLn = miLnFirst - 1
   mLnCh = 256
   GOSUB zscMetaGet
   GOSUB zscSplitFileSpec
   hInc = FREEFILE
   IncFile = Arg
   mErrCode = 0
   mErrTrap = etLocal
   OPEN IncFile FOR INPUT AS #hInc
   mErrTrap = etGlobal
   IF mErrCode <> 0 THEN
      IF mSrcPath <> FilePath THEN
         IncFile = mSrcPath + FileName
         mErrCode = 0
         mErrTrap = etLocal
         OPEN IncFile FOR INPUT AS #hInc
         mErrTrap = etGlobal
      END IF
   END IF
   IF mErrCode <> 0 THEN GOTO zscExit
   miSrcFileLast = miSrcFileLast + 1
   mhSrc = hInc
   mahSrc(miSrcFileLast) = hInc
   maSrcFile(miSrcFileLast) = IncFile
   GOSUB zscMetaDel
   GOTO zscExit

zscMetaDel:
   LeftLen = iLnCmd - BlankLen - 1
   RightLen = miLnMax - miLn
   miLnMax = LeftLen + RightLen
   miLn = LeftLen
   mLnCh = 256
   mLn = LEFT$(mLn, LeftLen) + RIGHT$(mLn, RightLen)
   mLnU = UCASE$(mLn)
RETURN

zscMetaGet:
   WordTtl = 0
   BlankLen = 0
   DO
      IF mLnCh = 36 THEN EXIT DO
      IF mLnCh > 32 THEN
         BlankLen = 0
      ELSE
         BlankLen = BlankLen + 1
      END IF
      IF miLn = miLnMax THEN GOTO zscExitMetaGet
      miLn = miLn + 1
      mLnCh = ASC(MID$(mLnU, miLn, 1))
   LOOP
   WordTtl = 1
   iLnCmd = miLn
   DO
      IF miLn = miLnMax THEN
         CmdLen = miLnMax - iLnCmd + 1
         EXIT DO
      END IF
      miLn = miLn + 1
      mLnCh = ASC(MID$(mLnU, miLn, 1))
      IF mLnCh <= 32 OR mLnCh = 36 OR mLnCh = 58 THEN
         CmdLen = miLn - iLnCmd
         EXIT DO
      END IF
   LOOP
   Cmd = MID$(mLnU, iLnCmd, CmdLen)
   iLnArg = miLn
   ArgCh = mLnCh
   DO
      IF ArgCh > 32 THEN EXIT DO
      IF iLnArg = miLnMax THEN GOTO zscExitMetaGet
      iLnArg = iLnArg + 1
      ArgCh = ASC(MID$(mLnU, iLnArg, 1))
   LOOP
   IF ArgCh <> 58 THEN GOTO zscExitMetaGet
   DO
      IF iLnArg = miLnMax THEN GOTO zscExitMetaGet
      iLnArg = iLnArg + 1
      ArgCh = ASC(MID$(mLnU, iLnArg, 1))
      IF ArgCh > 32 THEN EXIT DO
   LOOP
   IF ArgCh <> 39 THEN GOTO zscExitMetaGet
   WordTtl = 0
   IF iLnArg = miLnMax THEN GOTO zscExitMetaGet
   mLnCh = ArgCh
   miLn = INSTR(iLnArg + 1, mLnU, "'")
   IF miLn = 0 THEN GOTO zscExitMetaGet
   WordTtl = 2
   ArgLen = miLn - iLnArg - 1
   IF ArgLen <> 0 THEN Arg = MID$(mLnU, iLnArg + 1, ArgLen)
zscExitMetaGet:
RETURN

zscSplitFileSpec:
   FilePathLen = ArgLen
   DO
      IF FilePathLen = 0 THEN EXIT DO
      IF INSTR(":\/", MID$(Arg, FilePathLen, 1)) THEN EXIT DO
      FilePathLen = FilePathLen - 1
   LOOP
   FilePath = LEFT$(Arg, FilePathLen)
   FileName = RIGHT$(Arg, ArgLen - FilePathLen)
RETURN

zscExit:

END SUB