'===========================================================================
' Subject: INSTALLATION UTILITY               Date: 01-29-93 (10:58)       
'  Author: Ethan Winer                        Code: QB, PDS                
'  Origin: sansbach@gpu.srv.ualberta.ca     Packet: MISC.ABC
'===========================================================================
'********** PC-SETUP.BAS - PC Magazine Install Utility

'Copyright (c) 1992 Ethan Winer

'Note: If you run this program in the QB editor the ExeName function will
'return the directory that QB.EXE was run from, which is not necessarily the
'current directory.  In that case you may have to enter the directory name
'where your various .ZIP files reside for PC-SETUP to find them.
'
'If you are using Crescent's P.D.Q. you must search for all each call to the
'Interrupt routine, and change it as shown in the accompanying comments.  You
'can then compile and link this program for the smallest size possible as
'follows:
'
'   bc pc-setup /o/s;
'   link /nod/noe/packc/far/ex _
'     pc-setup _noread _noval _noerror _cprint , , nul , [basic7] pdq;
'   exe2com pc-setup               (optional)
'   del pc-setup.exe               (optional)
'   ren pc-setup.com pc-setup.exe  (optional)


DEFINT A-Z

'---- BASIC SUB and FUNCTION procedures in this program file
'
DECLARE SUB CopyFile (Source$)
DECLARE SUB DrawBox (ULRow, ULCol, LRRow, LRCol, Style)
DECLARE SUB DrawScreen ()
DECLARE SUB Editor (Text$, Row, LeftCol, Length, KeyCode)
DECLARE SUB EarlyEnd ()
DECLARE SUB ErrorEnd (Message$)
DECLARE SUB MidCharS (Work$, Position, NewChar)
DECLARE SUB ReadNames (Spec$, Array$())
DECLARE SUB SelectFiles (FileNames$(), Choice, ExitCode)
DECLARE SUB SetDrive (Drive$)
DECLARE SUB StuffBuf (Work$)

DECLARE FUNCTION ChangeDir% (DirName$)
DECLARE FUNCTION DOSVersion% ()
DECLARE FUNCTION Execute% (FileName$, Parameter$)
DECLARE FUNCTION ExeName$ ()
DECLARE FUNCTION FileCount% (FileSpec$, DirFlag)
DECLARE FUNCTION GetComment$ (FileName$)
DECLARE FUNCTION GetDir$ ()
DECLARE FUNCTION GetDrive% ()
DECLARE FUNCTION IntVal% (Work$)
DECLARE FUNCTION MakeDir% (DirName$)
DECLARE FUNCTION MidChar% (Work$, Position)
DECLARE FUNCTION Prompt% (Which)
DECLARE FUNCTION SourceDir$ ()


'Define the TYPE and other shared variables needed for using CALL InterruptX.
'
TYPE RegType
  AX    AS INTEGER
  BX    AS INTEGER
  CX    AS INTEGER
  DX    AS INTEGER
  BP    AS INTEGER
  SI    AS INTEGER
  DI    AS INTEGER
  Flags AS INTEGER
  DS    AS INTEGER
  ES    AS INTEGER
END TYPE
DIM SHARED Regs AS RegType

TYPE DTAType                            'used by find first/next service
  Reserved  AS STRING * 21              'reserved for use by DOS
  Attribute AS STRING * 1               'the file's attribute
  FileTime  AS STRING * 2               'the file's time
  FileDate  AS STRING * 2               'the file's date
  FileSize  AS LONG                     'the file's size
  FileName  AS STRING * 13              'the file's name
END TYPE
DIM SHARED DTA AS DTAType

DIM SHARED DOS                          'so the DOS procedures can get at it
DIM SHARED ZBuffer AS STRING * 80       'holds ASCIIZ copies of DOS strings
DIM SHARED One, Zero, Zero$             'these save code when used in CALLs
DIM SHARED Temp, Temp$                  'these are reusable scratch variables

'---- Define some constants and variables, and colors based on display type.
'
CONST MaxFiles% = 19                    'max. number of .ZIP files per disk
CONST DirLength% = 25                   'length of dest. directory display

One = 1                                 'saves four bytes per use in a CALL
DOS = &H21                              'also saves four bytes per use
Zero$ = CHR$(0)                         'call CHR$() just once here
PadComment$ = SPACE$(36)                'holds each comment when printing
REDIM DirsMade$(1 TO 100)               'remembers directories we created

Bar$ = "Μ" + STRING$(78, 205) + "Ή"     'for the main screen separating bars
Msg$ = SPACE$(79)                       'for messages on the bottom line
IF INSTR(UCASE$(COMMAND$), "/B") THEN MonoFlag = -1   '/b forces mono colors

NormFG = 11: NormBG = 7                 'assume colors for a color display
HiFG = 11: HiBG = 4                     'menu and default directory colors
MainFG = 10: MainBG = 1                 'main screen and box FG and BG colors
CsrSize = 7                             'color displays use 8 scan lines

DEF SEG = 0                             'see if it's really a color display
MonoMon = (PEEK(&H463) = &HB4)          'if not, MonoMon now equals -1
IF MonoMon OR MonoFlag THEN             'it's monochrome or /b was used
  NormFG = 7: NormBG = 0
  HiFG = 15: HiBG = 0
  MainFG = 0: MainBG = 7
  IF MonoMon THEN CsrSize = 12          'mono displays use 13 scan lines
END IF

IF DOSVersion% < 300 THEN               'PC-SETUP requires DOS 3.0 or later
  PRINT "DOS 3.0 or later required."
  END
END IF

'---- Get the directory PC-SETUP was run from or prompt for it if needed, to
'     ensure that there's at least one .ZIP file present to install.
'
InstPath$ = SourceDir$
DO
  IF RIGHT$(InstPath$, 1) <> "\" THEN InstPath$ = InstPath$ + "\"
  InstSpec$ = InstPath$ + "*.ZIP"
  NumFiles = FileCount%(InstSpec$, Zero)
  IF NumFiles THEN EXIT DO
  PRINT "No .ZIP files were found."
  INPUT "Enter the source directory or press Enter to end: ", InstPath$
  IF LEN(InstPath$) = 0 THEN END
LOOP

IF FileCount%(InstPath$ + "PKUNZIP.EXE", Zero) = 0 THEN 'confirm PKUNZIP
  PRINT "Can't find PKUNZIP."                           '  is available
  END
END IF
     
IF MidChar%(InstPath$, 2) <> 58 THEN    'if there's no drive letter (:)
  InstPath$ = CHR$(GetDrive%) + ":" + InstPath$ 'append the current drive
END IF


'---- See if they're installing more than one disk, and if so how many.
'
NumDisks = 1                                'assume only one disk for now
NumDisksFile$ = InstPath$ + "NUMDISKS.*"    'concatenate these just once

IF FileCount%(NumDisksFile$, Zero) THEN
  DIM NumDisks$(1 TO 1)
  CALL ReadNames(NumDisksFile$, NumDisks$())
  Temp = INSTR(NumDisks$(1), ".")
  NumDisks = IntVal%(MID$(NumDisks$(1), Temp + 1))
END IF


'---- See if there's a DEFAULT.DIR file in the root directory of the first
'     distribution disk, and if so read its contents.  Here we're using
'     FileCount to merely see if the file exists.  If there's no DEFAULT.DIR
'     file, default to current drive and directory.  And if the current drive
'     is A or B replace that with C.
'
SaveDir$ = CHR$(GetDrive%) + ":" + GetDir$      'save this while we have it
DefaultDir$ = SaveDir$                          'now assign it as the default

Temp = ASC(DefaultDir$)                         'avoid using ASC() twice
IF Temp = 65 OR Temp = 66 THEN                  'don't default to A: or B:
  CALL MidCharS(DefaultDir$, 1, 67)             'if A: or B:, substitute C:
END IF

DefaultDirFile$ = InstPath$ + "DEFAULT.DIR"     'concatenate these just once

IF FileCount%(DefaultDirFile$, Zero) THEN       'open the file if it exists
  OPEN DefaultDirFile$ FOR INPUT AS #1
  INPUT #1, DefaultDir$                         'read the default directory,
  CLOSE                                         ' trim and capitalize (UCASE$
  DefaultDir$ = UCASE$(RTRIM$(LTRIM$(DefaultDir$))) ' is for cosmetics only)
END IF


'---- See if there's a PROGRAM.RUN file in the root directory of the first
'     distribution disk, and if so read its contents.
'
RunFileName$ = InstPath$ + "PROGRAM.RUN"        'concatenate these just once
IF FileCount%(RunFileName$, Zero) THEN          'open the file if it exists
  OPEN RunFileName$ FOR INPUT AS #1
  INPUT #1, RunName$
  CLOSE
  RunName$ = RunName$ + CHR$(13)                'simulate pressing Enter
  IF LEN(RunName$) > 15 THEN RunName$ = ""      'don't use name if too long
END IF


'---- This is the main installation loop that cycles through each diskette.
'
FOR Disk = 1 TO NumDisks

  '---- See how many .ZIP files there are on the current disk, and limit the
  '     number we'll handle to MaxFiles% if there are more than that.  Then
  '     draw/redraw the main screen.
  '
  NumFiles = FileCount%(InstSpec$, Zero)
  IF NumFiles > MaxFiles% THEN NumFiles = MaxFiles%
 
  CALL DrawScreen
 
  '---- Read the .ZIP file names and display them in a vertical menu.  Then
  '     read any default directories (if present) within each .ZIP file's
  '     comment, and display them in the destination directory fields.  For
  '     each .ZIP file that doesn't have a corresponding default directory
  '     in the comment, use the contents of the main DEFAULT.DIR file found
  '     in the root directory of the disk.
  '
  REDIM ZIPName$(1 TO NumFiles)
  REDIM DestDir$(1 TO NumFiles)
  REDIM Comment$(1 TO NumFiles)

  CALL ReadNames(InstSpec$, ZIPName$())

  FOR X = 1 TO NumFiles                 'look at each .ZIP file comment
    DestDir$(X) = SPACE$(DirLength%)    'create a string to hold the dest dir
    LSET DestDir$(X) = DefaultDir$      'assume none, use the global default
    Comment$(X) = GetComment$(InstPath$ + ZIPName$(X))
    Temp = INSTR(Comment$(X), "ώ")      'see if a directory was given
    IF Temp THEN                        'there is a directory for this file
      LSET DestDir$(X) = UCASE$(MID$(Comment$(X), Temp + 1)) 'dir is on right
      Comment$(X) = LEFT$(Comment$(X), Temp - 1)         'and comment on left
    END IF
  NEXT

  FOR X = 1 TO NumFiles                 'add leading blanks to make room
    ZIPName$(X) = "   " + ZIPName$(X)   '  for the CHR$(251) check marks
    IF RIGHT$(Comment$(X), 1) = "ϋ" THEN    'they want this file checked
      CALL MidCharS(ZIPName$(X), 2, 251)    'so check it in the file list box
      Comment$(X) = LEFT$(Comment$(X), LEN(Comment$(X)) - 1)
    END IF
    LSET PadComment$ = Comment$(X)      'display the directories and comments
    COLOR NormFG, NormBG                'while we're here
    LOCATE X + 4, 2: PRINT DestDir$(X);
    LOCATE X + 4, 44: PRINT PadComment$;
  NEXT

  DO                                    'let the user select the files
    CALL SelectFiles(ZIPName$(), Choice, ExitCode)
    IF ExitCode = 9 THEN                'they pressed Tab
      COLOR MainFG, MainBG
      LOCATE 25, 2
      PRINT SPC(30); "Tab: Select .ZIP files    F2: Begin    Esc: Quit";

      DO
        CALL Editor(DestDir$(Choice), Choice + 4, 2, 25, ExitCode)
        SELECT CASE ExitCode            'how did the terminate editing?
          CASE -80                      'Down Arrow
            Choice = Choice + 1         'wrap around if they go past the end
            IF Choice > NumFiles THEN Choice = 1
          CASE -72                      'Up Arrow
            Choice = Choice - 1         'wrap to the end if they go before 1
            IF Choice < 1 THEN Choice = NumFiles
          CASE 27                       'Escape
            CALL EarlyEnd
          CASE -60                      'F2
            ExitCode = -60              'tell SelectFiles to come right back
            EXIT DO                     '  so we can exit both levels of DO
          CASE ELSE
            EXIT DO                     'anything else returns to SelectFiles
        END SELECT
      LOOP
    ELSEIF ExitCode = -60 THEN          'F2
      ExitCode = 0                      'prevent unwanted recursion across
      EXIT DO                           '  multiple disks
    ELSEIF ExitCode = 27 THEN           'Escape
      CALL EarlyEnd
    END IF
  LOOP


  '---- Install the selected files to the specified destination directories.
  '     For each file that is tagged, either change to the appropriate drive
  '     and directory, or ensure that we're back to the original path.
  '
  FOR X = 1 TO NumFiles                       'for each .ZIP file present

    IF MidChar%(ZIPName$(X), 2) = 251 THEN    'if it's tagged to install

      IF X = 1 THEN RunProg = -1              'use PROGRAM.RUN only if first
                                              '  file is being installed
      COLOR MainFG, MainBG                    'for the status message below
      CLS
      LSET Msg$ = "Installing" + RTRIM$(MID$(ZIPName$(X), 3)) + "..."
      COLOR HiFG
      PRINT Msg$                              'advise the user as to progress
      COLOR MainFG
     
      DestPath$ = RTRIM$(DestDir$(X))         'work with a copy of the path

      IF MidChar%(DestPath$, 2) = 58 THEN     'if a drive was used (58 = ":")
        CALL SetDrive(DestPath$)              'change to that drive
        IF GetDrive% <> ASC(DestPath$) THEN   'no such drive
          CALL ErrorEnd("Drive " + LEFT$(DestPath$, 2) + " invalid")
        END IF
      ELSE
        CALL SetDrive(DefaultDir$)            'else switch to default drive
      END IF

      'strip off possible trailing "\" unless it refers to the root directory
      IF RIGHT$(DestPath$, 1) = "\" THEN
        Temp = LEN(DestPath$)
        IF Temp > 1 AND RIGHT$(DestPath$, 2) <> ":\" THEN
          DestPath$ = LEFT$(DestPath$, Temp - 1)
        END IF
      END IF

      Temp = -1                               'assume directory now exists
      IF LEN(DestPath$) THEN                  'if a directory name was given

        IF RIGHT$(DestPath$, 1) <> "\" THEN   'and it's not a root directory

          IF FileCount%(DestPath$, -1) = 0 THEN   'does the directory exist?
            IF MakeDir%(DestPath$) THEN       'no, so first try to create it
              CALL ErrorEnd("Cannot create " + DestPath$)
            END IF
            Temp = 0                          'it can't possibly have files
            DirsWeMade = DirsWeMade + 1       'show we created another one
            DirsMade$(DirsWeMade) = DestPath$ 'and remember its name
          END IF

          FOR Y = 1 TO DirsWeMade             'see if we made this directory
            IF DestPath$ = DirsMade$(Y) THEN  'yes, so there's no need to
              Temp = 0                        ' warn about overwriting files
              EXIT FOR
            END IF
          NEXT

        END IF

        IF ChangeDir%(DestPath$) THEN         'then try to change to it
          CALL ErrorEnd("Unable to access " + DestPath$)
        END IF

      END IF

      PKCmd$ = "-o "                          'assume they want to be warned
      IF Temp THEN                            'this directory existed
        IF Prompt%(Zero) THEN                 'ask if they want to be warned
          PKCmd$ = ""                         ' to overwrite existing files
        END IF                                ' without further prompting and
      END IF                                  ' use appropriate command if so

      IF NOT PKCopied THEN                    'copy PKUNZIP first time only
        PKCopied = -1                         'flag that we did it already
        CALL CopyFile(InstPath$)              'show where PKUNZIP.EXE is
        PKDir$ = RTRIM$(DestDir$(X))          'remember where we put it!
        IF LEN(PKDir$) = 0 THEN PKDir$ = DefaultDir$ 'use default dir if none
       
        Temp = ASC(RIGHT$(PKDir$, 1))         'check the right-most character
        IF Temp <> 58 AND Temp <> 92 THEN     'if not a colon or backslash
          PKDir2$ = "\"                       ' create a trailing "\"
        END IF                                ' which is appended below
      END IF

      '---- Install all of the files contained in this .ZIP file and check
      '     for an errors returned by either DOS or PKUNZIP.  Execute returns
      '     positive error values if PKUNZIP was run okay but it returned an
      '     error via the DOS Errorlevel.  If DOS itself reports an error
      '     (perhaps there wasn't enough memory to run the program) Execute
      '     returns the DOS error value as a negative number.  Error 8 is the
      '     DOS "Out of memory" error.
      '
      Temp = Execute%(PKDir$ + PKDir2$ + "PKUNZIP.EXE", PKCmd$ + InstPath$ + RTRIM$(MID$(ZIPName$(X), 4)))
      IF Temp THEN
        Temp$ = "PKUNZIP reports Error" + STR$(Temp)
        IF Temp < 0 THEN Temp$ = "Out of memory"
        CALL ErrorEnd(Temp$)
      END IF

      IF INKEY$ = CHR$(27) THEN         'allow aborting by pressing Escape
        CALL EarlyEnd
      END IF

    END IF

  NEXT

  IF Disk < NumDisks THEN               'if there are more disks to install
    LOCATE 25, 2                        'prompt to insert the next disk
    LSET Msg$ = "Insert the next disk and press any key when ready"
    COLOR MainFG, MainBG
    PRINT Msg$;
    LOCATE , 52
    DO: LOOP WHILE LEN(INKEY$)          'first clear any pending keys
    DO: LOOP UNTIL LEN(INKEY$)          'then wait for a keypress
    CALL SetDrive(SaveDir$)             'return to the current drive and its
    Temp = ChangeDir%(SaveDir$)         '  current directory before going on
  END IF

NEXT Disk


'---- Report success and run the specified program (StuffBuf ignores a null
'     string argument.
'
COLOR 7, 0: CLS
LOCATE 13, 30: PRINT "Installation complete!"
LOCATE 22, 1, 1
CALL SetDrive(PKDir$)                   'change to the first drive and
Temp = ChangeDir%(PKDir$)               ' directory we installed to
KILL "PKUNZIP.EXE"                      'delete the copy of PKUNZIP.EXE there
IF RunProg THEN CALL StuffBuf(RunName$) 'stuff the buffer if appropriate
END                                     'and end

FUNCTION ChangeDir% (DirName$)          'returns 0 if Okay, -1 if an error
 
  ZBuffer$ = DirName$ + Zero$           'make an ASCIIZ string
  Regs.AX = &H3B00                      'DOS change directory service
  Regs.DX = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ is
  CALL Interrupt(DOS, Regs, Regs)       'call DOS
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.

  IF Regs.Flags AND 1 THEN              'must be an invalid path
    ChangeDir% = -1                     'return -1 as an error
  END IF

END FUNCTION

SUB CopyFile (Source$) STATIC           'copies PKUNZIP.EXE
 
  Temp$ = Source$ + "PKUNZIP.EXE"
 
  IF FileCount%(Temp$, Zero) THEN
    OPEN Temp$ FOR BINARY AS #1         'open the input file if it exists
  ELSE                                  'if we can't find it, bag out with
    CALL ErrorEnd("Can't find PKUNZIP.EXE")     ' an error message
  END IF

  OPEN "PKUNZIP.EXE" FOR BINARY AS #2   'now open the target file

  Temp$ = SPACE$(LOF(1))                'make a buffer to hold PKUNZIP.EXE
  GET #1, , Temp$                       'read the source file
  PUT #2, , Temp$                       'write it to the destination
 
  CLOSE                                 'all done here
   
END SUB

FUNCTION DOSVersion% STATIC         'returns DOS version * 100 (3.30 = 330)

  Regs.AX = &H3000                  'DOS get DOS version service
  CALL Interrupt(DOS, Regs, Regs)
 'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.

  'combine the major version in AL and the minor in AH
  DOSVersion% = (Regs.AX AND 255) * 100 + (Regs.AX \ 256)

END FUNCTION

SUB DrawBox (ULRow, ULCol, LRRow, LRCol, Style) STATIC
 
  Length = LRCol - ULCol + 1            'calculate this just once
 
  IF Style = 1 THEN
    LineType = 196
    VertBar$ = "³"
  ELSE
    LineType = 205
    VertBar$ = "Ί"
  END IF

  FOR X = ULRow TO LRRow                'first draw the walls
    LOCATE X, ULCol
    Temp = 32
    IF X = ULRow OR X = LRRow THEN Temp = LineType
    PRINT VertBar$; STRING$(Length - 2, Temp); VertBar$;
  NEXT

  IF Style = 1 THEN                     'then draw the corners
    LOCATE ULRow, ULCol: PRINT "Ϊ";
    LOCATE ULRow, LRCol: PRINT "Ώ";
    LOCATE LRRow, ULCol: PRINT "ΐ";
    LOCATE LRRow, LRCol: PRINT "Ω";
  ELSE
    LOCATE ULRow, ULCol: PRINT "Ι";
    LOCATE ULRow, LRCol: PRINT "»";
    LOCATE LRRow, ULCol: PRINT "Θ";
    LOCATE LRRow, LRCol: PRINT "Ό";
  END IF

END SUB

SUB DrawScreen STATIC

  SHARED MainFG, MainBG, Bar$
 
  '---- Draw the title screen and surrounding boxes.
  '
  COLOR MainFG, MainBG: CLS : LOCATE , , 0
  CALL DrawBox(One, One, 24, 80, 2)
  LOCATE 2, 24: PRINT "PC Magazine's PC-SETUP Version 1.00"
  LOCATE 3, 1: PRINT Bar$
 
  CALL DrawBox(3, 27, 24, 43, One)
  LOCATE 3, 27:  PRINT "ΡΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΡ";
  LOCATE 24, 27: PRINT "ΟΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΟ";
 
  LOCATE 4, 3: PRINT "Destination Directories";
  LOCATE , 31: PRINT "ZIP Files";
  LOCATE , 58: PRINT "Comments"

  LOCATE 25, 2
  PRINT "Up/Down/Space: Select files    Tab: Edit destination    F2: Begin    Esc: Quit";
 
END SUB

SUB EarlyEnd STATIC

  IF Prompt%(One) THEN
    COLOR 7, 0
    CLS
    LOCATE 24, , 1
    END
  END IF
  LOCATE , , 0

END SUB

SUB Editor (Text$, Row, LeftCol, Length, KeyCode) STATIC

  SHARED HiFG, HiBG, NormFG, NormBG, MonoMon, CsrSize

  '----- Work with a temporary copy.
  Edit$ = SPACE$(Length)
  LSET Edit$ = Text$

  '----- See where to begin editing and print the string.
  TxtPos = 1
  LOCATE Row, LeftCol, 1, CsrSize - 1, CsrSize
  COLOR HiFG, HiBG
  PRINT Edit$;

  '----- This is the main loop for handling key presses.
  DO
     LOCATE , LeftCol + TxtPos - 1, 1

     DO
       Ky$ = UCASE$(INKEY$)
     LOOP UNTIL LEN(Ky$)        'wait for a keypress

     IF LEN(Ky$) = 1 THEN       'create a key code
       KeyCode = ASC(Ky$)       'regular character key
     ELSE                       'extended key
       KeyCode = -ASC(RIGHT$(Ky$, 1))
     END IF

     '----- Branch according to the key pressed.
     SELECT CASE KeyCode

       '----- Backspace: decrement the pointer and the
       '      cursor, and ignore if in the first column.
       CASE 8
         TxtPos = TxtPos - 1
         IF TxtPos < 1 THEN TxtPos = 1
         LOCATE , LeftCol + TxtPos - 1, 0
         IF TxtPos > 0 THEN
           IF InsStatus THEN
             MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
           ELSE
             MID$(Edit$, TxtPos) = " "
           END IF
           PRINT MID$(Edit$, TxtPos);
         END IF

       '----- Enter or Escape: this block is optional in
       '      case you want to handle these separately.
       CASE 13, 27
         EXIT DO                'exit the subprogram

       '----- Letter keys: turn off the cursor to hide
       '      the printing, handle Insert mode as needed.
       CASE 32 TO 254
         LOCATE , , 0
         IF InsStatus THEN      'expand the string
           MID$(Edit$, TxtPos) = Ky$ + MID$(Edit$, TxtPos)
           PRINT MID$(Edit$, TxtPos);
         ELSE                   'else insert character
           MID$(Edit$, TxtPos) = Ky$
           PRINT Ky$;
         END IF
         TxtPos = TxtPos + 1    'update position counter
         IF TxtPos > Length THEN TxtPos = Length

       '----- Left arrow: decrement the position counter.
       CASE -75
         TxtPos = TxtPos - 1
         IF TxtPos < 1 THEN TxtPos = 1

       '----- Right arrow: increment position counter.
       CASE -77
         TxtPos = TxtPos + 1
         IF TxtPos > Length THEN TxtPos = Length

       '----- Home: jump to the first character position.
       CASE -71
         TxtPos = 1

       '----- End: search for the last non-blank, and
       '      make that the current editing position.
       CASE -79
         FOR N = Length TO 1 STEP -1
           IF MID$(Edit$, N, 1) <> " " THEN EXIT FOR
         NEXT
         TxtPos = N + 1
         IF TxtPos > Length THEN TxtPos = Length

       '----- Insert key: toggle the Insert state and
       '      adjust the cursor size.
       CASE -82
         InsStatus = NOT InsStatus
         IF InsStatus THEN
           LOCATE , , , CsrSize \ 2, CsrSize
         ELSE
           LOCATE , , , CsrSize - 1, CsrSize
         END IF

       '----- Delete: delete the current character and
       '      reprint what remains in the string.
       CASE -83
         MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
         LOCATE , , 0
         PRINT MID$(Edit$, TxtPos);

       '---- All other keys: exit the subprogram
       CASE ELSE
         EXIT DO
     END SELECT

  '----- Loop until the cursor moves out of the field.
  LOOP

  LSET Edit$ = LTRIM$(Edit$)    'trim and reprint the text in the normal
  LOCATE , 2                    ' color before returning
  COLOR NormFG, NormBG
  PRINT Edit$

  Text$ = RTRIM$(Edit$)         'now trim what's on the right too
 
END SUB

SUB ErrorEnd (Message$) STATIC

  COLOR 7, 0
  CLS
  LOCATE 13, 34 - LEN(Message$) \ 2, 1
  PRINT "Error: "; Message$; ", ending."
  END

END SUB

FUNCTION Execute% (Program$, Parameter$) STATIC
 
  '---- Prepare the program name and parameter strings for processing.  DOS
  '     requires that the parameter string hold the length of the parameter
  '     text, followed by the parameter text, and then followed by a CHR$(13)
  '     Enter byte.  The parameter block holds two CHR$(0) bytes followed by
  '     the address and segment of the parameter string.
  '
  DIM Block AS STRING * 14         'this is the DOS parameter block
  DIM Parm AS STRING * 50          'and this is the actual parameter text
 
  ZBuffer$ = Program$ + Zero$      'make an ASCIIZ string for DOS
 
  LSET Parm$ = CHR$(LEN(Parameter$)) + Parameter$ + CHR$(13)
  LSET Block$ = Zero$ + Zero$ + MKI$(VARPTR(Parm$)) + MKI$(VARSEG(Parm$))

  Dummy& = SETMEM(-500000)         'free up memory for PKUNZIP to run

  Regs.AX = &H4B00                 'DOS load/execute function
  Regs.DX = VARPTR(ZBuffer$)       'offset of program name into DX
  Regs.ES = VARSEG(Block$)         'segment of parameter block into ES
  Regs.BX = VARPTR(Block$)         'offset of parameter block into BX
  Regs.DS = -1                     'set DS to BASIC's segment
  CALL InterruptX(DOS, Regs, Regs) 'execute it as subordinate process
 'CALL InterruptX(DOS, Regs)       'use this with P.D.Q.

  IF Regs.Flags AND 1 THEN         'DOS had an error trying to run PKUNZIP
    Execute% = -Regs.AX            'set function value to exit code
    EXIT FUNCTION
  END IF

  Regs.AX = &H4D00                 'retrieve subordinate process code
  CALL Interrupt(DOS, Regs, Regs)
 'CALL Interrupt(DOS, Regs)        'use this with P.D.Q.
  Execute% = Regs.AX               'set function value to exit code

  Dummy& = SETMEM(500000)          'reclaim the memory reliquished eariler

END FUNCTION

FUNCTION ExeName$ STATIC

  'Returns the name of the currently running program; requires DOS 3.0 +

  '---- DOS Interrupt &H21 service &H62 returns the PSP segment in BX
  Regs.AX = &H6200
  CALL Interrupt(DOS, Regs, Regs)
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.

  '---- The environment segment is at address &H2C/&H2D in PSP segment
  DEF SEG = Regs.BX
  DEF SEG = PEEK(&H2C) + PEEK(&H2D) * 256

  '---- Search the environment segment for two zero bytes in a row.  A count
  '     word (which we skip over) follows that, and the program name follows
  '     the count word.
  Byte = 0
  DO
    IF PEEK(Byte) = 0 THEN              'this is zero
      IF PEEK(Byte + 1) = 0 THEN        'this is too
        Byte = Byte + 2                 'so skip both
        EXIT DO                         'all done
      END IF
    END IF                              'else,
    Byte = Byte + 1                     'keep looking
  LOOP

  IF PEEK(Byte) = 1 THEN                'if this count byte = 1
    Byte = Byte + 2                     'the name follows
    DO WHILE PEEK(Byte)                 'up to another zero
      Tmp$ = Tmp$ + CHR$(PEEK(Byte))    'this is a different Tmp$ on purpose
      Byte = Byte + 1
    LOOP
    ExeName$ = Tmp$                     'assign the function output
  END IF

END FUNCTION

FUNCTION FileCount% (FileSpec$, DirFlag)
 
  Regs.DX = VARPTR(DTA)                 'set new DTA address
  Regs.AX = &H1A00                      'specify service 1Ah
  CALL Interrupt(DOS, Regs, Regs)       'DOS set DTA service
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.

  Temp = 0                              'clear the counter
  ZBuffer$ = FileSpec$ + Zero$          'make an ASCIIZ string

  Regs.DX = VARPTR(ZBuffer$)            'the file spec address
  Regs.CX = 39                          'file attribute = all files
  IF DirFlag THEN Regs.CX = 39 OR 16    'include directories too
  Regs.AX = &H4E00                      'find first matching name service

  DO
    CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
   'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
    IF Regs.Flags AND 1 THEN EXIT DO    'no more files

    IF DirFlag THEN                     'do we want directories?
      IF ASC(DTA.Attribute) AND 16 THEN 'yes, but is this a directory?
        IF ASC(DTA.FileName) <> 46 THEN 'filter "." and ".." (46 = period)
          Temp = Temp + 1               'we got another directory name
        END IF
      END IF
    ELSE
      Temp = Temp + 1                   'we got another file name
    END IF
     
    Regs.AX = &H4F00                    'find next name service
  LOOP

  FileCount% = Temp                     'assign the function output
 
END FUNCTION

FUNCTION GetComment$ (Zip$) STATIC      'read comment from file named in Zip$

  ZipID$ = "PK" + CHR$(5) + CHR$(6)     'this identifies a file as a ZIP file
 
  OPEN RTRIM$(Zip$) FOR BINARY AS #1    'open the .ZIP file
  FileSize& = LOF(1)                    'get and save its length
  BufferSize = 3072                     'the default header size
  IF BufferSize > FileSize& THEN BufferSize = FileSize&
  Temp$ = SPACE$(BufferSize)            'make buffer to receive ZIP header

  GET #1, FileSize& - BufferSize + 1, Temp$
  CLOSE

  Temp = 0                              'find the last occurrence of PK ID
  DO
     HeaderOffset = Temp                'remember where this one is
     Temp = INSTR(Temp + 1, Temp$, ZipID$)      'find the next one
  LOOP WHILE Temp                               'until no more

  IF HeaderOffset THEN                  'if there's a comment, extract it
    CommentLen = CVI(MID$(Temp$, HeaderOffset + 20, 2))
    GetComment$ = MID$(Temp$, HeaderOffset + 22, CommentLen)
  END IF

  Temp$ = ""                            'free up the memory

END FUNCTION

FUNCTION GetDir$ STATIC
 
  Regs.AX = &H4700                      'DOS get directory service
  Regs.DX = 0                           'the drive goes in DL, 0 = default
  Regs.SI = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ is
  CALL Interrupt(DOS, Regs, Regs)       'call DOS
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
 
  IF Regs.Flags AND 1 THEN              'must be an invalid drive
    GetDir$ = ""
  ELSE
    Temp = INSTR(ZBuffer$, Zero$)       'find the zero byte, and return only
    GetDir$ = "\" + LEFT$(ZBuffer$, Temp - 1) ' what precedes it
  END IF

END FUNCTION

FUNCTION GetDrive% STATIC
 
  Regs.AX = &H1900                      'DOS Get Current Drive service
  CALL Interrupt(DOS, Regs, Regs)       'call DOS
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
  GetDrive% = (Regs.AX AND 255) + 65    'drive returned in AL as 0=A, 1=B...

END FUNCTION

FUNCTION IntVal% (Work$) STATIC

 'IntVal is an integer-only VAL substitute that reduces .EXE size up to 10K

  Length = LEN(RTRIM$(Work$))
  Value = 0

  FOR X = Length TO 1 STEP -1
    Temp = MidChar%(Work$, X)
    IF Temp > 47 AND Temp < 58 THEN
      IF X = Length THEN
        Value = Temp - 48
      ELSE
        Value = Value + (Temp - 48) * 10
      END IF
    END IF
  NEXT
 
  IntVal% = Value

END FUNCTION

FUNCTION MakeDir% (DirName$) STATIC

  ZBuffer$ = DirName$ + Zero$           'make an ASCIIZ string
  Regs.AX = &H3900                      'DOS create directory service
  Regs.DX = VARPTR(ZBuffer$)            'show DOS where ZBuffer$ is
  CALL Interrupt(DOS, Regs, Regs)       'call DOS
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.

  IF Regs.Flags AND 1 THEN              'must be an invalid drive or bad name
    MakeDir% = -1                       'return -1 as an error
  END IF

END FUNCTION

FUNCTION MidChar% (Work$, Position)

  IF Position <= LEN(Work$) THEN
    MidChar% = ASC(MID$(Work$, Position, 1))
  ELSE
    MidChar% = -1
  END IF

END FUNCTION

SUB MidCharS (Work$, Position, NewChar) STATIC

  MID$(Work$, Position, 1) = CHR$(NewChar)

END SUB

FUNCTION Prompt% (Which) STATIC

  SHARED HiFG, HiBG, MonoMon, CsrSize, DestPath$

  DEF SEG = &HB800                      'assume a color display
  IF MonoMon THEN DEF SEG = &HB000      'nope, use the mono video segment

  REDIM SaveScrn(10 TO 13, 14 TO 66)    'this saves the underlying screen
  FOR Row = 10 TO 13                    'Here, Row and Col are zero-based
    FOR Col = 14 TO 66
      Temp = Row * 160 + Col * 2        'calculate the address just once
      SaveScrn(Row, Col) = PEEK(Temp) + 256 * PEEK(Temp + 1)
    NEXT
  NEXT

  COLOR HiFG, HiBG
  CALL DrawBox(11, 15, 14, 67, One)     'draw the surrounding box
  IF Which THEN                         'we were called from EarlyEnd
    LOCATE 12, 31                       'show this directory name
    PRINT "Are you sure you want";      'print the prompt message
    LOCATE 13, 29, 1, CsrSize - 1, CsrSize
    PRINT "to quit installing? (Y/N) ";
  ELSE                                  'prompt if okay to overwrite files
    LOCATE 12, 17                       'show this directory name
    PRINT "Installing to "; DestPath$   'print the prompt message
    LOCATE 13, 17, 1, CsrSize - 1, CsrSize
    PRINT "Prompt before overwriting existing files? (Y/N) ";
  END IF
  DO                                    'wait for Yes or No (only)
    Temp$ = UCASE$(INKEY$)
  LOOP UNTIL INSTR(" YN", Temp$) > 1
  Prompt% = 0                           'assume the answer is No
  IF Temp$ = "Y" THEN Prompt% = -1      'they answered Yes

  FOR Row = 10 TO 13                    'now restore the screen
    FOR Col = 14 TO 66                  'as above
      Temp = Row * 160 + Col * 2
      POKE Temp, SaveScrn(Row, Col) AND 255
      POKE Temp + 1, SaveScrn(Row, Col) \ 256
    NEXT
  NEXT

  ERASE SaveScrn
  LOCATE 2                              'put cursor at the top of the screen

END FUNCTION

SUB ReadNames (Spec$, Array$()) STATIC  'reads file names into an array

  ZBuffer$ = Spec$ + Zero$              'make an ASCIIZ string of the spec
  CurFile = 0                           'zero out the file counter

  Regs.DX = VARPTR(ZBuffer$)            'the file spec address
  Regs.CX = 39                          'file attribute = all files
  Regs.AX = &H4E00                      'find first matching name service

  DO
    CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
   'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
    IF Regs.Flags AND 1 THEN EXIT DO    'no more files

    CurFile = CurFile + 1               'we found another file name
    Array$(CurFile) = SPACE$(12)        'create the string to hold it
    Temp$ = DTA.FileName                'assign the name
    Temp = INSTR(Temp$, Zero$)          'find the terminating zero byte
    LSET Array$(CurFile) = LEFT$(Temp$, Temp - 1) 'keep only what precedes it

    Regs.AX = &H4F00                    'find the next name
  LOOP

END SUB

SUB SelectFiles (FileNames$(), Choice, ExitCode) STATIC

  SHARED NumFiles, NormFG, NormBG, HiFG, HiBG, MainFG, MainBG

  IF ExitCode = -60 THEN EXIT SUB       'we got here via F2 pressed in Editor

  COLOR MainFG, MainBG                  'first display all of the choices
  LOCATE 25, 2                          'and update the status line
  PRINT "Up/Down/Space: Select files    Tab: Edit destination    F2: Begin    Esc: Quit";

  COLOR NormFG, NormBG
  FOR Temp = 1 TO NumFiles
    LOCATE 4 + Temp, 28, 0              'and turn off the cursor
    PRINT FileNames$(Temp);
  NEXT

  IF Choice = 0 THEN Choice = 1         'start at element 1 if first time
  IF Choice > UBOUND(FileNames$) THEN Choice = 1 'or if past the end

  DO
    LOCATE 4 + Choice, 28               'redraw current choice highlighted
    COLOR HiFG, HiBG
    PRINT FileNames$(Choice);
    DO
      KeyHit$ = INKEY$                  'see what they want to do
    LOOP UNTIL LEN(KeyHit$)             'wait for a keypress
   
    IF LEN(KeyHit$) = 1 THEN            'set ExitCode based on the type of
      ExitCode = ASC(KeyHit$)            'key (extended or not) they pressed
    ELSE
      ExitCode = -ASC(MID$(KeyHit$, 2))
    END IF
   
    IF ExitCode = 32 THEN               'spacebar
      IF MidChar%(FileNames$(Choice), 2) = 251 THEN 'if it's now checked
        Temp = 32                       'remove the check mark
      ELSE
        Temp = 251                       'else add a check mark
      END IF
      CALL MidCharS(FileNames$(Choice), 2, Temp)
      ExitCode = -80                    'select the next file automatically
    END IF

    SELECT CASE ExitCode
      CASE -80                          'Down Arrow
        GOSUB Deselect
        Choice = Choice + 1
        IF Choice > NumFiles THEN Choice = 1
      CASE -79                          'End key
        GOSUB Deselect
        Choice = NumFiles
      CASE -72                          'Up Arrow
        GOSUB Deselect
        Choice = Choice - 1
        IF Choice = 0 THEN Choice = NumFiles
      CASE -71                          'Home
        GOSUB Deselect
        Choice = 1
      CASE -60                          'F2
        EXIT SUB
      CASE 27                           'Escape
        EXIT SUB
      CASE 9                            'Tab
        LOCATE Choice + 4, 33
        GOSUB Deselect
        EXIT SUB
      CASE ELSE                         'this is needed for QB 4.0 only
    END SELECT
  LOOP

Deselect:                               're-paint the current choice, so it
  LOCATE Choice + 4, 28                 '  won't appear active
  COLOR NormFG, NormBG
  PRINT FileNames$(Choice);
  RETURN

END SUB

SUB SetDrive (Drive$) STATIC
   
  Regs.AX = &HE00                       'DOS Set Drive service in AH
  Regs.DX = ASC(UCASE$(Drive$)) - 65    'DL = 0 for A:, 1 for B:, and so on

  CALL Interrupt(DOS, Regs, Regs)       'see if there's a match
 'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.

END SUB

FUNCTION SourceDir$ STATIC

  Temp$ = ExeName$                  'get the directory we're running from

  FOR X = LEN(Temp$) TO 1 STEP -1   'isolate the drive letter and path
    Temp = MidChar%(Temp$, X)       '  (strip off the name PC-SETUP.EXE)
    IF Temp = 58 OR Temp = 92 THEN  'look for a colon or a backslash
      SourceDir$ = LEFT$(Temp$, X)  'by searching for ":" or "\" this will
      EXIT FOR                      ' work even if the program is renamed
    END IF
  NEXT

END FUNCTION

SUB StuffBuf (Cmd$) STATIC
       
  '----- Set the segment for poking, define the buffer head and tail, and
  '      then poke each character into the keyboard buffer.
 
  Temp = LEN(Cmd$)

  DEF SEG = 0
  POKE &H41A, &H1E
  POKE &H41C, &H1E + Temp * 2
   
  FOR X = 1 TO Temp
    POKE &H41C + X * 2, ASC(MID$(Cmd$, X))
  NEXT

END SUB