home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / PBC22B.ZIP / PBC$BAS.ZIP / ARCHIVES.BAS < prev    next >
BASIC Source File  |  1993-04-15  |  11KB  |  319 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
  8.    DECLARE FUNCTION Exist2% (FileName$)
  9.    DECLARE SUB FGetLoc (BYVAL FileHandle%, Posn&)
  10.    DECLARE SUB FindNextA (ErrCode%)
  11.    DECLARE SUB FOpen1 (FileName$, BYVAL ReadWrite%, BYVAL Sharing%, FileHandle%, ErrCode%)
  12.    DECLARE SUB FSetLoc (BYVAL FileHandle%, Posn&)
  13.    DECLARE SUB GetNameA (FileName$, FileNameLen%)
  14.    DECLARE SUB MatchFile (PatternName$, FileName$, IsMatch%)
  15.    DECLARE SUB ParseFSpec (FileSpec$, Drive$, DLen%, Subdir$, SLen%, File$, FLen%)
  16.    DECLARE SUB SFRead (BYVAL FileHandle%, St$, BytesRead%, ErrCode%)
  17.  
  18.    DECLARE SUB GetArc00 (Handle%, ArcType%, File$, Header$)
  19.    DECLARE SUB SetArc00 (BYVAL Handle%, BYVAL ArcType%, File$, Header$)
  20.  
  21.  
  22.  
  23. SUB FindFirstA (Archive$, FileName$, ErrCode%)
  24.    ErrCode% = 0
  25.    File$ = LEFT$(FileName$, 12)
  26.    Arc$ = UCASE$(Archive$)
  27.  
  28.    IF INSTR(Arc$, ".") = 0 THEN
  29.       IF Exist2%(Arc$ + ".ZIP") THEN
  30.          Arc$ = Arc$ + ".ZIP"
  31.       ELSEIF Exist2%(Arc$ + ".LZH") THEN
  32.          Arc$ = Arc$ + ".LZH"
  33.       ELSEIF Exist2%(Arc$ + ".ARC") THEN
  34.          Arc$ = Arc$ + ".ARC"
  35.       ELSEIF Exist2%(Arc$ + ".PAK") THEN
  36.          Arc$ = Arc$ + ".PAK"
  37.       ELSEIF Exist2%(Arc$ + ".ZOO") THEN
  38.          Arc$ = Arc$ + ".ZOO"
  39.       ELSEIF Exist2%(Arc$ + ".ARJ") THEN
  40.          Arc$ = Arc$ + ".ARJ"
  41.       ELSEIF Exist2%(Arc$ + ".EXE") THEN
  42.          Arc$ = Arc$ + ".EXE"
  43.       ELSEIF Exist2%(Arc$ + ".COM") THEN
  44.          Arc$ = Arc$ + ".COM"
  45.       ELSE
  46.          Arc$ = Arc$ + "."
  47.       END IF
  48.    END IF
  49.  
  50.    SELECT CASE RIGHT$(Arc$, 3)
  51.       CASE "ARC", "PAK"
  52.          ArcType% = 1
  53.       CASE "LZH"
  54.          ArcType% = 2
  55.       CASE "ZIP"
  56.          ArcType% = 3
  57.       CASE "ZOO"
  58.          ArcType% = 4
  59.       CASE "ARJ"
  60.          ArcType% = 5
  61.       CASE "COM", "EXE"
  62.          ArcType% = -1
  63.       CASE ELSE
  64.          ErrCode% = 9999
  65.    END SELECT
  66.  
  67.    Posn& = 1&
  68.  
  69.    IF ErrCode% = 0 THEN FOpen1 Arc$, 0, 2, Handle%, ErrCode%
  70.    IF ErrCode% = 0 AND ArcType% = -1 THEN
  71.       Header$ = "xx"
  72.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  73.       IF ErrCode% = 0 THEN IF Header$ <> "MZ" THEN ErrCode% = 9999
  74.       IF ErrCode% = 0 THEN                       ' check for LHARC .EXE
  75.          FSetLoc Handle%, 1637&
  76.          Header$ = SPACE$(8)
  77.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  78.          IF ErrCode% = 0 THEN
  79.             IF MID$(Header$, 3, 3) = "-lh" THEN
  80.                ArcType% = 2
  81.                FSetLoc Handle%, 1637&
  82.                Posn& = 1637&
  83.             END IF
  84.          END IF
  85.       END IF
  86.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for PKZIP .EXE
  87.          FSetLoc Handle%, 12785&
  88.          Header$ = SPACE$(4)
  89.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  90.          IF ErrCode% = 0 THEN
  91.             IF LEFT$(Header$, 4) = "PK" + CHR$(3) + CHR$(4) THEN
  92.                ArcType% = 3
  93.                FSetLoc Handle%, 12785&
  94.                Posn& = 12785&
  95.             END IF
  96.          END IF
  97.       END IF
  98.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for ARJ .EXE
  99.          FSetLoc Handle%, 14859&
  100.          Header$ = SPACE$(2)
  101.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  102.          IF ErrCode% = 0 THEN
  103.             IF Header$ = CHR$(&H60) + CHR$(&HEA) THEN
  104.                ArcType% = 5
  105.                FSetLoc Handle%, 14859&
  106.                Posn& = 14859&
  107.             END IF
  108.          END IF
  109.       END IF
  110.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' ...not an EXE format we know
  111.          ErrCode% = 9999
  112.       END IF
  113.    END IF
  114.    IF ErrCode% = 0 THEN
  115.       Header$ = SPACE$(128)
  116.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  117.       SetArc00 Handle%, ArcType%, File$, Header$
  118.       SELECT CASE ArcType%
  119.          CASE 1
  120.             IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  121.          CASE 2
  122.             IF MID$(Header$, 3, 1) <> "-" THEN ErrCode% = 9999
  123.          CASE 3
  124.             IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  125.          CASE 4
  126.             IF MID$(Header$, 21, 4) = CHR$(&HDC) + CHR$(&HA7) + CHR$(&HC4) + CHR$(&HFD) THEN
  127.                Posn& = CVL(MID$(Header$, &H19, 4)) + 1&
  128.                FSetLoc Handle%, Posn&
  129.                SFRead Handle%, Header$, BytesRead%, ErrCode%
  130.             ELSE
  131.                ErrCode% = 9999
  132.             END IF
  133.          CASE 5
  134.             IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) THEN ErrCode% = 9999
  135.       END SELECT
  136.       IF ErrCode% < 0 THEN
  137.          IF BytesRead% THEN
  138.             ErrCode% = 0
  139.             Header$ = LEFT$(Header$, BytesRead%)
  140.          END IF
  141.       END IF
  142.       IF ErrCode% = 0 THEN
  143.          SetArc00 Handle%, ArcType%, File$, Header$
  144.          FSetLoc Handle%, Posn&
  145.          CurFile$ = SPACE$(80)
  146.          GetNameA CurFile$, FLen%
  147.          IF FLen% THEN
  148.             FileSpec$ = LEFT$(CurFile$, FLen%)
  149.             Drive$ = " "
  150.             SubDir$ = SPACE$(64)
  151.             CurFile$ = SPACE$(12)
  152.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  153.             Drive$ = LEFT$(Drive$, DLen%)
  154.             SubDir$ = LEFT$(SubDir$, SLen%)
  155.             CurFile$ = LEFT$(CurFile$, FLen%)
  156.             MatchFile File$, CurFile$, Found%
  157.          ELSE
  158.             Found% = 0
  159.          END IF
  160.       END IF
  161.       IF ErrCode% OR NOT Found% THEN
  162.          FindNextA ErrCode%
  163.       END IF
  164.    END IF
  165. END SUB
  166.  
  167.  
  168.  
  169. SUB FindNextA (ErrCode%)
  170.    File$ = SPACE$(12)
  171.    Header$ = SPACE$(128)
  172.    GetArc00 Handle%, ArcType%, File$, Header$
  173.    IF Handle% THEN
  174.       File$ = RTRIM$(File$)
  175.    ELSE
  176.       ErrCode% = -1
  177.    END IF
  178.    DO UNTIL ErrCode% OR Found%
  179.       FGetLoc Handle%, Posn&
  180.       SELECT CASE ArcType%
  181.          CASE 1
  182.             IF AscM%(Header$, 2) = 1 THEN
  183.                Posn& = Posn& + 25&
  184.             ELSE
  185.                Posn& = Posn& + 29&
  186.             END IF
  187.             Posn& = Posn& + CVL(MID$(Header$, 16, 4))
  188.          CASE 2
  189.             Posn& = Posn& + (ASC(Header$) + 2) + CVL(MID$(Header$, 8, 4))
  190.          CASE 3
  191.             Posn& = Posn& + 30& + CVI(MID$(Header$, 27, 2))
  192.             Posn& = Posn& + CVI(MID$(Header$, 29, 2))
  193.             Posn& = Posn& + CVL(MID$(Header$, 19, 4))
  194.          CASE 4
  195.             Posn& = CVL(MID$(Header$, 7, 4)) + 1&
  196.          CASE 5
  197.             Posn& = Posn& + CLNG(CVI(MID$(Header$, 3, 2))) + CVL(MID$(Header$, 17, 4)) + 10&
  198.       END SELECT
  199.       IF ErrCode% = 0 THEN
  200.          FSetLoc Handle%, Posn&
  201.          Header$ = SPACE$(128)
  202.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  203.       END IF
  204.       IF ErrCode% < 0 THEN
  205.          IF BytesRead% THEN
  206.             ErrCode% = 0
  207.             Header$ = LEFT$(Header$, BytesRead%)
  208.          END IF
  209.       END IF
  210.       SELECT CASE ArcType%
  211.          CASE 1: IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  212.          CASE 2: IF MID$(Header$, 3, 1) <> "-" OR LEFT$(Header$, 1) = CHR$(0) THEN ErrCode% = 9999
  213.          CASE 3: IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  214.          CASE 5: IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) OR CVI(MID$(Header$, 3, 2)) = 0 THEN ErrCode% = 9999
  215.       END SELECT
  216.       IF ErrCode% = 0 THEN
  217.          SetArc00 Handle%, ArcType%, File$, Header$
  218.          FSetLoc Handle%, Posn&
  219.          CurFile$ = SPACE$(12)
  220.          GetNameA CurFile$, FLen%
  221.          IF FLen% THEN
  222.             FileSpec$ = LEFT$(CurFile$, FLen%)
  223.             Drive$ = " "
  224.             SubDir$ = SPACE$(64)
  225.             CurFile$ = SPACE$(12)
  226.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  227.             Drive$ = LEFT$(Drive$, DLen%)
  228.             SubDir$ = LEFT$(SubDir$, SLen%)
  229.             CurFile$ = LEFT$(CurFile$, FLen%)
  230.             MatchFile File$, CurFile$, Found%
  231.          ELSE
  232.             Found% = 0
  233.          END IF
  234.       END IF
  235.    LOOP
  236. END SUB
  237.  
  238.  
  239.  
  240. SUB GetNameA (FileName$, FLen%)
  241.    File$ = SPACE$(12)
  242.    Header$ = SPACE$(128)
  243.    GetArc00 Handle%, ArcType%, File$, Header$
  244.    SELECT CASE ArcType%
  245.       CASE 1
  246.          St$ = MID$(Header$, 3, 13)
  247.          FLen% = INSTR(St$, CHR$(0))
  248.          IF FLen% THEN
  249.             FLen% = FLen% - 1
  250.          ELSE
  251.             FLen% = 12
  252.          END IF
  253.          MID$(FileName$, 1, FLen%) = St$
  254.       CASE 2
  255.          FLen% = AscM%(Header$, 22)
  256.          MID$(FileName$, 1) = MID$(Header$, 23, FLen%)
  257.       CASE 3
  258.          FLen% = AscM%(Header$, 27)
  259.          MID$(FileName$, 1) = MID$(Header$, 31, FLen%)
  260.       CASE 4
  261.          IF AscM%(Header$, 31) = 1 THEN
  262.             FLen% = 0
  263.          ELSE
  264.             FLen% = INSTR(MID$(Header$, 39, 13), CHR$(0)) - 1
  265.             MID$(FileName$, 1) = MID$(Header$, 39, FLen%)
  266.          END IF
  267.       CASE 5
  268.          IF AscM%(Header$, 11) > 1 THEN
  269.             FLen% = 0
  270.          ELSE
  271.             St$ = MID$(Header$, 35, 80)
  272.             FLen% = INSTR(St$, CHR$(0))
  273.             IF FLen% THEN FLen% = FLen% - 1
  274.             MID$(FileName$, 1, FLen%) = St$
  275.          END IF
  276.    END SELECT
  277. END SUB
  278.  
  279.  
  280.  
  281. SUB GetStoreA (Storage$)
  282.    File$ = SPACE$(12)
  283.    Storage$ = File$
  284.    Header$ = SPACE$(128)
  285.    GetArc00 Handle%, ArcType%, File$, Header$
  286.    SELECT CASE ArcType%
  287.       CASE 1
  288.          SELECT CASE AscM%(Header$, 2)
  289.             CASE 1, 2: Storage$ = "Stored  "
  290.             CASE 3: Storage$ = "Packed  "
  291.             CASE 4: Storage$ = "Squeezed"
  292.             CASE 5, 6: Storage$ = "crunched"
  293.             CASE 7, 8: Storage$ = "Crunched"
  294.             CASE 9: Storage$ = "Squashed"
  295.             CASE 10: Storage$ = "Crushed "
  296.             CASE 11: Storage$ = "Distill "
  297.             CASE ELSE
  298.          END SELECT
  299.       CASE 2
  300.          Storage$ = LEFT$(MID$(Header$, 3, 5) + SPACE$(8), 8)
  301.       CASE 3
  302.          SELECT CASE AscM%(Header$, 9)
  303.             CASE 0: Storage$ = "Stored  "
  304.             CASE 1: Storage$ = "Shrunk  "
  305.             CASE 2: Storage$ = "Reduce-1"
  306.             CASE 3: Storage$ = "Reduce-2"
  307.             CASE 4: Storage$ = "Reduce-3"
  308.             CASE 5: Storage$ = "Reduce-4"
  309.             CASE 6: Storage$ = "Imploded"
  310.             CASE 8: Storage$ = "Deflated"
  311.             CASE ELSE: Storage$ = SPACE$(8)
  312.          END SELECT
  313.       CASE 4
  314.          Storage$ = SPACE$(8)
  315.       CASE 5
  316.          Storage$ = CHR$(AscM%(Header$, 10) + 48) + SPACE$(7)
  317.    END SELECT
  318. END SUB
  319.