!*! Updated on 18-Dec-95 at 11:31 AM by Jim Randazzo; edit time: 0:01:16
!*************************** AMUS Program Label ******************************
! Filename: DKLOOK.BAS Date: 11/03/95
! Category: UTIL Hash Code: 000-000-000-000 Version: 1.0(106)
! Initials: /AM Name: Mike L. Sessi
! Company: Birmingham Data Systems Inc. Telephone #: 707-795-1595
! Related Files: accept.sbr, noecho.sbr, norton.sbr, infld.sbr,amos.sbr, &
! look.lit
! Min. Op. Sys.: AMOSL 1.0 Expertise Level: none
!*****************************************************************************
!*! Updated on 02-Nov-95 at 0:00 AM by Mike L. Sessi IV; edit time: 0:00:00
!*************************** AMUS Program Label ******************************
!
! 11/09/95 added code so this will run under d-run (RUNDOS)
! 11/05/95 esc now works in dir print
! 11/02/95 change screen output so Norton works on both type of terminals
! 11/01/95 Mike Sessi (mls) First release
!
100 PROGRAM norton,1.0(106)
!
! THIS PROGRAM USES
! XCALL ACCEPT.SBR ! to get single chr input
! XCALL NOECHO.SBR ! for accept.sbr
! XCALL NORTON.SBR ! reads a single block
! XCALL INFLD.SBR ! input line for header info
! XCALL AMOS.SBR ! to excute look.lit
! LOOK.LIT ! displays any kind of file
101 ! RENUMBERED ON 09/12/95
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 FIL2,S,364
190
!
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 MFD block number
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
!
MAP1 R'DRIVE(09) ! DISK DEVICES NAMES
MAP2 C'DRIVE(10)
MAP3 DISKS,S,6 ! disks names (dsk00:)
!
510 ! MAP1 NORTON
520 MAP1 DISK'DEVICE,S,7 ! give disk spec (dsk000:
530 MAP1 BLOCK'NO,B,4 ! give block number to read
540 MAP1 BUFFER,X,512 ! returns block info
560 MAP1 ERR'CODE,B,1 ! any problems
!
! This info is stored in the A.A file in every P,PN
!
MAP1 HEAD'IN
MAP2 ENTRY,S,70
MAP2 H'FIL,S,442
!
MAP1 HEAD'HOLD,S,510 ! hold header info
! user defined info
! if you add more, change H'LOOP
MAP1 HEAD'INFO(06),S,70
HEAD'INFO(1)="No Information for this directory"
HEAD'INFO(2)="DSK00:[1,2]Operator acct."
HEAD'INFO(3)="DSK00:[1,4]System Acct."
HEAD'INFO(4)="DSK00:[1,6]System Drivers"
HEAD'INFO(5)="DSK00:[2,2]System commands files"
HEAD'INFO(6)="DSK00:[7,6]System .bas files"
MAP1 H'LOOP,B,1,6 ! NUMBER OF HEAD'INFO LINES
490 SIGNIFICANCE 11
500 STRSIZ 80
MLS: input "Instruction ? ",q$
if ucs(q$) = "T" then tst=1
if ucs(q$) = "Y" then call INSTR
!
BEGIN: INPUT "%Enter Disk Device (cr=DSK)? ",A$
IF A$="" THEN A$="DSK"
IF LEN(A$) # 3 THEN ? "ONLY 3 LETTERS" : GOTO BEGIN
XCALL NOECHO
!
START:
ON ERROR GOTO EXIT
CALL DISK'DEVICE
CALL INIT
CALL MFD
MFD'ROW=2
SCH'STR=1
CALL FF
CALL HEADER
? TAB(-1,29); ! turn off cursor
COM:
CALL MFD'MRK'ON
PRINT TAB(23,1); "COMMANDS: (H)eader, The arrows (to move), CR";
PRINT " (to make a selection)";
XCALL ACCEPT,A
!
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
CALL MFD'MRK'OFF
ON A-7 CALL BS,NULL,LF,VT,FF,CR
IF A=27 THEN A$="DSK" : GOTO START ! START OVER
CALL HEADER
COM$=UCS(CHR(A))
IF COM$="H" THEN CALL UP'DATE'HD
GOTO COM
!
NULL: RETURN
!
HEADER:
BH=INSTR(B,SCR'ROW(MFD'ROW),"]") ! find end of p,pn in table
10 SCR1$= DISK'DEVICE+SCR'ROW(MFD'ROW)[B,BH]+"A.A" ! create file name
! exp: DSK00:[1,6]A.A
20 LOOKUP SCR1$,FOUND
! if file type is ok, then, read and print
IF FOUND < 0 THEN CALL OPEN'HEAD : CALL CLOSE'HEAD : &
PRINT TAB(1,1); TAB(-1,9);DISK'DEVICE; TAB(1,8); ENTRY; : &
ELSE CALL HEAD'CNG ! if file is wrong type
! or doesn't exist,
RETURN ! change or create it
HEAD'CNG:
CALL LOG12 ! log to 1,2 to get operator status
! check if file is exist or wrong type
! if wrong type, copy into right type,
! then erase wrong type
70 IF FOUND > 0 THEN OPEN #14,SCR1$,INPUT : INPUT LINE #14,HEAD'HOLD : &
CLOSE #14 : KILL SCR1$
71 ALLOCATE SCR1$,1 ! create new file
CALL OPEN'HEAD ! open file
HEAD'IN=CHR(0)
IF FOUND > 0 THEN HEAD'IN=HEAD'HOLD ! move old file type into new
! keeping only 1st 70 chars.
! if file is empty, check for header infor.
FOR HL=1 TO H'LOOP
IF SCR1$[1,11] = HEAD'INFO(HL)[1,11] THEN &
ENTRY=HEAD'INFO(HL)[12,LEN(HEAD'INFO(HL))]
NEXT HL
! if no header info, get default info.
IF ENTRY="" THEN ENTRY=HEAD'INFO(1)
CALL WRITE'HEAD
CALL CLOSE'HEAD
CALL LOGBK ! return to current P,PN
75 print tab(1,1); TAB(-1,9); DISK'DEVICE; TAB(1,8);ENTRY;
RETURN
!
UP'DATE'HD: ! change header information
CALL LOG12 ! log 1,2 to get operator status
CALL OPEN'HEAD ! open A.A file and read it
XCALL INFLD,01,08,70,00,"*35]",ENTRY,INXCTL,1,1,EXITCODE
CALL WRITE'HEAD ! write file
CALL CLOSE'HEAD
CALL LOGBK ! return to current P,PN
? TAB(-1,29); ! turn off cursor
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
print tab(-1,0);
CALL INIT
CALL MFD
MFD'ROW=MFD'TEMP : B=MFD'COL
CALL FF
RETURN
INIT:
FOR A=1 TO 64
LNK(A)=SPACE(100)
SCR(A)=CHR(0)
NEXT A
RETURN
MFD'MRK'ON:
13 ! PRINT TAB(MFD'ROW,B-1); TAB(-1,32);
MRK=INSTR(B,SCR'ROW(MFD'ROW),"]")
! *THIS IS FIELD CRT'S ?
? TAB(MFD'ROW,B-1); TAB(-1,32); SCR'ROW(MFD'ROW)[B,MRK]; TAB(-1,33);
775 PRINT TAB(-1,33); "["+PPN1+","+PPN2+"]";TAB(-1,33);
800 OUT: NEXT MD
IF PPNX(64)=0 AND LNK2(64) # 0 THEN BLOCK'NO=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 BLOCK'NO=0 THEN ? "NO FILES" : RETURN
BLOCK'NO=LNK(MFD'ROW)[B;5]
CALL RD'DISK
UFD=BUFFER
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'FILES : 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'FILES
!
930 CALL RAD50 ! UNPACK THE FILE NAME
!
DIR'NAM(ROW1,(C'CT))=NAME+SP[1,7-LEN(NAME)]+UNP+SP[1;3-LEN(UNP)]
!
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
!
990 ! SIZE OF FILE
! PRINT UFDACTX(A0);" " ! ACTIVE LINK OR TYPE
! PRINT UFDFPTX(A0); ! LINK TO BLOCK
1010 DIR1: NEXT A0
1020 IF PTR = 0 THEN CALL PRT'FILES : CALL DIR'INP : RETURN
!
1030 BLOCK'NO=PTR
CALL RD'DISK
UFD=BUFFER
1060 GOTO DIR2
!
PRT'FILES:
PRINT TAB(1,30); STR(FILES); " Files In "; STR(T'BLOCKS);" Blocks On";
RETURN
!
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:
print tab(24,1); "Commands: ^T, next screen, arrows (to";
print " move from file to file), CR: read"; tab(1,1);
XCALL ACCEPT,A
CALL DIR'MRK'OFF
CALL SAVE'CT
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
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=27 THEN : RETURN ! ESC to exit 'dir'
CALL CK'DIR'NAM
CALL DIR'MRK'ON
GOTO COM'DIR
!
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
DIR'CR:
DCR$=SCR1$[1,6]
XCALL STRIP,DCR$
AM0S="LOOK "+DISK'DEVICE+DCR$[1,LEN(DCR$)]+"."+SCR1$[8,10]+ SCR(MFD'ROW)[B,E]
if tst=1 then print tab(-1,0); tab(12,10); AM0S : INPUT A$
! PRINT TAB(1,1); SCR1$;
! check to see if we running under DRAVIC run (DRUN)
!
ON ERROR GOTO AMOS
F$=RAD50("123")
!
! ok, no error. we must be running d-run
!
RUNDOS=AM0S
!
! back to normal processing
!
DIR'1: ON ERROR GOTO EXIT
CALL DIR'PRT
PRINT TAB(-1,29);
CALL UFD'LN
CALL DIR'LF
RETURN
AMOS:
! ? ERR(0),ERR(1),ERR(2)
RESUME AMOS1
AMOS1: XCALL AMOS,AM0S
GOTO DIR'1
!
SAVE'CT:
C'CT'S=C'CT : ROW1'S=ROW1
RETURN
RESTORE'CT:
C'CT=C'CT'S : ROW1=ROW1'S
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);
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);
! PRINT TAB(15,16); ROW1;C'CT;CCT;SCR1$;
! PRINT TAB(ROW1,CCT); TAB(-1,32);
! PRINT TAB(ROW1,CCT); "!";
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);
! PRINT TAB(ROW1,CCT); "@";
RETURN
!
!
UFD'LN:
833 E=INSTR(B,SCR(MFD'ROW),"]")
834 PRINT TAB(1,1);"PC Directory Utility";TAB(1,65); &
DISK'DEVICE ; SCR(MFD'ROW)[B,E];
RETURN
DIR'CLR:
831 PRINT TAB(-1,0);
832 ROW1=1 : COL=2 : C'CT=1
CALL UFD'LN
FOR A=1 TO 24
DIR'ROW(A)=SPACE(50)
NEXT A
RETURN
IF ERR'CODE # 0 THEN GOTO NEXT
IF DEV'C+1 > 10 THEN DEV'R=DEV'R+1 : DEV'C=0 : PRINT TAB(-1,33)
DISKS(DEV'R,DEV'C+1)=DISK'DEVICE
PRINT TAB(-1,33);DISK'DEVICE;
DEV'C = DEV'C +1
A=A+1
GOTO DD2
NEXT:
PRINT TAB(70); TAB(-1,33)
PRINT TAB(23,1); "Select Disk by using the arrows, then CR";
DEV'ROW=1 : DEV'COL=1
? TAB(-1,29);
DEV'COM:
CALL DEV'MRK'ON
CALL DEV'CR
CALL LABEL
XCALL ACCEPT,A
!
! <- \/ ^ ->
! H J K L CR
! 8 9 10 11 12 13
CALL DEV'MRK'OFF
CALL SAVE'DEV
ON A-7 CALL DEV'BS,NULL,DEV'LF,DEV'VT,DEV'FF,DEV'CR
IF A=27 THEN GOTO EXIT
IF A=13 THEN RETURN ! return to 'START'
CALL CK'DEV
GOTO DEV'COM
SAVE'DEV:
DEV'COL'S=DEV'COL : DEV'ROW'S=DEV'ROW
RETURN
RESTORE'DEV'CT:
DEV'COL=DEV'COL'S : DEV'ROW=DEV'ROW'S
RETURN
CK'DEV:
IF DISKS(DEV'ROW,DEV'COL)="" THEN CALL RESTORE'DEV'CT
RETURN
DEV'BS: ! BACK SPACE
DEV'COL=DEV'COL-1
IF DEV'COL < 1 THEN DEV'ROW=DEV'ROW-1 : DEV'COL=10
IF DEV'ROW < 1 THEN DEV'ROW=DEV'R : DEV'COL=10
RETURN
DEV'FF: ! RIGHT ARROW
DEV'COL=DEV'COL+1
IF DEV'COL > 10 THEN DEV'ROW=DEV'ROW+1 : DEV'COL=1
IF DEV'ROW > DEV'R THEN DEV'ROW=1 : DEV'COL=1
RETURN
DEV'VT: ! UP ARROW
DEV'ROW=DEV'ROW-1
IF DEV'ROW < 1 THEN DEV'ROW=DEV'R
RETURN
DEV'LF: ! DOWN ARROW
DEV'ROW=DEV'ROW+1
IF DEV'ROW > DEV'R THEN DEV'ROW=1
RETURN
! READ DISK
1250 RD'DISK:
1260 XCALL NORTON, DISK'DEVICE, BLOCK'NO, BUFFER,ERR'CODE
1270 RETURN
!
! FILE NAMES UNPACK
!
1330 RAD50: D=40
1340 X=UFDNAM1(A0) : CALL UNPACK : CALL RAD51 : NAME=UNP
1350 X=UFDNAM2(A0) : CALL UNPACK : CALL RAD51 : NAME=NAME+UNP
1360 X=UFDNAMX(A0) : CALL UNPACK : CALL RAD51 : NAME=NAME ! +"."+UNP
1370 RETURN
1380 RAD51:
1390 UNP=RAD5O[R1+1,R1+1]+RAD5O[R2+1,R2+1]+RAD5O[R3+1,R3
+1]
1400 RETURN
1070 PPN'UNPACK:
1080 PPN1=CHR(0) : PPN2=CHR(0) : X=PPNX(MD)
1090 D=256 : CALL UNPACK ! CONVERT TO OCTAL
1100 D=8 : X=R2 : X3=R3 : CALL UNPACK
1110 IF R1 > 0 THEN PPN1=STR(R1)+STR(R2)+STR(R3) : GOTO PPN2
1120 IF R2 > 0 THEN PPN1=STR(R2)+STR(R3) : GOTO PPN2
1130 PPN1=STR(R3)
1140 PPN2:
1150 D=8 : X=X3 : CALL UNPACK
1160 IF R1 > 0 THEN PPN2=STR(R1)+STR(R2)+STR(R3) : GOTO PPN9
1170 IF R2 > 0 THEN PPN2=STR(R2)+STR(R3) : GOTO PPN9
1180 PPN2=STR(R3)
1190 PPN9: RETURN
!
1200 UNPACK:
1210 Q=INT(X/D) : R=X-Q*D : X=Q : R3=R
1220 Q=INT(X/D) : R=X-Q*D : X=Q : R2=R
1230 Q=INT(X/D) : R=X-Q*D : X=Q : R1=R
! ? D,R1;"-";R2;"/";R3
1240 RETURN
!
OPEN'HEAD:
ZZ=0
30 OPEN #1,SCR1$,RANDOM,512,ZZ
40 READ #1,HEAD'IN
RETURN
CLOSE'HEAD:
CLOSE #1
RETURN
WRITE'HEAD:
WRITE #1,HEAD'IN
RETURN
LOG12:
JOBCUR=WORD(1052)*65536+WORD(1054) ! GET JOB ADDRESS(LONG WORD)
LOGIN=WORD(JOBCUR+20) ! SAVE WHERE USER IS LOGGED INTO
WORD(JOBCUR+20)=258 ! LOG 1,2
RETURN
LOGBK:
WORD(JOBCUR+20)=LOGIN ! LOG BACK TO WHERE WE WERE
RETURN
INSTR:
print tab(-1,0)
print "This program will read the disks on this system."
print "Then read the MFD's on that disk. Allowing you"
print "to create an A.A file in each of the P,PNs."
print "you will Also be able to look at any file on"
print "that disk."
PRINT
print "while looking at a UFD, you can not ESC back to the MFD."
print "You must read all of the UFD."
print
print "THIS only reads the old directory format."
print
print "yes, it does need some help."
print "Any questions, call Mike at 707-795-1595"
print
return
EXIT:
IF FOUND # 0 THEN CALL LOGBK
? TAB(-1,28); TAB(23,1);
END
