home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / SLINK10.ZIP / SLINK.BAS next >
Encoding:
BASIC Source File  |  1989-05-21  |  10.6 KB  |  352 lines
  1. ' SLINK  Copyright (c) 1989  Thomas G. Hanlin III
  2. ' Smart LINK shell, version 1.0, 5/21/89
  3.  
  4. DECLARE FUNCTION Min% (x%, y%)
  5.  
  6. DECLARE SUB CatchError ()
  7. DECLARE SUB DelFile (file$, errcode%)
  8. DECLARE SUB DFRead (handle%, dseg%, dofs%, bytes%, bytesread%, errcode%)
  9. DECLARE SUB DFWrite (handle%, dseg%, dofs%, bytes%, byteswrit%, errcode%)
  10. DECLARE SUB DMPrint (st$)
  11. DECLARE SUB ExtendFSpec (file$, ext$, fullfile$, errcode%)
  12. DECLARE SUB FClose (handle%)
  13. DECLARE SUB FCreate (file$, attr%, handle%, errcode%)
  14. DECLARE SUB FindFirstF (file$, attr%, errcode%)
  15. DECLARE SUB FindNextF (errcode%)
  16. DECLARE SUB FOpen (file$, readwrite%, sharing%, handle%, errcode%)
  17. DECLARE SUB FSetLoc (handle%, posn&)
  18. DECLARE SUB FSize (handle%, bytes&)
  19. DECLARE SUB GetError (errorlevel%)
  20. DECLARE SUB GetNameF (file$, flen%)
  21. DECLARE SUB GetSizeFL (bytes&)
  22. DECLARE SUB ParseFSpec (path$, drv$, dlen%, subdir$, slen%, file$, flen%)
  23. DECLARE SUB Rename (oldfile$, newfile$, errcode%)
  24. DECLARE SUB RInstr (st$, seekst$, posn%)
  25. DECLARE SUB SetError (errorlevel%)
  26.  
  27.    CONST buffersize& = 8192&
  28.  
  29.    TYPE exehdr
  30.       signature AS STRING * 2
  31.       lastpagesize AS INTEGER
  32.       filepages AS INTEGER
  33.       reloccount AS INTEGER
  34.       headersize AS INTEGER
  35.       minalloc AS INTEGER
  36.       maxalloc AS INTEGER
  37.       ss AS INTEGER
  38.       sp AS INTEGER
  39.       checksum AS INTEGER
  40.       ip AS INTEGER
  41.       cs AS INTEGER
  42.       relocptr AS INTEGER
  43.       overlay AS INTEGER
  44.    END TYPE
  45.  
  46.    DEFINT A-Z
  47.  
  48.    DIM exeheader AS exehdr
  49.  
  50.    crlf$ = CHR$(13) + CHR$(10)
  51.  
  52.    DMPrint "SLINK 1.0  Copyright (c) 1989  Thomas G. Hanlin III" + crlf$
  53.    DMPrint crlf$
  54.  
  55.    cmd$ = UCASE$(LTRIM$(RTRIM$(COMMAND$)))
  56.    IF LEN(cmd$) = 0 THEN
  57.       DMPrint "This is an enhancement shell for the Microsoft LINK utility.  It automatically" + crlf$
  58.       DMPrint "LINKs your file.  The resulting .EXE file will be converted to .COM or .SYS" + crlf$
  59.       DMPrint "format if it is appropriate to do so.  Otherwise, the program will be" + crlf$
  60.       DMPrint "linked again using the /EXEPACK option and the smaller of the two .EXE files" + crlf$
  61.       DMPrint "will be kept." + crlf$
  62.       DMPrint crlf$
  63.       DMPrint "Syntax:" + crlf$
  64.       DMPrint "   SLINK filename[link parameters]" + crlf$
  65.       DMPrint crlf$
  66.       DMPrint "Wildcards may be used in the filename specification." + crlf$
  67.       DMPrint crlf$
  68.       DMPrint "SLINK may be distributed as long as no fee of over $6.00 is charged and all" + crlf$
  69.       DMPrint "files (SLINK.BAS, SLINK.DOC, SLINK.EXE) are included without modification." + crlf$
  70.       DMPrint crlf$
  71.       SetError 0
  72.       END
  73.    END IF
  74.  
  75.    tmp = INSTR(cmd$, ",")
  76.    IF tmp THEN
  77.       runfile$ = mid$(cmd$, tmp + 1)
  78.       tmp = INSTR(runfile$, ",")
  79.       IF tmp THEN
  80.          runfile$ = LEFT$(runfile$, tmp - 1)
  81.       ELSE
  82.          tmp = INSTR(cmd$, ";")
  83.          IF tmp THEN runfile$ = LEFT$(runfile$, tmp - 1)
  84.       END IF
  85.       tmp = INSTR(runfile$, "/")
  86.       IF tmp THEN runfile$ = LEFT$(runfile$, tmp - 1)
  87.       IF LEN(runfile$) THEN
  88.          ExtendFSpec runfile$, ".EXE", path$, errcode
  89.          IF errcode THEN
  90.             DMPrint "*** Error: invalid run file [" + runfile$ + "]" + crlf$
  91.             SetError 3
  92.             END
  93.          ELSE
  94.             runfile$ = path$
  95.          END IF
  96.       END IF
  97.    ELSE
  98.       runfile$ = ""
  99.    END IF
  100.  
  101.  
  102.    t1 = INSTR(cmd$, ","): IF t1 = 0 THEN t1 = LEN(cmd$) + 1
  103.    t2 = INSTR(cmd$, ";"): IF t2 = 0 THEN cmd$ = cmd$ + ";": t2 = LEN(cmd$) + 1
  104.    t3 = INSTR(cmd$, "+"): IF t3 = 0 THEN t3 = LEN(cmd$) + 1
  105.    t4 = INSTR(cmd$, "/"): IF t4 = 0 THEN t4 = LEN(cmd$) + 1
  106.    t5 = INSTR(cmd$, " "): IF t5 = 0 THEN t5 = LEN(cmd$) + 1
  107.    tmp = Min(Min(Min(Min(t1, t2), t3), t4), t5)
  108.    filename$ = LEFT$(cmd$, tmp - 1)
  109.    filetail$ = LTRIM$(MID$(cmd$, tmp))
  110.    IF INSTR(filetail$, "/E") THEN exepacked = -1
  111.    ExtendFSpec filename$, ".OBJ", path$, errcode
  112.    IF errcode THEN
  113.       DMPrint "*** Error: invalid "
  114.       SELECT CASE errcode
  115.          CASE -1: DMPrint "file"
  116.          CASE 1: DMPrint "drive"
  117.          CASE 2: DMPrint "subdirectory"
  118.       END SELECT
  119.       DMPrint " [" + filename$ + "]" + crlf$
  120.       SetError 1
  121.       END
  122.    END IF
  123.    drv$ = " ": subdir$ = SPACE$(64): file$ = SPACE$(12)
  124.    ParseFSpec path$, drv$, dlen, subdir$, slen, file$, flen
  125.    locus$ = drv$ + ":" + LEFT$(subdir$, slen)
  126.    IF RIGHT$(locus$, 1) <> "\" THEN locus$ = locus$ + "\"
  127.    file$ = LEFT$(file$, flen)
  128.  
  129.    FindFirstF path$, 0, errcode
  130.    IF errcode THEN
  131.       DMPrint "*** Error: file not found [" + path$ + "]" + crlf$
  132.    END IF
  133.    DO WHILE errcode = 0
  134.       infile$ = SPACE$(12)
  135.       GetNameF infile$, flen
  136.       infile$ = locus$ + LEFT$(infile$, flen)
  137.       IF LEN(runfile$) THEN
  138.          midfile$ = runfile$
  139.       ELSE
  140.          RInstr infile$, ".", tmp
  141.          midfile$ = LEFT$(infile$, tmp) + "EXE"
  142.       END IF
  143.       CatchError
  144.       SHELL "LINK " + infile$ + filetail$ + " >NUL"
  145.       GetError errorlevel
  146.       IF errorlevel THEN
  147.          DelFile midfile$, errcode
  148.          DMPrint "*** Error: LINK failed on " + infile$ + filetail$ + crlf$
  149.       ELSE
  150.          IF RIGHT$(midfile$, 3) = "EXE" AND NOT exepacked THEN
  151.             GetSizeFL bytes&
  152.             IF bytes& < 99999 THEN
  153.                GOSUB TryConvert        ' see if it should be .COM or .SYS
  154.             END IF
  155.             IF NOT convertfile THEN
  156.                GOSUB ExePack           ' see if it can be profitably EXEPACKed
  157.             END IF
  158.          ELSE
  159.             DelFile infile$, errcode
  160.             DMPrint infile$ + " --> " + midfile$
  161.             IF exepacked THEN DMPrint " (EXEPACKed)"
  162.             DMPrint crlf$
  163.          END IF
  164.       END IF
  165.       FindNextF errcode
  166.    LOOP
  167.    SetError 0
  168.    END
  169.  
  170.  
  171.  
  172. ' ----------------- subroutine to try to convert .EXE to .COM or .SYS ---------
  173.  
  174. TryConvert:
  175.    errorflag = 0
  176.    FOpen midfile$, 0, 0, inhandle, errcode
  177.    IF errcode THEN
  178.       errorflag = 1
  179.    ELSE
  180.       dseg = VARSEG(exeheader)
  181.       dofs = VARPTR(exeheader)
  182.       DFRead inhandle, dseg, dofs, 28, bytesread, errcode
  183.       IF errcode THEN
  184.          FClose inhandle
  185.          errorflag = 1
  186.       END IF
  187.    END IF
  188.  
  189.    IF errorflag = 0 THEN
  190.       IF exeheader.signature <> "MZ" THEN
  191.          FClose inhandle
  192.          errorflag = 2
  193.       END IF
  194.    END IF
  195.  
  196.    IF errorflag = 0 THEN
  197.       errcode = (exeheader.reloccount <> 0) OR (exeheader.cs <> 0)
  198.       errcode = errcode OR (exeheader.ss <> 0) OR (exeheader.sp <> 0)
  199.       IF errcode THEN
  200.          FClose inhandle
  201.          errorflag = -1
  202.       END IF
  203.    END IF
  204.    IF errorflag = 0 THEN
  205.       SELECT CASE exeheader.ip
  206.          CASE 0
  207.             ext$ = "SYS"
  208.          CASE &H100
  209.             ext$ = "COM"
  210.          CASE ELSE
  211.             FClose inhandle
  212.             errorflag = -1
  213.       END SELECT
  214.       IF errorflag = 0 THEN
  215.          RInstr midfile$, ".", tmp
  216.          outfile$ = LEFT$(midfile$, tmp) + ext$
  217.       END IF
  218.    END IF
  219.  
  220.    IF errorflag = 0 THEN
  221.       codeptr& = CLNG(exeheader.headersize) * 16&
  222.       codesize& = CLNG(exeheader.filepages) * 512& - codeptr& - CLNG(exeheader.ip)
  223.       IF exeheader.lastpagesize THEN
  224.          codesize& = codesize& - 512& + CLNG(exeheader.lastpagesize)
  225.       END IF
  226.       codeptr& = codeptr& + CLNG(exeheader.ip) + 1&
  227.       FSetLoc inhandle, codeptr&
  228.       IF codesize& < 1& OR codesize& > 65530 THEN
  229.          FClose inhandle
  230.          errorflag = -1
  231.       END IF
  232.    END IF
  233.  
  234.    IF errorflag = 0 THEN
  235.       FCreate outfile$, 0, outhandle, errcode
  236.       IF errcode THEN
  237.          FClose inhandle
  238.          errorflag = 3
  239.       END IF
  240.    END IF
  241.  
  242.    IF errorflag THEN
  243.       convertfile = 0
  244.    ELSE
  245.       convertfile = -1
  246.       REDIM buffer(1 TO CINT(buffersize/2+.1))
  247.       bytes = buffersize
  248.       DO
  249.          IF codesize& <= buffersize THEN
  250.             bytes = CINT(codesize&)
  251.             codesize& = 0&
  252.          ELSE
  253.             codesize& = codesize& - buffersize
  254.          END IF
  255.          dseg = VARSEG(buffer(1))
  256.          dofs = VARPTR(buffer(1))
  257.          DFRead inhandle, dseg, dofs, bytes, bytesread, errcode
  258.          IF errcode THEN
  259.             errorflag = 1
  260.          ELSE
  261.             DFWrite outhandle, dseg, dofs, bytes, bytesread, errcode
  262.             IF errcode THEN errorflag = 3
  263.          END IF
  264.       LOOP WHILE codesize& > 0& AND errorflag = 0
  265.       FClose inhandle
  266.       FClose outhandle
  267.       ERASE buffer
  268.    END IF
  269.  
  270.    IF errorflag THEN
  271.       IF convertfile THEN
  272.          DelFile outfile$, errcode
  273.          convertfile = 0
  274.       END IF
  275.       SELECT CASE errorflag
  276.          CASE -1
  277.             REM  the .EXE file was not suitable for .COM or .SYS conversion
  278.          CASE 1
  279.             DMPrint "*** Error: unable to read file [" + midfile$ + "]" + crlf$
  280.          CASE 2
  281.             DMPrint "*** Error: invalid .EXE file [" + midfile$ + "]" + crlf$
  282.          CASE 3
  283.             DMPrint "*** Error: unable to create file [" + outfile$ + "]"
  284.             DMPrint crlf$
  285.       END SELECT
  286.    ELSE
  287.       DelFile infile$, errcode
  288.       DelFile midfile$, errcode
  289.       DMPrint infile$ + " --> " + outfile$ + crlf$
  290.    END IF
  291.    RETURN
  292.  
  293.  
  294.  
  295. ' ------------- subroutine to try /EXEPACK ------------------------------------
  296.  
  297. ExePack:
  298.    IF LEN(runfile$) THEN
  299.       midfile$ = runfile$
  300.    ELSE
  301.       RInstr infile$, ".", tmp
  302.       midfile$ = LEFT$(infile$, tmp) + "EXE"
  303.    END IF
  304.    IF RIGHT$(midfile$, 3) = "EXE" THEN
  305.       RInstr midfile$, ".", tmp
  306.       bakfile$ = LEFT$(midfile$, tmp) + "$SL"
  307.       Rename midfile$, bakfile$, errcode
  308.       CatchError
  309.       SHELL "LINK " + infile$ + "/EXEPACK" + filetail$ + " >NUL"
  310.       GetError errorlevel
  311.       IF errorlevel THEN
  312.          DMPrint "*** Error: LINK failed on " + infile$ + "/EXEPACK"
  313.          DMPrint filetail$ + crlf$
  314.       ELSE
  315.          FOpen bakfile$, 0, 0, handle, errcode
  316.          FSize handle, baksize&
  317.          FClose handle
  318.          FOpen midfile$, 0, 0, handle, errcode
  319.          FSize handle, midsize&
  320.          FClose handle
  321.          IF midsize& > baksize& THEN
  322.             DelFile infile$, errcode
  323.             DelFile midfile$, errcode
  324.             Rename bakfile$, midfile$, errcode
  325.             DMPrint infile$ + " --> " + midfile$ + crlf$
  326.          ELSE
  327.             DelFile bakfile$, errcode
  328.             DelFile infile$, errcode
  329.             DMPrint infile$ + " --> " + midfile$ + " (EXEPACKed)"+ crlf$
  330.          END IF
  331.       END IF
  332.    ELSE
  333.       DelFile infile$, errcode
  334.       DMPrint infile$ + " --> " + midfile$ + crlf$
  335.    END IF
  336.    RETURN
  337.  
  338.  
  339.  
  340. ' ----------------------------- subprograms and functions ---------------------
  341.  
  342.  
  343.  
  344.  
  345. FUNCTION Min (x, y)
  346.    IF x < y THEN
  347.       Min = x
  348.    ELSE
  349.       Min = y
  350.    END IF
  351. END FUNCTION
  352.