home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / pbclon20 / pbc_bas / archives.bas < prev    next >
Encoding:
BASIC Source File  |  1992-10-18  |  9.5 KB  |  293 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1992  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
  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.             ELSE
  84.                ErrCode% = 9999
  85.             END IF
  86.          END IF
  87.       END IF
  88.    END IF
  89.    IF ErrCode% = 0 THEN
  90.       Header$ = SPACE$(128)
  91.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  92.       SetArc00 Handle%, ArcType%, File$, Header$
  93.       SELECT CASE ArcType%
  94.          CASE 1
  95.             IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  96.          CASE 2
  97.             IF MID$(Header$, 3, 1) <> "-" THEN ErrCode% = 9999
  98.          CASE 3
  99.             IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  100.          CASE 4
  101.             IF MID$(Header$, 21, 4) = CHR$(&HDC) + CHR$(&HA7) + CHR$(&HC4) + CHR$(&HFD) THEN
  102.                Posn& = CVL(MID$(Header$, &H19, 4)) + 1&
  103.                FSetLoc Handle%, Posn&
  104.                SFRead Handle%, Header$, BytesRead%, ErrCode%
  105.             ELSE
  106.                ErrCode% = 9999
  107.             END IF
  108.          CASE 5
  109.             IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) THEN ErrCode% = 9999
  110.       END SELECT
  111.       IF ErrCode% < 0 THEN
  112.          IF BytesRead% THEN
  113.             ErrCode% = 0
  114.             Header$ = LEFT$(Header$, BytesRead%)
  115.          END IF
  116.       END IF
  117.       IF ErrCode% = 0 THEN
  118.          SetArc00 Handle%, ArcType%, File$, Header$
  119.          FSetLoc Handle%, Posn&
  120.          CurFile$ = SPACE$(80)
  121.          GetNameA CurFile$, FLen%
  122.          IF FLen% THEN
  123.             FileSpec$ = LEFT$(CurFile$, FLen%)
  124.             Drive$ = " "
  125.             SubDir$ = SPACE$(64)
  126.             CurFile$ = SPACE$(12)
  127.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  128.             Drive$ = LEFT$(Drive$, DLen%)
  129.             SubDir$ = LEFT$(SubDir$, SLen%)
  130.             CurFile$ = LEFT$(CurFile$, FLen%)
  131.             MatchFile File$, CurFile$, Found%
  132.          ELSE
  133.             Found% = 0
  134.          END IF
  135.       END IF
  136.       IF ErrCode% OR NOT Found% THEN
  137.          FindNextA ErrCode%
  138.       END IF
  139.    END IF
  140. END SUB
  141.  
  142.  
  143.  
  144. SUB FindNextA (ErrCode%)
  145.    File$ = SPACE$(12)
  146.    Header$ = SPACE$(128)
  147.    GetArc00 Handle%, ArcType%, File$, Header$
  148.    IF Handle% THEN
  149.       File$ = RTRIM$(File$)
  150.    ELSE
  151.       ErrCode% = -1
  152.    END IF
  153.    DO UNTIL ErrCode% OR Found%
  154.       FGetLoc Handle%, Posn&
  155.       SELECT CASE ArcType%
  156.          CASE 1
  157.             IF AscM%(Header$, 2) = 1 THEN
  158.                Posn& = Posn& + 25&
  159.             ELSE
  160.                Posn& = Posn& + 29&
  161.             END IF
  162.             Posn& = Posn& + CVL(MID$(Header$, 16, 4))
  163.          CASE 2
  164.             Posn& = Posn& + (ASC(Header$) + 2) + CVL(MID$(Header$, 8, 4))
  165.          CASE 3
  166.             Posn& = Posn& + 30& + CVI(MID$(Header$, 27, 2))
  167.             Posn& = Posn& + CVI(MID$(Header$, 29, 2))
  168.             Posn& = Posn& + CVL(MID$(Header$, 19, 4))
  169.          CASE 4
  170.             Posn& = CVL(MID$(Header$, 7, 4)) + 1&
  171.          CASE 5
  172.             Posn& = Posn& + CLNG(CVI(MID$(Header$, 3, 2))) + CVL(MID$(Header$, 17, 4)) + 10&
  173.       END SELECT
  174.       IF ErrCode% = 0 THEN
  175.          FSetLoc Handle%, Posn&
  176.          Header$ = SPACE$(128)
  177.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  178.       END IF
  179.       IF ErrCode% < 0 THEN
  180.          IF BytesRead% THEN
  181.             ErrCode% = 0
  182.             Header$ = LEFT$(Header$, BytesRead%)
  183.          END IF
  184.       END IF
  185.       SELECT CASE ArcType%
  186.          CASE 1: IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  187.          CASE 2: IF MID$(Header$, 3, 1) <> "-" OR LEFT$(Header$, 1) = CHR$(0) THEN ErrCode% = 9999
  188.          CASE 3: IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  189.          CASE 5: IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) OR CVI(MID$(Header$, 3, 2)) = 0 THEN ErrCode% = 9999
  190.       END SELECT
  191.       IF ErrCode% = 0 THEN
  192.          SetArc00 Handle%, ArcType%, File$, Header$
  193.          FSetLoc Handle%, Posn&
  194.          CurFile$ = SPACE$(12)
  195.          GetNameA CurFile$, FLen%
  196.          IF FLen% THEN
  197.             FileSpec$ = LEFT$(CurFile$, FLen%)
  198.             Drive$ = " "
  199.             SubDir$ = SPACE$(64)
  200.             CurFile$ = SPACE$(12)
  201.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  202.             Drive$ = LEFT$(Drive$, DLen%)
  203.             SubDir$ = LEFT$(SubDir$, SLen%)
  204.             CurFile$ = LEFT$(CurFile$, FLen%)
  205.             MatchFile File$, CurFile$, Found%
  206.          ELSE
  207.             Found% = 0
  208.          END IF
  209.       END IF
  210.    LOOP
  211. END SUB
  212.  
  213.  
  214.  
  215. SUB GetNameA (FileName$, FLen%)
  216.    File$ = SPACE$(12)
  217.    Header$ = SPACE$(128)
  218.    GetArc00 Handle%, ArcType%, File$, Header$
  219.    SELECT CASE ArcType%
  220.       CASE 1
  221.          St$ = MID$(Header$, 3, 13)
  222.          FLen% = INSTR(St$, CHR$(0))
  223.          IF FLen% THEN
  224.             FLen% = FLen% - 1
  225.          ELSE
  226.             FLen% = 12
  227.          END IF
  228.          MID$(FileName$, 1, FLen%) = St$
  229.       CASE 2
  230.          FLen% = AscM%(Header$, 22)
  231.          MID$(FileName$, 1) = MID$(Header$, 23, FLen%)
  232.       CASE 3
  233.          FLen% = AscM%(Header$, 27)
  234.          MID$(FileName$, 1) = MID$(Header$, 31, FLen%)
  235.       CASE 4
  236.          IF AscM%(Header$, 31) = 1 THEN
  237.             FLen% = 0
  238.          ELSE
  239.             FLen% = INSTR(MID$(Header$, 39, 13), CHR$(0)) - 1
  240.             MID$(FileName$, 1) = MID$(Header$, 39, FLen%)
  241.          END IF
  242.       CASE 5
  243.          IF AscM%(Header$, 11) > 1 THEN
  244.             FLen% = 0
  245.          ELSE
  246.             St$ = MID$(Header$, 35, 80)
  247.             FLen% = INSTR(St$, CHR$(0))
  248.             IF FLen% THEN FLen% = FLen% - 1
  249.             MID$(FileName$, 1, FLen%) = St$
  250.          END IF
  251.    END SELECT
  252. END SUB
  253.  
  254.  
  255.  
  256. SUB GetStoreA (Storage$)
  257.    File$ = SPACE$(12)
  258.    Storage$ = File$
  259.    Header$ = SPACE$(128)
  260.    GetArc00 Handle%, ArcType%, File$, Header$
  261.    SELECT CASE ArcType%
  262.       CASE 1
  263.          SELECT CASE AscM%(Header$, 2)
  264.             CASE 1, 2: Storage$ = "Stored  "
  265.             CASE 3: Storage$ = "Packed  "
  266.             CASE 4: Storage$ = "Squeezed"
  267.             CASE 5, 6: Storage$ = "crunched"
  268.             CASE 7, 8: Storage$ = "Crunched"
  269.             CASE 9: Storage$ = "Squashed"
  270.             CASE 10: Storage$ = "Crushed "
  271.             CASE 11: Storage$ = "Distill "
  272.             CASE ELSE
  273.          END SELECT
  274.       CASE 2
  275.          MID$(Storage$, 1) = MID$(Header$, 3, 5)
  276.       CASE 3
  277.          SELECT CASE AscM%(Header$, 9)
  278.             CASE 0: Storage$ = "Stored  "
  279.             CASE 1: Storage$ = "Shrunk  "
  280.             CASE 2: Storage$ = "Reduce-1"
  281.             CASE 3: Storage$ = "Reduce-2"
  282.             CASE 4: Storage$ = "Reduce-3"
  283.             CASE 5: Storage$ = "Reduce-4"
  284.             CASE 6: Storage$ = "Imploded"
  285.             CASE ELSE
  286.          END SELECT
  287.       CASE 4
  288.          Storage$ = "        "
  289.       CASE 5
  290.          Storage$ = CHR$(AscM%(Header$, 10) + 48) + SPACE$(7)
  291.    END SELECT
  292. END SUB
  293.