Listing of file='TESTIDX1' on disk='vmedia/731-8012A.wvd.zip'
# Sector 1034, program filename = 'TESTIDX1'
0010 REM TESTIDX1 24 OCT. 1990
0020 REM % (c) Copyright Wang Laboratories, Inc. 1986
0030 REM PROGRAM NAME - TEST INDEXED FILE FUNCTIONALITY
0040 REM DATE OF FIRST CODE - 13 AUGUST 198
0050 REM RELEASE 1.0. UPDATE - 10 SEPTEMBER 1986
0052 REM RELEASE 2.0. UPDATE - 10 NOVEMBER 1987
0054 REM RAM/INCLUDED TEST OPEN MODES/24 OCT., '90
0060 DIM N$32,T$1,M$1,A$40,A1$(2)8,D$1,C$1,N1$32,A2$(2)8
0070 DIM E$5,E1$26,E2$26,E3$20,E4$2,E5$5,E9$(25)5,B$5,B1$5
: B$="99999"
: B1$="00000"
0080 DIM F$5,F1$26,F2$26,F3$20,F4$2,F5$5,F8$26,F9$5
0090 REM DEBUG FLAG
: D$="Y"
: REM FILE EXISTS OR CREATE FLAG
: C$="C"
0100 REM % TEST PARAMETERS
0110 REM TEST FILE NAME
: N$,N1$="///S06 /RILEY /TESTIDX1"
0120 REM TEST FILE SIZE
: A = 25
0130 REM TEST RECORD SIZE
: A1=84
0140 REM NUMBER OF ALTERNATE KEYS
: A2=2
0150 REM PRIMARY KEY POS
: P=0
: REM PRIMARY KEY LENGTH
: K=5
0160 REM TEST RECORD VARIABLE
: DIM S$84,S1$84,W$
: W$=HEX(A005A01AA01AA014A002A005)
0170 REM % VARIABLE DIMENSIONS
0180 DIM V$32,V1$1,V2$1,V3$1,V4$2,V5$2,V6$26
0190 DIM V7$32,V8$,V8$(50),V9$2,V9$(16,16)8
0200 REM % START OF TEST
0210 PRINT HEX(03);TAB(26);"TEST INDEXED FILE FUNCTIONALITY"
0220 DIM T$1,T1$1,A0$3
: A0$="07C"
0230 PRINT AT(5,0,240);"Enter the Communication Address of the desired 2258 Co
ntroller"
0240 LINPUT -A0$
0250 IF VER(A0$,"HHH")<>3THEN 230
: HEXPACKT$FROMSTR(A0$,2,2)
: T1$=T$
0260 T$=T1$
: T$=OR HEX(03)
: HEXUNPACKT$TO STR(A0$,2,2)
: SELECT #3<A0$>
0270 T$="I"
: M$="X"
: IF C$="E" THEN 1450
0280 REM % CREATE WORK FILE
0290 PRINT AT(5,0,240);"CREATE A INDEXED FILE OF";A;"RECORDS."
0300 T$="I"
0310 M$="X"
0320 O$="O"
0330 A$="IFAN"
0340 STR(A$,5,2)=HEX(0000)
: STR(A$,7,2)=BIN(A,2)
0350 STR(A$,9,2)=HEX(0000)
: STR(A$,11,2)=BIN(A1,2)
0360 STR(A$,13,4)=HEX(00000000)
0370 STR(A$,17,4)=HEX(00000000)
0380 STR(A$,21,6)=ALL(" ")
0390 STR(A$,26,1)=" "
0400 STR(A$,28,2)=BIN(P,2)
: STR(A$,30,2)=BIN(K,2)
: STR(A$,32,2)=BIN(A2,2)
0410 STR(A$,34,1)=" "
0420 STR(A$,35,6)=ALL(HEX(00))
0430 REM ALTERNATIVE KEY STRUCTURE DUPLICATE KEYS? KEY COMPRESSION? ORDINAL #,
START POS KEY, KEY LENGTH
0440 A1$(1)="NN" & BIN(1,2) & BIN(5,2) & BIN(26,2)
0450 A1$(2)="YN" & BIN(2,2) & BIN(77,2) & BIN(2,2)
0460 GOSUB '200(N$,T$,M$,O$,A$,A1$())
0470 IF V0$<>HEX(FF)THEN STOP "ERROR IN CREATE"
0480 IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN SMB HEADER"
0490 REM % WRITE RECORDS TO INIT FILE
0500 PRINT "TEST INDEXED WRITE"
0510 FOR I=1TO A
0520 READ E$,E1$,E2$,E3$,E4$,E5$
: IF D$<>"Y" THEN 540
: PRINT AT(10,0,800);"WRITING RECORD FOR EMPLOYEE NUMBER: ";E$
0530 PRINT ,"EMPLOYEE NAME: ";E1$
: PRINT ,"EMPLOYEE ADDRESS: ";E2$
: PRINT ,"EMPLOYEE CITY: ";E3$
: PRINT ,"EMPLOYEE STATE: ";E4$,"EMPLOYEE ZIP :";E5$
: PRINT
0540 E9$(I)=E$
0550 $PACK (F=W$) S$ FROM E$,E1$,E2$,E3$,E4$,E5$
0560 GOSUB '111(V9$,V7$,HEX(0000),S$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN WRITE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN WRITE SMB HEADER"
0570 IF E$<B$ THEN B$=E$
: IF E$>B1$ THEN B1$=E$
0580 NEXT I
0590 REM % CLOSE FILE
0600 PRINT "CLOSE FILE"
0610 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
0620 REM % RE-OPEN FILE TO VERIFY WRITE USING READ NEXT
0630 PRINT AT(5,0,1600);"RE-OPEN FILE (READ ONLY) TO VERIFY WRITE USING READ N
EXT"
0640 GOSUB '101(N$,T$,"R")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
0650 REM % READ A RECORD
: F9$="00000"
0660 IF D$<>"Y" THEN 670
: PRINT AT(7,0,800);"READ NEXT EMPLOYEE RECORD"
0670 IF F9$<>"00000" THEN 680
: GOSUB '109(V9$,V7$,"H",0,0,5,B$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN READ"
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN READ SMB NEXT"
: GOTO 690
0680 GOSUB '110(V9$,V7$,"H",0)
: IF STR(V7$,6,1)=HEX(00)THEN 690
: IF STR(V7$,8,2)=HEX(0019) THEN 750
: STOP "ERROR IN READ SMB NEXT"
0690 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
: IF E$<F9$ THEN STOP "ERROR IN FILE SEQUENCING"#
: F9$=E$
0700 IF D$<>"Y" THEN 710
: PRINT ,"EMPLOYEE NUMBER: ";E$
: PRINT ,"EMPLOYEE NAME: ";E1$
: PRINT ,"EMPLOYEE ADDRESS: ";E2$
: PRINT ,"EMPLOYEE CITY: ";E3$
: PRINT ,"EMPLOYEE STATE: ";E4$,"EMPLOYEE ZIP :";E5$
: PRINT
0710 REM VERIFY DATA
: RESTORE
0720 READ F$,F1$,F2$,F3$,F4$,F5$
: IF E$<>F$ THEN 720
: IF E1$<>F1$ OR E2$<>F2$ OR E3$<>F3$ OR E4$<>F4$ OR E5$<>F5$ THEN STOP "IN
VALID DATA READ"
0730 GOTO 660
0740 REM % CLOSE FILE
0750 PRINT "CLOSE FILE"
0760 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
0770 REM % RE-OPEN FILE FOR READ HOLD, DELETE & WRITE
0780 PRINT AT(5,0,1600);"RE-OPEN FILE FOR READ HOLD, DELETE & WRITE TEST"
0790 GOSUB '101(N$,T$,"X")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
0800 REM % READ A RECORD
: RESTORE
0810 FOR I=1TO A
: IF D$<>"Y" THEN 820
: PRINT AT(7,0,800);"READ RECORD FOR EMPLOYEE NUMBER:";E9$(I)
0820 GOSUB '109(V9$,V7$,"H",0,0,K,E9$(I))
: IF V0$<>HEX(FF)THEN STOP "ERROR IN READ"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN READ SMB"
0830 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
0840 PRINT
: PRINT ,"EMPLOYEE NAME: ";E1$
: PRINT ,"EMPLOYEE ADDRESS: ";E2$
: PRINT ,"EMPLOYEE CITY: ";E3$
: PRINT ,"EMPLOYEE STATE: ";E4$,"EMPLOYEE ZIP :";E5$
: PRINT
0850 REM VERIFY DATA
: READ F$,F1$,F2$,F3$,F4$,F5$
: IF E$<>F$ OR E1$<>F1$ OR E2$<>F2$ OR E3$<>F3$ OR E4$<>F4$ OR E5$<>F5$ THE
N STOP "INVALID DATA READ"
0860 REM % DELETE RECORD
0870 IF D$<>"Y" THEN 880
: PRINT AT(7,0,80);"DELETE RECORD FOR EMPLOYEE: ";E9$(I)
0880 GOSUB '113(V9$,V7$)
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN DELETE"
0890 REM % WRITE RECORD WITH NEW EMPLOYEE ID
0900 CONVERT I*500 TO E$, (#####)
0910 $PACK (F=W$) S$ FROM E$,E1$,E2$,E3$,E4$,E5$
0920 PRINT AT(7,0,80);"REWRITE RECORD FOR EMPLOYEE NUMBER:";E9$(I)
0930 GOSUB '111(V9$,V7$,HEX(0000),S$)
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN WRITE SMB HEADER"
0940 NEXT I
0950 REM % CLOSE FILE
0960 PRINT "CLOSE FILE"
0970 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
0980 REM % RE-OPEN FILE FOR RANDOM READS USING PRIMARY KEY
0990 GOSUB '101(N$,T$,"R")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
1000 REM % GENERATE RANDOM NUMBER FOR EMPLOYEE NUMBER
1010 FOR I = 1 TO A
: X=INT(RND(1)*A)+1
: CONVERT X*500 TO E$, (#####)
: PRINT AT(7,0,800);"FIND RECORD WITH PRIMARY KEY OF ";E$
1020 REM % READ DATA FROM DATA STRUCTURE
1030 RESTORE LINE 1980
: RESTORE (X-1)*6+1
: READ F$,F1$,F2$,F3$,F4$,F5$
1040 PRINT
: PRINT ,"EMPLOYEE NAME: ";F1$
: PRINT ,"EMPLOYEE ADDRESS: ";F2$
: PRINT ,"EMPLOYEE CITY: ";F3$
: PRINT ,"EMPLOYEE STATE: ";F4$,"EMPLOYEE ZIP :";F5$
: PRINT
1050 REM % FIND RECORD
1060 GOSUB '114 (V9$,V7$,HEX(8080),0,0,5,E$)
: IF V0$<>HEX(FF) THEN STOP "ERROR IN FIND "#
1070 REM % UNPACK DATA AND COMPARE AGAINST STRUCTURE EXCEPT EMPLOYEE #
1080 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
: IF E1$<>F1$ OR E2$<>F2$ OR E3$<>F3$ OR E4$<>F4$ OR E5$<>F5$ THEN STOP "IN
VALID DATA READ"
1090 REM LOOP
: NEXT I
1100 REM % CLOSE FILE
1110 PRINT "CLOSE FILE"
1120 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
1130 REM % RE-OPEN FILE AND TEST FIND WITH ALTERNATE KEYS
1140 GOSUB '101(N$,T$,"X")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
1150 REM % GENERATE RANDOM NUMBER FOR EMPLOYEE NUMBER
1160 FOR I = 1 TO A
: X=INT(RND(1)*A)+1
1170 REM % READ DATA FROM DATA STRUCTURE
1180 RESTORE (X-1)*6+1
: READ F$,F1$,F2$,F3$,F4$,F5$
1190 PRINT AT(7,0,800);"FIND/READ A RECORD WITH 1ST ALTERNATE KEY OF ";F1$
1200 PRINT
: PRINT ,"EMPLOYEE NAME: ";F1$
: PRINT ,"EMPLOYEE ADDRESS: ";F2$
: PRINT ,"EMPLOYEE CITY: ";F3$
: PRINT ,"EMPLOYEE STATE: ";F4$,"EMPLOYEE ZIP :";F5$
: PRINT
1210 REM % FIND RECORD
1220 GOSUB '114 (V9$,V7$,HEX(8080),0,1,26,F1$)
: IF V0$<>HEX(FF) THEN STOP "ERROR IN FIND "#
1230 REM % UNPACK DATA AND COMPARE AGAINST STRUCTURE EXCEPT EMPLOYEE #
1240 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
: IF E1$<>F1$ OR E2$<>F2$ OR E3$<>F3$ OR E4$<>F4$ OR E5$<>F5$ THEN STOP "IN
VALID DATA IN A FIND"
: CONVERT X*500 TO F$, (#####)
: IF F$<>E$ THEN STOP "INVALID EMPLYEE # "#
1244 REM % TEST READ WITH ALTERNATE KEYS
1245 GOSUB '109(V9$,V7$,"H",0,1,26,F1$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN READ "#
1246 REM % UNPACK DATA AND COMPARE AGAINST STRUCTURE EXCEPT EMPLOYEE #
1247 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
: IF E1$<>F1$ OR E2$<>F2$ OR E3$<>F3$ OR E4$<>F4$ OR E5$<>F5$ THEN STOP "IN
VALID DATA IN A READ"
: CONVERT X*500 TO F$, (#####)
: IF F$<>E$ THEN STOP "INVALID EMPLYEE # "#
1250 REM LOOP
: NEXT I
1260 REM % CLOSE FILE
1270 PRINT "CLOSE FILE"
1280 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
1290 REM % RE-OPEN FILE AND TEST FIND WITH ALTERNATE KEYS
1300 GOSUB '101(N$,T$,"S")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
1310 REM % SET EMPLOYEE NAME ALTERNATE KEY
: F1$=ALL(" ")
1320 REM % FIND 1ST RECORD >= F1$
1330 PRINT AT(7,0,800);"FIND RECORD WITH 1ST ALTERNATE KEY GREATER THAN OR EQU
AL TO ";F1$
1340 REM % FIND RECORD
1350 GOSUB '114 (V9$,V7$,HEX(2080),0,1,26,F1$)
: IF V0$=HEX(FF) THEN 1370
: IF STR(V7$,8,2)=HEX(0018) THEN 1410
: STOP "ERROR IN FIND "#
1360 REM CHECK IF MEETS SEARCH CRITERIA
1370 S$=STR(V9$(),1,V1)
: $UNPACK (F=W$) S$ TO E$,E1$,E2$,E3$,E4$,E5$
: IF E1$<F1$ THEN STOP "INVALID DATA READ" #
: F1$=E1$
1380 PRINT
: PRINT ,"EMPLOYEE NAME: ";E1$
: PRINT ,"EMPLOYEE ADDRESS: ";E2$
: PRINT ,"EMPLOYEE CITY: ";E3$
: PRINT ,"EMPLOYEE STATE: ";E4$,"EMPLOYEE ZIP :";E5$
: PRINT
1390 REM LOOP
: GOTO 1330
1400 REM % CLOSE FILE
1410 PRINT "CLOSE FILE"
1420 GOSUB '102(V9$,V7$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
1425 GOTO 1670
1430 REM % TEST INDEXED LOCK
1440 REM OPEN SAME FILE SHARED TWICE, LOCK ONE AND ATTEMPT TO READ SECOND
1450 PRINT "RE-OPEN FILE FOR INDEXED LOCK TEST"
1460 GOSUB '101(N$,T$,"S")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
1470 DIM F$(2)2,F1$(2)32
1480 F$(1)=V9$
: F1$(1)=V7$
1490 GOSUB '101(N$,T$,"S")
: IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB"
1500 F$(2)=V9$
: F1$(2)=V7$
1510 REM GENERATE 5 RANDOM KEYS AND TEST EACH
: FOR I = 1 TO 5
: X=INT(RND(1)*A)+1
: CONVERT X*500 TO E$, (#####)
1520 REM LOCK FILE 1
: IF D$="Y" THEN PRINT "LOCK FILE BASED ON PRIMARY KEY = ";E$
1530 GOSUB '115 (F$(1),F1$(1),0,0,5,E$)
: IF V0$<>HEX(FF) THEN STOP "ERROR IN LOCK"
1540 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN LOCK SMB HEADER"
1550 REM ATTEMPT TO READ RECORD
: GOSUB '109(F$(2),F1$(2),"H",0,0,5,E$)
: IF V0$=HEX(FF)THEN STOP "EXPECTED ERROR NOT REPORTED"
: IF STR(V7$,6,1)=HEX(00) THEN STOP "EXPECTED ERROR NOT REPORTED"
: IF STR(V7$,8,2)<>HEX(002A) THEN STOP "IMPROPER ERROR CODE REPORTED FOR LO
CKED RECORD"
1560 REM NEXT RECORD
: NEXT I
1570 REM UNLOCK FILE 1
: IF D$="Y" THEN PRINT "UNLOCK FILE 1"
1580 GOSUB '116 (F$(1),F1$(1))
: IF V0$<>HEX(FF) THEN STOP "ERROR IN UNLOCK"
1590 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN UNLOCK SMB HEADER"
1600 REM UNLOCK FILE 2
: IF D$="Y" THEN PRINT "UNLOCK FILE 2"
1610 GOSUB '116 (F$(2),F1$(2))
: IF V0$<>HEX(FF) THEN STOP "ERROR IN UNLOCK"
1620 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN UNLOCK SMB HEADER"
1630 REM CLOSE FILE 1
: IF D$="Y" THEN PRINT "CLOSE FILE"
1640 GOSUB '102(F$(1),F1$(1))
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
1650 REM CLOSE FILE 2
: IF D$="Y" THEN PRINT "CLOSE FILE"
1660 GOSUB '102(F$(2),F1$(2))
: IF V0$<>HEX(FF)THEN STOP "ERROR IN CLOSE"
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CLOSE SMB HEADER"
1670 REM % TEST OPEN MODES
: PRINT "TEST OPEN MODES - READONLY"
: T$="I"
: GOSUB '101(N$,T$,"R")
: IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN -READONLY"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN OPEN - READONLY"#
1675 REM WRITE SHOULD FAIL
: F$(1)=V9$
: F1$(1)=V7$
: RESTORE
: READ E$,E1$,E2$,E3$,E4$,E5$
: $PACK (F=W$) S$ FROM E$,E1$,E2$,E3$,E4$,E5$
1680 GOSUB '111(V9$,V7$,HEX(0000),S$)
: IF STR(V7$,8,2)<>HEX(001D) THEN STOP "ERROR IN READONLY - WRITE SUCCEEDS!
"#
1685 REM REWRITE SHOULD FAIL
: B$="00500"
: GOSUB '109(V9$,V7$,"H",0,0,5,B$)
: IF V0$<>HEX(FF) THEN STOP "READ ERROR - READONLY"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "READ SMB ERROR - READONLY"#
1690 GOSUB '112(V9$,V7$,HEX(0000),84,V9$())
: IF STR(V7$,8,2)<>HEX(001D) THEN STOP "ERROR IN READONLY - REWRITE SUCCEED
S!"#
1695 REM OPEN IN SHARED SHOULD FAIL
: GOSUB '101(N$,T$,"S")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READONLY - CAN OPEN SHARED
!"#
1700 REM OPEN IN EXCLUSIVE SHOULD FAIL
: GOSUB '101(N$,T$,"X")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READONLY - CAN OPEN EXCLUS
IVE!"#
1705 REM OPEN IN EXTENDED SHOULD FAIL
: GOSUB '101(N$,T$,"E")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READONLY - CAN OPEN EXTEND
ED!"#
1710 REM CLOSE FILE
: GOSUB '102(F$(1),F1$(1))
: IF V0$<>HEX(FF) THEN STOP "ERROR IN CLOSE - READONLY"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - READONLY"#
1720 REM % TEST OPEN MODES
: PRINT "TEST OPEN MODES - SHARED"
: T$="I"
: GOSUB '101(N$,T$,"S")
: IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN -SHARED"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN OPEN - SHARED"#
1725 REM OPEN IN EXCLUSIVE SHOULD FAIL
: F$(1)=V9$
: F1$(1)=V7$
: GOSUB '101(N$,T$,"X")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - CAN OPEN EXCLUSIV
E!"#
1730 REM OPEN IN EXTENDED SHOULD FAIL
: GOSUB '101(N$,T$,"X")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - CAN OPEN EXTENDED
!"#
1735 REM OPEN IN READONLY SHOULD FAIL
: GOSUB '101(N$,T$,"X")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - CAN OPEN READONLY
!"#
1740 REM CLOSE FILE
: GOSUB '102(F$(1),F1$(1))
: IF V0$<>HEX(FF) THEN STOP "ERROR IN CLOSE - SHARED"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - SHARED"#
1750 REM % TEST OPEN MODES
: PRINT "TEST OPEN MODES - EXCLUSIVE"
: T$="I"
: GOSUB '101(N$,T$,"X")
: IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN -EXCLUSIVE"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN OPEN - EXCLUSIVE"#
1755 REM OPEN IN EXTENDED SHOULD FAIL
: F$(1)=V9$
: F1$(1)=V7$
: GOSUB '101(N$,T$,"E")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - CAN OPEN EXTEN
DED!"#
1760 REM OPEN IN READONLY SHOULD FAIL
: GOSUB '101(N$,T$,"R")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - CAN OPEN READO
NLY!"#
1765 REM OPEN IN SHARED SHOULD FAIL
: GOSUB '101(N$,T$,"S")
: IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - CAN OPEN SHARE
D!"#
1770 REM CLOSE FILE
: GOSUB '102(F$(1),F1$(1))
: IF V0$<>HEX(FF) THEN STOP "ERROR IN CLOSE - EXCLUSIVE"#
: IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - EXCLUSIVE"#
1780 REM % TEST OPEN MODES
: PRINT "TEST OPEN MODES - EXTENDED"
: T$="I"
: GOSUB '101(N$,T$,"E")
: IF STR(V7$,8,2)<>HEX(0037) THEN STOP "ERROR IN EXTENDED - CAN OPEN AN IND
EXED FILE!"#
1840 REM % TEST FILE RENAME
: STR(N1$,24,1)="9"
: PRINT "RENAME FILE FROM ";N$;" TO ";N1$
: GOSUB '202 (N$,N1$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN RENAME"#
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN RENAME SMB HEADER"#
1850 REM % TEST GET FILE ATTRIBUTES ON RENAMED FILE
: PRINT "TEST GET FILE ATTRIBUTES OF RENAMED FILE"
1860 GOSUB '203(N1$)
: IF V0$<>HEX(FF)THEN STOP "ERROR IN GET ATTRIBUTES"#
: IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN GET ATTRIBUTES SMB HEADER"#
1870 Z$=STR(V9$(),1,40)
1880 IF STR(Z$,1,4)<>"AFNA" THEN 1920
: IF STR(Z$,5,2)<>HEX(0000) THEN 1920
: IF VAL(STR(Z$,7,2),2)<>A THEN 1920
1890 IF STR(Z$,9,2)<>HEX(0000) THEN 1920
: IF VAL(STR(Z$,11,2),2)<>A1 THEN 1920
1900 REM TEST ATTRIBUTES VALUE
1910 GOTO 1930
1920 STOP "ERROR IN GET FILE ATTRIBUTE DATA"#
1930 REM % DELETE FILE
: PRINT "DELETE FILE - ";N1$
1940 GOSUB '201 (N1$)
: IF V0$<>HEX(FF) THEN STOP "ERROR IN FILE DELETE"
1950 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN FILE DELETE SMB HEADER"
1960 END
1970 REM DATA FOR CREATE
1980 DATA "12345","TOM SWIFT","1 JOSEPH STREET","ANDOVER","MA","01801"
1990 DATA "51038","MARGO THOMAS","43 BEVERLEE ROAD","TYNGSBORO","MA","01827"
2000 DATA "44880","PETER PAN","45 TENBY DRIVE","NASHUA","NH","03063"
2010 DATA "40726","JAMES T KIRK","10 WILDWOOD ROAD","STOW","MA","01775"
2020 DATA "51173","SCOTTIE","17 MAYNARD STREET","ARLINGTON","MA","01545"
2030 DATA "50333","PRINCESS LEAH","80A NASHUA ROAD","PEPPERELL","MA","01427"
2040 DATA "90265","HANS SOLO","27 HICKORY LANE","SALEM","NH","03060"
2050 DATA "50662","CLARK KENT","442 SARATOGA STREET #3","E. BOSTON","MA","0212
8"
2060 DATA "45556","JEFF BRADY","96 DUNSTABLE ROAD","N. CHELMSFORD","MA","01824
"
2070 DATA "51556","THELMA PARTRIDGE","36 BURLINGTON ROAD","BEDFORD","MA","9999
9"
2080 DATA "19801","JAMES OLSEN","15 FOREST ROAD","HUDSON","NH","99999"
2090 DATA "41793","LOIS LANE","51 PARRISH HILL DRIVE","NASHUA","NH","03063"
2100 DATA "10462","LEX LUTHER","4 QUEBEC STREET","METHEUN","MA","01844"
2110 DATA "07683","MARY TYLER MOORE","15 PLAIN ROAD","HOLLIS","NH","99999"
2120 DATA "08316","DICK VAN DYKE","211 FOSTER ROAD","TEWKSBURY","MA","01876"
2130 DATA "41856","FRED ROSEBUD","21 GOLDEN COVE ROAD","CHELMSFORD","MA","0182
4"
2140 DATA "02792","SIMPLE SIMON","526 ANDOVER STREET","MAWRENCE","MA","01843"
2150 DATA "09007","CINDERELLA","10 PARK AVENUE","DERRY","NH","03038"
2160 DATA "50783","MOTHER GOOSE","219 RT 13","BROOKLINE","NH","99999"
2170 DATA "41834","SAM WONDERFUL","16 PARK DRIVE","BURLINGTON","MA","01803"
2180 DATA "45184","ROGER DO TAXES","6 DENISE STREET","NASHUA","NH","03063"
2190 DATA "07818","CLARA BELL","39 BURTT STREET","LOWELL","MA","01851"
2200 DATA "00740","SOCK IT 2ME","OLD CANDIA ROAD RFD 1","CANDIA","NH","99999"
2210 DATA "08187","SOMEONE ANYONE","8 LUTHERAN DRIVE","NASHUA","NH","03063"
2220 DATA "07852","END FINI","66 NEWPORT DRIVE","WESTFORD","MA","01899"
2230 DATA " "," "," "," "," "," "
2248 DEFFN'101(V$,V1$,V2$)
2252 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(01)
: STR(V7$,23,2)=HEX(FFFF)
2254 V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(030202)
2256 IF STR(V$,1,2)<>"//"THEN 2278
2258 V1=POS(" IRCBS"=V1$)
: IF V1<11OR V1>15THEN 2278
: V2=2^V1
: STR(V8$(),4,2)=BIN(V2,2)
2260 V1=POS(" SXER"=V2$)
: IF V1<12OR V1>15THEN 2278
: V2=2^V1
: STR(V8$(),6,2)=BIN(V2,2)
2262 STR(V8$(),8,2)=BIN(8+LEN(V$),2)
2264 STR(V8$(),10,1)=HEX(04)
: STR(V8$(),11,LEN(V$)+1)=V$&HEX(00)
2266 V1=12+LEN(V$)
: STR(V8$(),V1,7)=HEX(04)&"FILE"&HEX(0000)
2268 GOSUB '199
: IF V0$=HEX(5A)THEN 2278
2270 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 2278
2272 V9$=STR(V9$(),34,2)
2274 V1=VAL(STR(V8$,3,2),2)-35
: STR(V9$(),,V1)=STR(V9$(),41,V1)
: STR(V9$(),V1+1)=ALL(" ")
2276 V0$=HEX(FF)
: RETURN
2278 V0$=HEX(00)
: RETURN
2306 DEFFN'199
2308 STR(V8$,7,1)=HEX(53)
2310 STR(V8$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50)
2314 $OPEN #3
: $GIO#3(466042708701,V8$)
: IF STR(V8$,1,1)<>HEX(80)THEN 2336
2318 V1=LEN(V8$())+34
: STR(V8$,6,2)=BIN(V1,2)
: $GIO#3(40E3426042701800A0001801A00040008701,V8$)V7$;STR(V8$(),,V1)
2320 IF STR(V8$,1,1)<>HEX(80)THEN 2336
2322 V9$()=ALL(" ")
: $GIO#3(870387041801C340,V8$)V8$;STR(V9$(),1,VAL(STR(V8$,3,2),2))
2324 $GIO#3(4000,V8$)
2328 V0$=HEX(FF)
2332 $CLOSE#3
: RETURN
2336 V0$=HEX(5A)
: GOTO 2332
2384 DEFFN'102(V9$,V7$)
2388 STR(V7$,6,4)=HEX(00020000)
2390 V8$()=ALL(" ")
: STR(V8$(),1,5)=HEX(02)&V9$&HEX(0000)
2392 STR(V8$(),6,6)=HEX(000301000000)
2394 GOSUB '199
: IF V0$<>HEX(FF)THEN 2402
2396 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 2404
2398 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
2400 V0$=HEX(FF)
2402 RETURN
2404 V0$=HEX(00)
: RETURN
3188 DEFFN'200(V$,V1$,V2$,V3$,STR(V9$(),1,40),STR(V9$(),41))
3192 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(23)
: STR(V7$,23,2)=HEX(FFFF)
3194 V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(040000)
3196 IF STR(V$,1,2)<>"//"THEN 3230
3198 IF V3$<>"T"AND V3$<>"C"AND V3$<>"O"THEN 3230
: IF V3$="C"THEN STR(V8$(),4,2)=HEX(0000)
: IF V3$="O"THEN STR(V8$(),4,2)=HEX(0001)
: IF V3$="T"THEN STR(V8$(),4,2)=HEX(0002)
3200 V1=POS(" IRCBS"=V1$)
: IF V1<11OR V1>15THEN 3230
: V2=2^V1
: STR(V8$(),6,2)=BIN(V2,2)
3202 V1=POS(" SXER"=V2$)
: IF V1<12OR V1>15THEN 3230
: V2=2^V1
: STR(V8$(),8,2)=BIN(V2,2)
3204 V1=LEN(V$)
: V2=(V1+2)+6+43
: V3=VAL(STR(V9$(),32,2),2)*8
: IF V1$="I"THEN V2=V2+V3+3
: STR(V8$(),10,2)=BIN(V2,2)
3206 STR(V8$(),12,1)=HEX(04)
: STR(V8$(),13,LEN(V$)+1)=V$&HEX(00)
3208 V1=14+LEN(V$)
: STR(V8$(),V1,6)=HEX(04)&"FILE"&HEX(00)
3210 V1=V1+6
: STR(V8$(),V1,43)=HEX(01)&BIN(40,2)&STR(V9$(),1,40)
: V1=V1+43
: IF V1$<>"I"THEN 3214
3212 STR(V8$(),V1,V3+3)=HEX(01)&BIN(V3,2)&STR(V9$(),41,V3)
: V1=V1+V3+3
3214 STR(V8$(),V1,1)=HEX(00)
3216 GOSUB '199
: IF V0$<>HEX(FF)THEN 3230
3218 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 3228
3220 IF V3$="O"THEN V9$=STR(V9$(),34,2)
3222 IF V3$="O"THEN V2=35
: ELSE V2=33
3224 V1=VAL(STR(V8$,3,2),2)-V2
: STR(V9$(),,V1)=STR(V9$(),V2+1,V1)
: STR(V9$(),V1+1)=ALL(" ")
3226 V0$=HEX(FF)
: RETURN
3228 V0$=HEX(A5)
: RETURN
3230 V0$=HEX(00)
: RETURN
3292 DEFFN'201(V$)
3296 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(17)
: STR(V7$,23,2)=HEX(FFFF)
3298 IF STR(V$,1,2)<>"//"THEN 3316
3300 STR(V8$(),1,3)=HEX(010000)
3302 V1=LEN(V$)
: STR(V8$(),4,2)=BIN(2+V1,2)
3304 STR(V8$(),6,V1+2)=HEX(04)&V$&HEX(00)
3306 V1=V1+8
: STR(V8$(),V1,1)=HEX(00)
3308 GOSUB '199
: IF V0$<>HEX(FF)THEN 3318
3310 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 3316
3312 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
3314 V0$=HEX(FF)
: RETURN
3316 V0$=HEX(00)
3318 RETURN
3384 DEFFN'202(V$,V9$())
3388 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(2A)
: STR(V7$,23,2)=HEX(FFFF)
3390 STR(V8$(),1,3)=HEX(010000)
3392 IF STR(V$,1,2)<>"//"OR STR(V9$(),1,2)<>"//"THEN 3410
3394 V1=LEN(V$)
: V2=LEN(V9$())
: STR(V8$(),4,2)=BIN(4+V1+V2,2)
3396 STR(V8$(),6,2+V1)=HEX(04)&V$&HEX(00)
3398 STR(V8$(),8+V1,V2+2)=HEX(04)&STR(V9$(),1,V2)&HEX(00)
3400 V1=10+V1+V2
: STR(V8$(),V1,1)=HEX(00)
3402 GOSUB '199
: IF V0$<>HEX(FF)THEN 3412
3404 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 3410
3406 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
3408 V0$=HEX(FF)
: RETURN
3410 V0$=HEX(00)
3412 RETURN
3528 DEFFN'203(V$)
3532 V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(1A)
: STR(V7$,23,2)=HEX(FFFF)
3534 V8$()=ALL(" ")
: STR(V8$(),1,5)=HEX(0200000000)
3536 IF STR(V$,1,2)<>"//"THEN 3552
3538 V1=LEN(V$)
: V2=(V1+2)+6
: STR(V8$(),6,2)=BIN(V2,2)
3540 STR(V8$(),8,V1+2)=HEX(04)&V$&HEX(00)
3542 V1=V1+10
: STR(V8$(),V1,7)=HEX(04)&"FILE"&HEX(0000)
3544 GOSUB '199
: IF V0$<>HEX(FF)THEN 3554
3546 V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 3552
3548 V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),39,V1)
: STR(V9$(),V1+1)=ALL(" ")
3550 V0$=HEX(FF)
: RETURN
3552 V0$=HEX(A5)
: RETURN
3554 V0$=HEX(00)
: RETURN
5058 DEFFN'109(V9$,V7$,V3$,V6,V4,V5,V6$)
5060 STR(V7$,7,1)=HEX(07)
5062 STR(V8$())=HEX(04)&V9$
5064 IF V3$=" "THEN STR(V8$(),4,2)=HEX(0000)
: ELSE STR(V8$(),4,2)="HH"
5066 STR(V8$(),6,2)=BIN(V6,2)
: STR(V8$(),8,2)=BIN(V4,2)
5068 STR(V8$(),10,V5+6)=BIN(V5+3,2)&HEX(01)&BIN(V5,2)&STR(V6$,1,V5)&HEX(00)
5070 GOSUB '199
: IF V0$<>HEX(FF)THEN 5080
5072 V4$=STR(V9$(),34,2)
5074 V7$=STR(V9$(),1,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 5082
5076 V1=VAL(STR(V9$(),39,2),2)
: STR(V9$(),1,V1)=STR(V9$(),41,V1)
5078 V0$=HEX(FF)
5080 RETURN
5082 V0$=HEX(00)
: RETURN
5130 DEFFN'110(V9$,V7$,V3$,V6)
5132 STR(V7$,7,1)=HEX(08)
5134 STR(V8$())=HEX(03)&V9$
5136 IF V3$=" "THEN STR(V8$(),4,2)=HEX(0000)
: ELSE STR(V8$(),4,2)="HH"
5138 STR(V8$(),6,2)=BIN(V6,2)
: STR(V8$(),8,2)=HEX(0000)
5140 STR(V8$(),10,1)=HEX(00)
5142 GOSUB '199
: IF V0$<>HEX(FF)THEN 5150
5143 REM /P30F301769/RAM/12 OCT., '90/ MOVE MASK TO V4$
: V4$=STR(V9$(),34,2)
5144 V7$=STR(V9$(),1,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 5152
5146 V1=VAL(STR(V9$(),39,2),2)
: V9$()=STR(V9$(),41,V1)
5148 V0$=HEX(FF)
5150 RETURN
5152 V0$=HEX(00)
: RETURN
5196 DEFFN'111(V9$,V7$,V4$,V9$())
5198 STR(V7$,7,1)=HEX(10)
5200 STR(V8$())=HEX(02)&V9$
5202 V1=LEN(V9$())
: STR(V8$(),4,V1+8)=V4$&BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(0
0)
5206 GOSUB '199
: IF V0$<>HEX(FF)THEN 5212
5208 V7$=STR(V9$(),1,32)
5210 V0$=HEX(FF)
5212 RETURN
5248 DEFFN'113(V9$,V7$)
5250 STR(V7$,7,1)=HEX(19)
5252 STR(V8$())=HEX(01)&V9$&HEX(0000)&HEX(00)
5256 GOSUB '199
: IF V0$<>HEX(FF)THEN 5262
5258 V7$=STR(V9$(),1,32)
5260 V0$=HEX(FF)
5262 RETURN
5308 DEFFN'112(V9$,V7$,V4$,V1,V9$())
5310 STR(V7$,7,1)=HEX(15)
5312 STR(V8$())=HEX(02)&V9$&V4$
5314 STR(V8$(),6)=BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(00)
5318 GOSUB '199
: IF V0$<>HEX(FF)THEN 5324
5320 V7$=STR(V9$(),1,32)
5322 V0$=HEX(FF)
5324 RETURN
5390 DEFFN'114(V9$,V7$,V5$,V3,V4,V5,V6$)
5392 STR(V7$,7,1)=HEX(26)
5394 STR(V8$())=HEX(04)&V9$&V5$
5396 STR(V8$(),6)=BIN(V3,2)&BIN(V4,2)&BIN(V5+3,2)&HEX(01)&BIN(V5,2)&STR(V6$,,V
5)&HEX(00)
5400 GOSUB '199
: IF V0$<>HEX(FF)THEN 5410
5402 V4$=STR(V9$(),34,2)
: V7$=STR(V9$(),1,32)
: IF STR(V7$,6,1)<>HEX(00)THEN 5412
5404 V1=VAL(STR(V9$(),39,2),2)
5406 STR(V9$(),,V1)=STR(V9$(),41,V1)
5408 V0$=HEX(FF)
5410 RETURN
5412 V0$=HEX(00)
: RETURN
5456 DEFFN'115(V9$,V7$,V3,V4,V5,V6$)
5458 STR(V7$,7,1)=HEX(1E)
5462 V8$()=HEX(05)&V9$&HEX(0000)&HEX(0000)&BIN(V3,2)&BIN(V4,2)
5464 STR(V8$(),12,V5+6)=BIN(V5+3,2)&HEX(01)&BIN(V5,2)&STR(V6$,,V5)&HEX(00)
5466 GOSUB '199
: IF V0$<>HEX(FF)THEN 5472
5468 V7$=STR(V9$(),1,32)
5470 V0$=HEX(FF)
5472 RETURN
5506 DEFFN'116(V9$,V7$)
5508 STR(V7$,7,1)=HEX(21)
5510 V8$()=HEX(01)&V9$&HEX(0000)&HEX(00)
5512 GOSUB '199
: IF V0$<>HEX(FF)THEN 5518
5514 V7$=STR(V9$(),1,32)
5516 V0$=HEX(FF)
5518 RETURN
9990 DEFFN'31"N$=";HEX(22);"TESTIDX1";HEX(22);":SCRATCH T N$: SAVE T () N$"