!*! Updated on 13-Dec-95 at 8:46 AM by Jim Randazzo; edit time: 0:03:20
!*************************** AMUS Program Label ******************************
! Filename: FOLDER.BAS Date: 11/25/95
! Category: UTIL Hash Code: 000-000-000-000 Version: 1.0(100)
! Initials: /AM Name: Mike L. Sessi
! Company: Birmingham Data Systems Inc. Telephone #: 707-795-1595
! Related Files: accept.sbr, noecho.sbr,
!
! Min. Op. Sys.: AMOSL 1.0 Expertise Level: none
!*****************************************************************************
!*! Updated on 25-Nov-95 at 0:00 AM by Mike L. Sessi IV; edit time: 0:00:00
!*************************** AMUS Program Label ******************************
!
100 PROGRAM folder,1.0(101)
! THIS PROGRAM USES
! XCALL ACCEPT.SBR ! to get single chr input
! XCALL NOECHO.SBR
110 MAP1 LABEL ! block 0, disk label information
120 MAP2 FIL,B,4
130 MAP2 VOL'NAM,S,40
140 MAP2 VOL'ID,S,10
150 MAP2 CREATOR,S,30
160 MAP2 INSTALL,S,30
170 MAP2 SYSTEM,S,30
MAP2 LAB1,B,1 ! last access
MAP2 LAB2,B,1
MAP2 LAB3,B,1
MAP2 LAB4,B,1
MAP2 LAB5,B,1 ! created on
MAP2 LAB6,B,1
MAP2 LAB7,B,1
MAP2 LAB8,B,1
180 MAP2 LAB9,S,260
MAP2 LAB0,S,100
MAP1 FLD'IN,S,100
MAP1 FOLDER(23) ! DISK SPEC
MAP2 FLD,S,30 ! DSK02:FOLDER.FLD[001,002]
! or/ DSK2:FOLDER.FLD[1,2]
MAP1 FLD'RD,X,512
MAP1 FLD'ROW,F,6,1
MAP1 FLD'ROW'S,F,6,0
MAP1 FLD'CT,F,6
!
MAP1 DIR'FILE
MAP2 DIR'PTR,B,2
MAP2 D'SEQ,X,510
!
MAP1 D'RAN,X,512,@DIR'FILE
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
200
210 MAP1 MFDX ! master file directory
220 MAP2 MFD0(64) ! 64 p'pn in 1 disk block
230 MAP3 PPNX,B,2 ! p'pn number
240 MAP3 LNK2,B,2 ! Points to the UFD block, also
! the next MFD block number (#64)
250 MAP3 MFD3,B,2 ! PASS WORD ?
260 MAP3 MFD4,B,2 ! ???
!
MAP1 PPN0,S,3 ! Hold p,pn number [123,123]
270 MAP1 PPN1,S,3 ! P,PN 1st 3 numbers
280 MAP1 PPN2,S,3 ! 2nd 3 numbers
!
290 MAP1 UFD ! USER FILE DIRECTORY (42 ENTRYS/BLK)
300 MAP2 PTR,B,2 ! Next UFD block number
310 MAP2 UFDENT(42)
320 MAP3 UFDNAM1,B,2 ! 1ST 3 CHR'S
330 MAP3 UFDNAM2,B,2 ! 2ND 3 CHR'S
340 MAP3 UFDNAMX,B,2 ! 3RD 3 CHR'S (EXT)
350 MAP3 UFDBLKX,B,2 ! FILE SIZE
360 MAP3 UFDACTX,B,2 ! FILE TYP. IF 65503 THEN CONTIG
370 MAP3 UFDFPTX,B,2 ! LINK TO 1ST BLOCK of file
380 MAP2 FIL3,X,6
!
390 MAP1 RAD5O
400 MAP2 RAD5,S,1
410 MAP2 RADX,S,50,"ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789 "
450 RAD5=CHR(0)
!
420 MAP1 UNP,S,3 ! unpacked UFD file chars (3)
430 MAP1 SP,S,20," "
440 MAP1 NAME,S,10 ! the unpacked file name
!
460 MAP1 SCR'ROW(128) ! store the MFD screen
470 MAP2 SCR,S,80 ! MFD's ([123,123])
MAP2 LNK,S,80 ! the link to the UFD
!
MAP1 DIR'ROW(24) ! screen of the UFD block
MAP2 DIR'COL(5)
MAP3 DIR'NAM,S,10 ! file name.ext blocks
MAP3 DIR'SIZ,B,2 ! file size
MAP3 DIR'TYP,B,2 ! file type, or seq., ran.
MAP3 DIR'LNK,B,2 ! link to 1st block
!
MAP1 HEAD'IN
MAP2 ENTRY,S,70
MAP2 H'FIL,S,442
!
MAP1 VARIABLE'LIST
MAP2 AM0S,S,50
MAP2 SCR1$,S,100
490 SIGNIFICANCE 11
500 STRSIZ 80
MLS: input "Instruction ? ",q$
if ucs(q$) = "Y" then call INSTR : GOTO MLS
LOOKUP "FOLDER.FIL",FOUND
IF FOUND=0 THEN GOTO FLD'DIR ! file not found, output err message
OPEN #14,"FOLDER.FIL",INPUT
FLD: INPUT LINE #14,FLD'IN
IF EOF(14) THEN GOTO FLD1
FLD'CT=FLD'CT+1
FLD(FLD'CT)=FLD'IN
GOTO FLD
FLD1:
CALL FLD'FILES ! display folder files
? TAB(-1,29); ! turn off cursor
XCALL NOECHO
FLD'ROW=1
FLD'COM:
CALL FLD'MRK'ON
XCALL ACCEPT,A
!
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
CALL FLD'MRK'OFF ! up & down arrows only
IF A=27 THEN GOTO EXIT
ON A-7 CALL NULL,NULL,FLD'LF,FLD'VT,NULL,FLD'CR
GOTO FLD'COM
!
FLD'VT: ! UP ARROW
FLD'ROW=FLD'ROW-1
IF FLD'ROW=0 THEN FLD'ROW=FLD'CT
RETURN
FLD'LF: ! DOWN ARROW
FLD'ROW=FLD'ROW+1
IF FLD'ROW > FLD'CT THEN FLD'ROW=1
RETURN
FLD'CR:
CALL FLD'OPEN ! open folder file
CALL MFD'SEC ! process the MFD section
CALL FLD'CLOSE ! close folder file
FLD'ROW'S=FLD'ROW ! save folder file pointer
CALL FLD'FILES ! display all folder files
FLD'ROW=FLD'ROW'S
RETURN
FLD'MRK'ON:
PRINT TAB(FLD'ROW+1,2); TAB(-1,32); FLD(FLD'ROW); TAB(-1,33);
RETURN
FLD'MRK'OFF:
PRINT TAB(FLD'ROW+1,2); TAB(-1,33); FLD(FLD'ROW); TAB(-1,33);
RETURN
FLD'OPEN: ! open folder file & read
OPEN #1,FLD(FLD'ROW),RANDOM,512,F1
READ #1,FLD'RD
RETURN
FLD'CLOSE:
CLOSE #1
RETURN
FLD'FILES: F1=0
PRINT TAB(-1,0); "FOLDER FILE SPEC FILE LABEL INFO"
PRINT TAB(23,1); "COMMANDS: ESC: Exit program, ARROWS: move selection";
print ", CR: opens folder File";
FOR FLD'ROW=1 TO FLD'CT
CALL FLD'OPEN ! open folder file and do a read
CALL FLD'CLOSE ! close file
for f=1 to 40 !lenth of vol'nam
if FLD'RD[f,f] >= " " and FLD'RD[f,f] < "}" then &
LABEL[f,f]=FLD'RD[f,f]
next f
LABEL=FLD'RD ! move into LABEL
PRINT TAB(FLD'ROW+1,28); VOL'NAM ! print label info
CALL FLD'MRK'OFF ! print file name
NEXT FLD'ROW
RETURN
!
MFD'SEC:
print tab(2,1); tab(-1,10);
CALL INIT ! clears mfd save area, reads ,loads & prints mfd
MFD'ROW=2 ! start printing on this row
SCH'STR=1 ! instr search starting point
CALL FF ! get 1st mfd entry
MFD'COM:
CALL MFD'MRK'ON ! re-print mfd entry
PRINT TAB(23,1); "Commands: ESC: file selection, ARROWS to move";
print ", CR: to make a selection";
XCALL ACCEPT,A
!
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
CALL MFD'MRK'OFF
IF A=27 THEN RETURN ! return to FLD'CR
ON A-7 CALL BS,NULL,LF,VT,FF,CR
COM$=UCS(CHR(A)) ! convert to upercase
! CALL HEADER ! print header (A.A)
GOTO MFD'COM ! get keyboard input
!
NULL: RETURN
BS: ! BACK SPACE
IF B-1 < 2 THEN MFD'ROW=MFD'ROW-1 : B=100
IF MFD'ROW=1 THEN MFD'ROW=PPN'CT : B=100
FOR BS=B-1 TO 1 STEP -1
IF SCR'ROW(MFD'ROW)[BS,BS] = "[" THEN B=BS : BS=1
NEXT BS
SCH'STR=B+1
RETURN
FF: ! RIGHT ARROW
FF1: B=INSTR (SCH'STR,SCR'ROW(MFD'ROW),"[")
IF B=0 AND MFD'ROW > PPN'CT THEN MFD'ROW=2 : SCH'STR=1 : GOTO FF
IF B=0 THEN MFD'ROW=MFD'ROW+1 : SCH'STR=1 : GOTO FF:
SCH'STR=B+1
RETURN
VT: ! UP ARROW
MFD'ROW=MFD'ROW-1
IF MFD'ROW=1 THEN MFD'ROW=PPN'CT
SCH'STR=1
CALL FF1
RETURN
LF: ! DOWN ARROW
MFD'ROW=MFD'ROW+1
IF MFD'ROW > PPN'CT THEN MFD'ROW=2 : SCH'STR=1 : CALL FF1
SCH'STR=1
CALL FF1
RETURN
CR: MFD'TEMP=MFD'ROW : MFD'COL=B
CALL DIR
CALL INIT
MFD'ROW=MFD'TEMP : B=MFD'COL
CALL FF
RETURN
INIT:
print tab(-1,0); FLD(FLD'ROW); TAB(1,28); VOL'NAM ! print label info
FOR A=1 TO 64
LNK(A)=SPACE(100)
SCR(A)=CHR(0)
NEXT A
CALL MFD ! read and load and print the mfd
RETURN
!
MFD'MRK'ON: ! display and print p,pn
13 MRK=INSTR(B,SCR'ROW(MFD'ROW),"]")
? TAB(MFD'ROW,B-1); TAB(-1,32); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
RETURN
!
MFD'MRK'OFF:
14 ? TAB(MFD'ROW,B-1); TAB(-1,33); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
RETURN
!
! *****************************************
!
700 MFD: ! read, load and print the mfd
!
F1=1 ! point to mfd in a folder file
READ #1,MFDX ! get folder's mfd
630 MD1=0
720 FOR MD=1 TO 64 ! 64 ppn's per block
730 IF PPNX(MD)=0 THEN MD=64 : GOTO OUT
740 CALL PPN'UNPACK
750 IF MD1=0 AND MD=1 THEN PPN0=PPN1 : MFD'ROW=2 : : COL=2
760 IF PPN1 # PPN0 THEN PPN0=PPN1 : ? : MFD'ROW=MFD'ROW+1 : &
: COL=2
IF LEN(SCR(MFD'ROW)) > 70 THEN MFD'ROW=MFD'ROW+1 : COL=2 : &
PRINT
775 PRINT TAB(-1,33); "["+PPN1+","+PPN2+"]";TAB(-1,33);
800 OUT: NEXT MD
IF PPNX(64)=0 AND LNK2(64) # 0 THEN print "%too many P,PNs"
! IF PPNX(64)=0 AND LNK2(64) # 0 THEN F1=LNK2(64) : CALL RD'DISK : &
! MFDX=BUFFER : MD1=1 : GOTO 720
PPN'CT=MFD'ROW ! NO MORE ENTRY'S
810 RETURN
!
!********************* DIR *************
!
820 DIR:
IF LNK(MFD'ROW)=0 THEN PRINT "NO FILES, CR TO CONTINUE" : INPUT "",A$ : RETURN
F1=LNK(MFD'ROW)[B;5] ! get the next block (record) link
READ #1,UFD ! read ufd block (record)
830 BLOCKS=0 : T'BLOCKS=0 : FILES=0
CALL DIR'CLR
840 CALL DIR2
860 RETURN ! RTN TO CALLER
870 DIR2:
880 FOR A0=1 TO 42
NAME=CHR(0)
900 UNP=CHR(0)
910 IF UFDBLKX(A0)=0 THEN A0=42 : GOTO DIR1
920 IF UFDNAM1(A0)=65535 THEN GOTO DIR1
ROW1=ROW1+1
!
IF COL>64 AND ROW1 > 23 THEN CALL PRT'BLKS : CALL DIR'INP : &
IF A=27 THEN RETURN ! rtn to mfd early
IF ROW1>23 THEN ROW1=2 : COL=COL+16 : C'CT=C'CT+1 : CALL PRT'BLKS
!
930 CALL RAD50 ! UNPACK THE FILE NAME
!
DIR'NAM(ROW1,C'CT)=NAME+SP[1,7-LEN(NAME)]+UNP+SP[1;3-LEN(UNP)]
DIR'SIZ(ROW1,C'CT)=UFDBLKX(A0) ! file size
DIR'TYP(ROW1,C'CT)=UFDACTX(A0) ! file type
DIR'LNK(ROW1,C'CT)=UFDFPTX(A0) ! link to file
!
940 FILES=FILES+1
950 PRINT TAB(ROW1,COL-1); TAB(-1,33); NAME;SP[1,7-LEN(NAME)]; &
UNP ; SP[1;3-LEN(UNP)]; TAB(-1,33);
960 BLOCKS=UFDBLKX(A0)
970 PRINT STR(BLOCKS); ! SP[1,4-LEN(STR(BLOCKS))+1];
980 T'BLOCKS = T'BLOCKS + BLOCKS
1010 DIR1: NEXT A0
1020 IF PTR = 0 THEN CALL PRT'BLKS : CALL DIR'INP : RETURN
!
1030 F1=PTR ! get another ufd block (record)
READ #1,UFD ! read it
1060 GOTO DIR2 ! print files on screen
!
!
DIR'INP:
ROW1=2 : C'CT=1
SCR1$=DIR'NAM(ROW1,C'CT)
CALL DIR'MRK'ON
PRINT TAB(-1,29); ! CURSOR OFF
COM'DIR:
ON ERROR GOTO EXIT
print tab(-1,29);
print tab(24,1); "^T: next screen, Arrows: move around";
print ", CR: read, SP: un/mark file, C: to copy"; tab(1,79);
XCALL ACCEPT,A
CALL DIR'MRK'OFF
CALL SAVE'CT
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
IF A=27 THEN PRINT TAB(-1,0); : RETURN ! return to CR'MFD
ON A-7 CALL DIR'BS,NULL,DIR'LF,DIR'VT,DIR'FF,DIR'CR
IF A=20 THEN CALL DIR'CLR : ROW1=2 : RETURN ! ^T
IF A=32 THEN CALL DIR'FILE'MARK ! un/mark file
IF A=67 OR A=99 THEN CALL DIR'COPY'FILES : print tab(-1,29);
CALL CK'DIR'NAM
CALL DIR'MRK'ON
GOTO COM'DIR
!
! 27=esc, 20=^t, 32=sp, 67;99= c
!
DIR'BS: ! BACK SPACE (LEFT ARROW)
C'CT=C'CT-1
IF C'CT=0 THEN C'CT=5 : ROW1=ROW1-1
IF ROW1=1 AND C'CT=5 THEN ROW1=23 : C'CT=5
RETURN
DIR'FF: ! RIGHT ARROW
C'CT=C'CT+1
IF C'CT=6 AND ROW1 = 23 THEN ROW1=2 : C'CT=1
IF C'CT=6 THEN ROW1=ROW1+1 : C'CT=1
RETURN
DIR'VT: ! UP ARROW
ROW1=ROW1-1
IF ROW1=1 AND C'CT=1 THEN ROW1=23 : C'CT=5
IF ROW1=1 THEN C'CT=C'CT-1 : ROW1=23
RETURN
DIR'LF: ! DOWN ARROW
ROW1=ROW1+1
IF ROW1 > 23 THEN ROW1=2 : C'CT=C'CT+1
IF C'CT=6 THEN ROW1=2 : C'CT=1
RETURN
CK'DIR'NAM:
IF DIR'NAM(ROW1,C'CT) = "" THEN CALL RESTORE'CT
RETURN
!
DIR'PRT:
PRINT TAB(-1,0);
FOR C=1 TO 5
CCT=C * 16 - 15
FOR R=1 TO 23
IF DIR'NAM(R,C)="" THEN GOTO NXR
PRINT TAB(R,CCT); TAB(-1,33);DIR'NAM(R,C); &
TAB(-1,33); STR(DIR'SIZ(R,C));
NXR: NEXT R
NEXT C
RETURN
!
DIR'MRK'ON:
! Need to re-print file name again. This will allow it to work on all crts
CCT=C'CT * 16 - 15
IF CCT <= 0 THEN CCT=1
SCR1$=DIR'NAM(ROW1,C'CT)
PRINT TAB(ROW1,CCT); TAB(-1,32); SCR1$; TAB(-1,33);
RETURN
DIR'MRK'OFF:
CCT=C'CT * 16 - 15
IF CCT <= 0 THEN CCT=1
PRINT TAB(ROW1,CCT); TAB(-1,33);SCR1$; TAB(-1,33);
RETURN
!
PRT'BLKS:
PRINT TAB(1,21); STR(FILES); " Files "; STR(T'BLOCKS);" Blocks";
RETURN
!
PRT'HD:
E=INSTR(B,SCR(MFD'ROW),"]")
PRINT TAB(1,1);"Directory Utility";TAB(1,45); &
FLD(FLD'ROW);" ";SCR(MFD'ROW)[B,E];
RETURN
!
DIR'CLR:
831 PRINT TAB(-1,0);
832 ROW1=1 : COL=2 : C'CT=1
CALL PRT'HD
FOR A=1 TO 24
DIR'ROW(A)=SPACE(50)
NEXT A
RETURN
DIR'FILE'MARK:
MRK$="*" ! seq. file
IF DIR'TYP(ROW1,C'CT)= 65535 THEN MRK$="#" ! is it a random file?
IF DIR'NAM(ROW1,C'CT)[7,7] = " " THEN DIR'NAM(ROW1,C'CT)[7,7] = MRK$ &
ELSE DIR'NAM(ROW1,C'CT)[7,7] = " "
RETURN
DIR'COPY'FILES:
COPY$=CHR(0)
print tab(-1,28); ! cursor on
PRINT TAB(24,1); TAB(-1,9); TAB(-1,32); "Copy File(s) To:";
print " Exp: DSK0:[7,6]";
PRINT TAB(24,39); "|_______________"; TAB(24,40);
DCF: XCALL ACCEPT,F
! 27= esc, 8=bs, 127=del, 13=cr,
IF F=27 THEN RETURN ! rtn COM'DIR
IF F=8 OR F=127 THEN CALL RUB'OUT
IF F=13 THEN CALL CHECK'FILE : RETURN ! rtn COM'DIR
IF F < 43 OR F > 126 THEN GOTO DCF
COPY$=COPY$+CHR(F)
CALL PRT'NAME
GOTO DCF
RUB'OUT:
RO=LEN(COPY$)
IF RO-1 = 0 THEN COPY$=CHR(0) : CALL PRT'NAME : RETURN
COPY1$=CHR(0)
COPY1$=COPY$[1,RO-1]
COPY$=COPY1$
CALL PRT'NAME
RETURN
PRT'NAME:
PRINT TAB(24,40); TAB(-1,9); COPY$;
RETURN
CHECK'FILE:
ON ERROR GOTO NO'FILE
! LOOKUP A FILE, OK, CONTINUE
LOOKUP COPY$+"A.MLS",FOUND
IF FOUND # 0 THEN GOTO FOR
ALLOCATE COPY$+"A.MLS",1
FOR: FOR C=1 TO 5
FOR R=1 TO 23
IF DIR'NAM(R,C)[7,7]="*" OR DIR'NAM(R,C)[7,7]="#" &
THEN CALL COPY'FILE
NEXT R
NEXT C
RETURN
NO'FILE:
PRINT TAB(24,2); TAB(-1,9);
IF ERR(0)=16 THEN PRINT "?File spec error";
IF ERR(0)=22 THEN PRINT "?PPN not found ";
IF ERR(0)=26 THEN PRINT "?Device does not exist";
IF ERR(0)=23 THEN PRINT "?Protection violation";
PRINT " %Error ";ERR(0); " "; COPY$; " ";
XCALL ACCEPT,D
RESUME FILE'RTN
FILE'RTN:
RETURN ! rtn to DCF (DIR'COPY'FILES)
!
COPY'FILE:
A$=DIR'NAM(R,C) ! get file name
A$[7,7]=" "
CS=INSTR(1,A$," ") ! find a space in file name
F$=A$[1,CS-1]+"."+ A$[8,10] ! put dot in
PRINT TAB(24,2); TAB(-1,9); FLD(FLD'ROW);" to "; COPY$;F$;
R1=510
F1=DIR'LNK(R,C) ! get first block link
IF DIR'TYP(R,C) = 65535 THEN CALL COPY'RANDOM ELSE &
CALL COPY'SEQ
RETURN
COPY'SEQ:
CT=0
OPEN #20,COPY$+F$,OUTPUT ! open file
COPY'S:
READ #1,D'RAN
F1=DIR'PTR ! get next link
IF F1 = 0 THEN R1=DIR'TYP(ROW1,C'CT) ! bytes of last block
PRINT #20,D'SEQ[1,R1];
CT=CT+1
PRINT TAB(24,50); CT;
IF F1=0 THEN CLOSE #20 : RETURN
GOTO COPY'S
COPY'RANDOM:
F14=0
LOOKUP COPY$+F$,FOUND
IF FOUND < 0 THEN KILL COPY$+F$ ! erase old file
1335 ALLOCATE COPY$+F$,DIR'SIZ(R,C) ! create new file
OPEN #20,COPY$+F$,RANDOM,512,F14 ! open file
GOTO COPY'RAN
PRINT "By Mike L. Sessi. 415/258-0102 .. 707/795-1596 11/24/95"
print "Questions, call me"
COPY'RAN:
READ #1,D'RAN
WRITE #20,D'RAN
F14=F14+1
IF F14 => DIR'SIZ(R,C) THEN CLOSE #20 : RETURN
F1=F1+1
PRINT TAB(24,50); F14
GOTO COPY'RAN
! DIR'SIZ(ROW1,C'CT)=UFDBLKX(A0) ! file size
! DIR'TYP(ROW1,C'CT)=UFDACTX(A0) ! file type
! DIR'LNK(ROW1,C'CT)=UFDFPTX(A0) ! link to file
! check file type
PRT'FILE'SCR:
PRINT TAB(-1,0);
F1=DIR'LNK(ROW
1,C'CT) ! get first block link
IF DIR'TYP(ROW1,C'CT) = 65535 THEN GOTO RANDOM'PRT
R1 = 510
!look
SEQ'PRT:
R=1
1234 READ #1,D'RAN
IF DIR'PTR = 0 THEN R1=DIR'TYP(ROW1,C'CT) ! bytes of last block
S1: SEQ=ASC(D'SEQ[R,R])
IF SEQ > 31 AND SEQ < 126 THEN PRINT CHR(SEQ); : C=C+1
IF SEQ = 13 THEN PRINT CHR(13); CHR(10); : R=R+1 : C=0 : L=L+1
IF SEQ = 9 THEN PRINT CHR(9); : C=C+9
IF C > 79 THEN C=0 : L=L+1
IF L > 22 THEN CALL PRT'COM : IF B=27 THEN RETURN
R=R+1 : IF R < R1 THEN GOTO S1
F1=DIR'PTR
IF F1=0 THEN CALL PRT'COM : RETURN ! end of file
GOTO SEQ'PRT
PRT'COM:
PRINT TAB(24,1); TAB(-1,9);
C=0 : L=0
PRINT TAB(24,1); TAB(-1,32); "CR to continue listing, ESC to return >";
print tab(24,77); tab(-1,33);
XCALL ACCEPT,B
PRINT TAB(24,1); TAB(-1,9);
RETURN
RANDOM'PRT:
R=1
READ #1,D'RAN
R1: SEQ=ASC(D'SEQ[R,R])
IF SEQ > 31 AND SEQ < 126 THEN PRINT CHR(SEQ); : C=C+1
IF SEQ = 13 THEN PRINT CHR(13); CHR(10); : R=R+1 : C=0 : L=L+1
IF SEQ = 9 THEN PRINT CHR(9); : C=C+9
IF C > 79 THEN C=0 : L=L+1
IF L > 22 THEN CALL PRT'COM : IF B=27 THEN RETURN
R=R+1 : IF R < R1 THEN GOTO R1
F1=F1+1
IF F1+1 > DIR'SIZ(ROW1,C'CT) THEN CALL PRT'COM : RETURN ! size of file
GOTO RANDOM'PRT
!
INSTR:
PRINT "This program will extract files from a FOLDER file."
print "It will overwrite any file that already exsist in"
print "that account."
print
print "Do not try to look at an empty PPN,"
print "the program will bounce you out to the dot."
print
print "Questions: call mike sessi @ 707/795-1595"
print "As always, if this program as value to you,"
print "you can always send me $."
RETURN
FLD'DIR:
PRINT "Need a file called FOLDER.FIL. Please create by the"
print "following: ? DIR/D FOLDER.FIL=*.FLD whereas .FLD is"
print "the name(s) of the folder files"
