'=========================================================================== ' Subject: EXTRACT *.BAS FROM *.CDE/*.ABC Date: 01-10-00 (17:48) ' Author: James A. Davis Code: QB, QBasic, PDS ' Origin: jad@iswt.com Packet: ABC.ABC '=========================================================================== '*** 1-7-2000 1600 ' *** use at your own risk this can wipe old files *** ' ** I am James Davis : email jad@iswt ' ** this takes *.abc files and makes *.bas files '** unzip the packet and it will take the *.cde and make *.bas files '** run abcread and make the *.abc files and this will then make *.bas files ' ** I tried to make it all work in auto using the abc packets '** I use part of Jane Grisctic's program qblister.bas nov 95 '** I use part of Mr Snow's program, abcfile.bas may 97 ** '** not responsible ** use at your own risk **** DIM from AS STRING * 31 ' Programmer/Author's name DIM Subject AS STRING * 31 ' Subject/Title of code DIM Origin AS STRING * 31 ' Origin of code, or keywords DIM DateOf AS STRING * 23 ' Date of code release DIM CodeOf AS STRING * 23 ' Code of (QB,QBasic,PDS,ASIC,PB,VB,ASM,TEXT) DIM NumLines AS STRING * 5 ' Number of lines in code DIM Numbytes AS STRING * 9 ' Number of bytes when extracted DIM savefile AS STRING * 12 ' Default extraction name DIM z AS LONG DIM pp AS LONG DIM T$(180) T = TIMER pp = 1 '****the start in the for next loop.increases each time uu = 0 '** comnter in loop ON ERROR GOTO mistake emptyfile = 0 CLS COLOR 3 LOCATE 10, 25: PRINT "Which files ABC or CDE " LOCATE 12, 25: PRINT " A "; "for ABC,"; " C"; " for CDE" start: an$ = INKEY$: IF an$ = "" THEN GOTO start IF an$ = "a" OR an$ = "A" THEN : CLS : GOTO abcstart IF an$ = "c" OR an$ = "C" THEN LOCATE 12, 25: PRINT "can only do 1 cde because of name overwrite": GOTO cdestart GOTO start abcstart: n$ = "abc": GOTO begin cdestart: n$ = "cde": GOTO begin '---------- Write files names to temp file begin: CLS IF LEN(CurrDir$) > 3 THEN doscom$ = "dir " + CurrDir$ + "\*." + n$ + " /b /on >tmpfiles.jad" ELSE doscom$ = "dir *." + n$ + " /b /on >tmpfiles$.jad" END IF SHELL doscom$ REDIM fILENAME$(500) i = 1 OPEN "TMPFILES.jad" FOR INPUT AS #1 IF emptyfile = 0 THEN DO INPUT #1, fILENAME$(i) i = i + 1 CT = i LOOP WHILE NOT (EOF(1)) END IF CLOSE 1 SHELL "del tmpfiles.jad" COLOR 3 CT = CT - 1 IF CT >= 41 THEN CT = 40: LOCATE 1, 5: PRINT "40 Files max press any key": SLEEP: CLS : END tt = 1: d = 5 IF n$ = "cde" THEN CT = 1 '** keeps the cde files to one FOR gg = 1 TO CT LOCATE 2 + tt, d: PRINT fILENAME$(gg) tt = tt + 1 IF gg = 10 THEN d = d + 20: tt = 1: IF gg = 20 THEN d = d + 20: tt = 1 IF gg = 30 THEN d = d + 20: tt = 1 NEXT DS = 0 LOCATE 15, 30: PRINT "Press any key" SLEEP FOR hh = 1 TO CT Q = 1 pp = 1 indexfile$ = fILENAME$(hh) sd = 0 '** counter for file in each catigory ABCFILE$ = fILENAME$(hh) '** could put command$ here OPEN ABCFILE$ FOR BINARY AS #1 IF INKEY$ = "q" OR INKEY$ = "Q" THEN CLS : END IF INKEY$ = "p" OR INKEY$ = "P" THEN LOCATE 12, 5: PRINT "pause ": SLEEP: LOCATE 22, 5: PRINT SPACE$(8) DO zz = 0 '** counter for chr$(0) LOCATE 1, 1: PRINT SPACE$(80) LOCATE 1, 2: COLOR 4: PRINT "jad"; : COLOR 3: PRINT SPACE$(19); " fILENAME; "; ABCFILE$ LOCATE 1, 60: PRINT DS doagain: GET #1, pp, from GET #1, , Subject GET #1, , Origin GET #1, , DateOf GET #1, , CodeOf GET #1, , NumLines GET #1, , Numbytes GET #1, , savefile IF RIGHT$(savefile, 1) = "A" THEN pp = pp + 1: : GOTO doagain IF LEFT$(savefile, 1) = CHR$(32) THEN pp = pp + 1: : GOTO doagain sd = sd + 1 '** counter for how many files DS = DS + 1 'counter for all the files LOCATE 13, 50: PRINT "Press Q to end P to pause" LOCATE 14, 5: PRINT "From: "; from LOCATE 15, 5: PRINT "Subject: "; Subject LOCATE 16, 5: PRINT "Origin: "; Origin LOCATE 17, 5: PRINT "DateOf: "; DateOf LOCATE 18, 5: PRINT "CodeOf: "; CodeOf LOCATE 19, 5: PRINT "NumLines: "; NumLines LOCATE 20, 5: PRINT "NumBytes: "; Numbytes LOCATE 21, 5: PRINT "Name: "; savefile; LOCATE 23, 5: COLOR 3, 0: PRINT "BAS File "; savefile; " "; : COLOR 27, 0: PRINT CHR$(17); CHR$(17); : COLOR 3, 0: PRINT " Extracting this file " LOCATE 22, 5: PRINT SPACE$(70): LOCATE 22, 5: COLOR 3, 0: PRINT "Number of file "; sd LOCATE 22, 40: COLOR 3, 0: PRINT "Number of bytes "; pp IF INKEY$ = "q" OR INKEY$ = "Q" THEN CLS : END IF INKEY$ = "p" OR INKEY$ = "P" THEN LOCATE 22, 5: PRINT "pause ": SLEEP: LOCATE 22, 5: PRINT SPACE$(8) b = 0 '**counter OPEN savefile FOR OUTPUT AS #2 FOR z = pp TO 15000000 copy$ = " " GET #1, , copy$ IF copy$ = CHR$(0) THEN zz = zz + 1 IF zz = 3 THEN pp = z - 4: zz = 0: message$ = "": fr$ = "": : EXIT FOR IF copy$ = CHR$(227) THEN b = 0: T$ = "" '**clears all of this above: b counts how many t$ after CHR$(227) b = b + 1 '***counter that counts to 166 T$ = T$ + copy$ IF b = 166 THEN fr$ = RIGHT$(T$, 12) fr$ = LTRIM$(RTRIM$(fr$)) IF (RIGHT$(fr$, 3)) = "BAS" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "ASI" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "ASM" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "TXT" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "INC" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "FAQ" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "REF" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "LST" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "DOC" THEN pp = z: fr$ = "": message$ = "": EXIT FOR IF (RIGHT$(fr$, 3)) = "HTM" THEN pp = z: fr$ = "": message$ = "": EXIT FOR ELSE fr$ = "" END IF fr$ = "" IF copy$ = CHR$(227) THEN copy$ = CHR$(13) IF copy$ <> CHR$(13) THEN message$ = message$ + copy$ ELSE PRINT #2, message$ message$ = "" END IF NEXT z CLOSE 2 LOOP UNTIL EOF(1) CLOSE 1 NEXT mistake: CLOSE CLS tt = TIMER - T er = tt \ 60 er = tt - (er * 60) PRINT "No more files.." PRINT "" PRINT "There were "; DS; " files Time used"; tt \ 60; " Mins "; er \ 1; " Secs " PRINT "This is the total bytes when using cde files"; pp PRINT "Please press any key" SLEEP COLOR 7 CLS END