'===========================================================================
' Subject: ABC GROUP EXTRACTOR               Date: 11-12-96 (11:34)       
' Author:  Alexander Podkolzin               Code: PB                     
' Origin:  APP@nw.sbank.e-burg.su          Packet: ABC.ABC
'===========================================================================
'-------------------------------------------------------------------------
' ABC group extractor. Extracts all "*.BAS" files from a group (*.ABC).
' I cann't explain all details about ABC structures, as (1) - I am not
' the author of ABCREAD programme and (2) - it is copyrighted by
' the ABC programmer - William Yu !
' I'd recommend to use ABC extractor separately from your main ABC archive,
' in a "temp" directory. Copy to it ABC extractor and a group file you'v
' chosen.
' I do not give you any warranty, use it on your own risc!
'-------------------------------------------------------------------------
  DEFINT a-z
'
  s$ = LTRIM$(RTRIM$(COMMAND$))
'
  IF NOT FileHere(s$) OR s$ = "" THEN
     PRINT "File not found !"
     END
  END IF
'
  d = INSTR(s$,".")
'
  IF MID$(s$,d+1,3) <> "abc" OR d = 0 THEN
     PRINT "It's not ABC file!"
     END
  END IF
'
  NameFile$ = s$
'
'
  ABCD$ = CHR$(227)
  %FALSE = 0
  %TRUE = NOT %FALSE
  %MaxLen = 1024
'
  CLS
  PRINT "Extracting :"
  Position& = 0
  source = FREEFILE
  OPEN NameFile$ FOR BINARY AS source
  DO
     Buffer$ = space$(%MaxLen)
     SEEK #source, Position&
     GET$ #source, %MaxLen, Buffer$
     d = INSTR(Buffer$,ABCD$)
'
     IF d = 0 THEN
        EXIT LOOP
     ELSEIF d = 1 THEN
        Buffer$ = ""
     ELSE
        Buffer$ = LEFT$(Buffer$,d-1)
     END IF
'
     INCR Position&,d
'
     IF LEN(Buffer$) > 165 THEN
'
' There are in ABC packets chars with code=0 (<32) sometimes, so
' we have to remove them...
'
        Buffer$ = RemoveRubbish$(Buffer$)
'
        IF OnlyDigits(MID$(Buffer$,140,11)) THEN
           CLOSE dest             '
           DestName$ = MID$(Buffer$,154,12)
           PRINT destname$
           dest = FREEFILE
           OPEN DestName$ FOR output AS dest
'
'      Header:
'
           PRINT #dest,CHR$(39)+STRING$(75,45)
           PRINT #dest,CHR$(39)+" Author  : "+MID$(Buffer$, 1,31)
           PRINT #dest,CHR$(39)+" Subject : "+MID$(Buffer$,32,30)
           PRINT #dest,CHR$(39)+" Origin  : "+MID$(Buffer$,63,30)
           PRINT #dest,CHR$(39)+" Date    : "+MID$(Buffer$,94,22)
           PRINT #dest,CHR$(39)+" System  : "+MID$(Buffer$,117,22)
           PRINT #dest,CHR$(39)+STRING$(75,45)
'
           PRINT #dest,CHR$(39)
           PRINT #dest,MID$(Buffer$,166)
        END IF
     ELSE
        PRINT #dest,Buffer$
     END IF
'
  LOOP
  CLOSE                           ' All files
'
  PRINT "Thank you for using this program!"
'
  END
'
'--------------------------------------------------------------------------
  FUNCTION FileHere%(FileNAME$)
     s$=DIR$(FileNAME$)
     IF LEN(s$)=0 THEN
        FUNCTION = %FALSE
     ELSE
        FUNCTION = %TRUE
     END IF
  END FUNCTION
'--------------------------------------------------------------------------
  FUNCTION OnlyDigits%(s$)        ' Checks if s$ contains only digits
'
     IF LEN(s$) = 0 THEN
        FUNCTION = 0
        EXIT FUNCTION
     END IF
'
     s$ = REMOVE$(s$,ANY " 0123456789")
'
     IF LEN(s$) = 0 THEN
        FUNCTION = %TRUE
     ELSE
        FUNCTION = %FALSE
     END IF
'
  END FUNCTION
'---------------------------------------------------------------------------
  FUNCTION RemoveRubbish$(s$)
'
     DIM PTR AS BYTE PTR
     DIM ptr0 AS BYTE PTR
'
     ptr0 = STRPTR32(s$)
'
     FOR i%=0 TO LEN(s$)-1
        PTR = ptr0+i%
        IF @ptr < 32 THEN
           @ptr = 32
        END IF
     NEXT
'
     FUNCTION = s$
'
  END FUNCTION
'--------------------------------------------------------------------------