Listing of file='TESTCON1' on disk='vmedia/731-8012A.wvd.zip'
# Sector 869, program filename = 'TESTCON1' 0010 REM TESTCON1 24 OCT 1990 0020 REM % (c) Copyright Wang Laboratories, Inc. 1986 0030 REM PROGRAM NAME - TEST CONSECUTIVE FILE FUNCTIONALITY 0040 REM DATE OF FIRST CODE - 26 JUNE 1986 0050 REM DATEOF LATEST UPDATE - 06 OCT 86 ADD BLOCK READ/WRITE 0051 REM RENAME & GET ATTRIBTUTES 0060 REM /CONSECUTIVE LOCK and UNLOCK/If the mode is SHARED for CONSECUTIVE fi le, then the file is opened in SHARED I/0 mode for 2200SRV Rel 01.60.00 a nd above/ Ram/19 Oct., '90/ 0070 REM RAM/INCLUDED TEST OPEN MODES/24 OCT., '90 0080 REM 0090 REM 0100 REM 0110 DIM N$32,T$1,M$1,A$40,A1$8,D$1,C$1,B$(16,16)8,N1$32,Z$62 0120 REM DEBUG FLAG : D$="Y" : REM FILE EXISTS OR CREATE FLAG : C$="C" 0130 REM % TEST PARAMETERS 0140 REM TEST FILE NAME : N$,N1$="///FRANK/OMTLIB/TESTCON" 0150 REM TEST FILE SIZE : A = 100 0160 REM TEST RECORD SIZE : A1=256 0170 REM READ TIMEOUT : T=0 0180 REM TEST RECORD VARIABLE : DIM S$(16),S1$(16) : S$(),S1$()="THIS IS RECORD ####" 0190 REM % VARIABLE DIMENSIONS 0200 DIM V$32,V1$1,V2$1,V3$1,V4$2,V5$2,V6$6 0210 DIM V7$32,V8$,V8$(16,16)10,V9$2,V9$(16,16) 0220 REM % START OF TEST 0230 PRINT HEX(03);TAB(26);"TEST CONSECUTIVE FILE FUNCTIONALITY" 0240 DIM T$1,T1$1,A0$3 : A0$="07C" 0250 PRINT AT(3,0,240);"Enter the Communication Address of the desired 2258 Co ntroller" 0260 LINPUT -A0$ 0270 IF VER(A0$,"HHH")<>3THEN 250 : HEXPACKT$FROMSTR(A0$,2,2) : T1$=T$ 0280 T$=T1$ : T$=OR HEX(03) : HEXUNPACKT$TO STR(A0$,2,2) : SELECT #3<A0$> 0290 T$="C" : M$="X" : IF C$="E" THEN 580 0300 REM % CREATE WORK FILE 0310 PRINT AT(3,0,240);"CREATE A CONSECUTIVE FILE OF";A;"RECORDS." 0320 O$="O" 0330 A$="CFAN" 0340 REM NO OF RECORDS : STR(A$,5,2)=HEX(0000) : STR(A$,7,2)=BIN(A,2) 0350 REM RECORD SIZE : STR(A$,9,2)=HEX(0000) : STR(A$,11,2)=BIN(A1,2) 0360 REM BLOCK ALLOCATION : STR(A$,13,4)=HEX(00000000) 0370 REM BLOCK SIZE : STR(A$,17,4)=HEX(00000000) 0380 REM RETENTION PERIOD : STR(A$,21,6)=ALL(HEX(00)) 0390 REM WP PROLOGUE : STR(A$,27,1)=" " 0400 REM PRIMARY KEY POS, HEY LENGTH & ALTERNATE : STR(A$,28,2),STR(A$,30,2),STR(A$,32,2)=HEX(0000) 0410 REM TAKE CREATED AREA : STR(A$,34,1)=" " 0420 REM PRINT FORM #, PRINT CLASS,DEVICE #, # COPIES, HOLD RELEASE, DISPOS : STR(A$,35,6)=ALL(HEX(00)) 0430 REM ALTERNATE KEY PARATMETERS 0440 A1$=ALL(" ") 0450 GOSUB '200(N$,T$,M$,O$,A$,A1$) 0460 IF V0$<>HEX(FF)THEN STOP "ERROR IN CREATE" 0470 IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN SMB HEADER" 0480 REM % WRITE RECORDS TO INIT FILE 0490 PRINT "TEST CONSECUTIVE WRITE" 0500 FOR I=1TO A : IF D$="Y" THEN PRINT "WRITING RECORD:";I 0510 CONVERT I TO STR(S$(),16,4), (####) 0520 GOSUB '104(V9$,V7$,S$()) : IF V0$<>HEX(FF)THEN STOP "ERROR IN CONSECUTIVE WRITE" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN CONSECUTIVE WRITE SMB HEADER" 0530 NEXT I 0540 REM % CLOSE FILE 0550 PRINT "CLOSE FILE" 0560 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" 0570 REM % RE-OPEN FILE FOR READ & RE-WRITE 0580 PRINT "RE-OPEN FILE FOR READ HOLD & REWRITE TEST" 0590 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" 0600 REM % READ A RECORD 0610 FOR I=1TO A : IF D$="Y" THEN PRINT "READ RECORD:";I 0620 GOSUB '103(V9$,V7$,"H",T) : IF V0$<>HEX(FF)THEN STOP "ERROR IN READ" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN READ SMB" 0630 S$()=STR(V9$(),9,A1) 0640 CONVERT I TO STR(S1$(),16,4), (####) : IF S$()<>S1$() THEN STOP "ERROR ON READ - INVALID DATA" 0650 REM % RE-WRITE A RECORD 0660 IF D$="Y" THEN PRINT "RE-WRITE RECORD:";I 0670 CONVERT 500+I TO STR(S$(),16,4),(####) 0680 GOSUB '105(V9$,V7$,A1,S$()) : IF V0$<>HEX(FF)THEN STOP "ERROR IN RE-WRITE" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN RE-WRITE SMB HEADER" 0690 NEXT I 0700 REM % CLOSE FILE 0710 PRINT "CLOSE FILE" 0720 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" 0730 REM % RE-OPEN FILE FOR SKIP TEST 0740 PRINT "RE-OPEN FILE FOR SKIP TEST" 0750 GOSUB '101(N$,T$,M$) : IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB" 0760 REM % SKIP TEST 0770 C=1 : FOR J=1TO A : I=INT(RND(1)*A)+1 0780 IF D$<>"Y" THEN 810 0790 PRINT : PRINT "CURRENTLY POINTING AT RECORD:";C : PRINT "RECORD TO BE READ:";I 0800 REM SKIP TO PROPER RECORD : PRINT "RECORDS TO BE SKIPPED:";I-C 0810 REM SKIP TO PROPER RECORD : R=I-C 0820 GOSUB '106 (V9$,V7$,R) : IF V0$<>HEX(FF) THEN STOP "ERROR IN SKIP" 0830 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN SMB HEADER FOR SKIP" 0840 REM % READ ERROR AND VERIFY DATA 0850 IF D$="Y" THEN PRINT "READ RECORD TO VERIFY SKIP. EXPECT TO READ RECORD:" ;I 0860 GOSUB '103(V9$,V7$,"H",0) : IF V0$<>HEX(FF)THEN STOP "ERROR IN READ" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN READ SMB" 0870 S$()=STR(V9$(),9,A1) 0880 CONVERT 500+I TO STR(S1$(),16,4), (####) : IF S$()<>S1$() THEN STOP "ERROR ON READ - INVALID DATA" 0890 C=I+1 : NEXT J 0900 REM % CLOSE FILE 0910 IF D$="Y" THEN PRINT "CLOSE FILE - END OF SKIP TEST" 0920 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" 0930 REM % READ RELATIVE TEST 0940 PRINT "RE-OPEN FILE FOR READ RELATIVE TEST" 0950 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" 0960 REM % READ A RECORDS RANDOMLY 0970 FOR I = 1 TO A : J=INT(A*RND(1))+1 : IF D$="Y" THEN PRINT "READ RECORD NO:";J 0980 GOSUB '117(V9$,V7$,"H",J,1) : IF V0$<>HEX(FF)THEN STOP "ERROR IN READ" : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN READ SMB" 0990 REM VERIFY DATA : CONVERT 500+J TO STR(S1$(),16,4), (####) : S$()=STR(V9$(),9,VAL(STR(V9$(),7,2),2)) : IF S$()<>S1$() THEN STOP "ERROR ON READ - INVALID DATA" 1000 NEXT I 1010 REM % CLOSE FILE : PRINT "CLOSE FILE FOR READ RELATIVE TEST" 1020 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" 1030 REM % TEST CONSECUTIVE LOCK 1040 PRINT "RE-OPEN FILE FOR CONSECUTIVE LOCK TEST" 1050 REM FILE OPEN = EXTENDED 1060 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" 1070 DIM F$(2)2,F1$(2)32 1080 F$(1)=V9$ : F1$(1)=V7$ 1090 REM LOCK FILE 1 : IF D$="Y" THEN PRINT "LOCK FILE" 1100 GOSUB '107 (F$(1),F1$(1),V2$) : IF V0$<>HEX(FF) THEN STOP "ERROR IN LOCK" 1110 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN LOCK SMB HEADER" 1120 REM UNLOCK FILE 1 : IF D$="Y" THEN PRINT "UNLOCK FILE" 1130 GOSUB '108 (F$(1),F1$(1)) : IF V0$<>HEX(FF) THEN STOP "ERROR IN UNLOCK" 1140 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN UNLOCK SMB HEADER" 1150 REM CLOSE FILE 1 : IF D$="Y" THEN PRINT "CLOSE FILE" 1160 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" 1170 REM % TEST BLOCK READ/WRITE 1175 PRINT "TEST BLOCK READ" 1180 REM OPEN FILE IN BLOCK MODE : GOSUB '101 (N$,"B","X") : IF V0$<>HEX(FF)THEN STOP "ERROR IN OPEN"# : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN OPEN SMB HEADER"# 1185 B= INT(A/8) : REM # OF BLOCKS 1190 REM BLOCK READ : FOR I = 1 TO B : GOSUB '121 (V9$,V7$,I) : IF V0$<>HEX(FF)THEN STOP "ERROR IN BLOCK READ"# : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN BLOCK READ SMB HEADER"# 1200 FOR J = 1 TO 8 : CONVERT 500+(I-1)*8+J TO STR(S$(),16,4),(####) : IF S$()<>STR(V9$(),(J-1)*256+1,256) THEN STOP "ERROR IN BLOCK READ "# 1210 CONVERT (I-1)*8+J TO STR(V9$(),(J-1)*256+16,4),(####) : NEXT J 1220 REM WRITE UPDATED BLOCK : GOSUB '122(V9$,V7$,I,V9$()) : IF V0$<>HEX(FF)THEN STOP "ERROR IN BLOCK WRITE"# : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN BLOCK WRITE SMB HEADER"# 1224 NEXT I 1225 REM TEST BLOCK WRITE : PRINT "TEST BLOCK WRITE" 1230 REM CHECK BLOCK WRITE DATA 1240 REM BLOCK READ : FOR I = 1 TO B : GOSUB '121 (V9$,V7$,I) : IF V0$<>HEX(FF)THEN STOP "ERROR IN BLOCK READ"# : IF STR(V7$,6,1)<>HEX(00)THEN STOP "ERROR IN BLOCK READ SMB HEADER"# 1250 FOR J = 1 TO 8 : CONVERT (I-1)*8+J TO STR(S$(),16,4),(####) : IF S$()<>STR(V9$(),(J-1)*256+1,256) THEN STOP "ERROR IN BLOCK WRITE"# : NEXT J,I 1260 REM CLOSE FILE : 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"# 1270 REM % TEST OPEN MODES : PRINT "TEST OPEN MODES - READONLY" : T$="C" : GOSUB '101(N$,T$,"R") : IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN - READONLY MODE" : IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN READONLY MODE SMB HEADER" 1280 REM WRITE SHOULD FAIL : F$(1)=V9$ : F1$(1)=V7$ : S$()="THIS WRITE SHOULD FAIL! " : GOSUB '104(V9$,V7$,S$()) : IF STR(V7$,8,2)<>HEX(002B) THEN STOP "ERROR IN READONLY MODE - WRITE SUCC EEDS!"# 1290 REM READ AND REWRITE : GOSUB '103(V9$,V7$,"H",T) : IF V0$<>HEX(FF) THEN STOP "ERROR IN READ - READONLY MODE"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN READ - READONLY MODE"# 1300 REM REWRITE SHOULD FAIL : GOSUB '105(V9$,V7$,A,V9$()) : IF STR(V7$,8,2)<>HEX(002B) THEN STOP "ERROR IN READONLY MODE - REWRITE S UCCEEDS!"# 1310 REM OPEN IN EXCLUSIVE SHOULD FAIL : GOSUB '101(N$,T$,"X") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READ ONLY - OPEN IN EXCLUS IVE MODE SUCCEEDS!"# 1320 REM OPEN IN EXTENDED SHOULD FAIL : GOSUB '101(N$,T$,"E") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READ ONLY - OPEN IN EXTEND ED MODE SUCCEEDS!"# 1330 REM OPEN IN SHARED SHOULD FAIL : GOSUB '101(N$,T$,"S") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN READONLY - OPEN IN SHARED MODE SUCCEEDS!"# 1340 REM CLOSE FILES : GOSUB '102(F$(1),F1$(1)) : IF V0$<>HEX(FF) THEN STOP "CLOSE FAILS - READONLY"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - READONLY"# 1350 REM % TEST OPEN MODES : PRINT "TEST OPEN MODES - SHARED" : T$="C" : GOSUB '101 (N$,T$,"S") : IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN - SHARED MODE"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN SHARED MODE SMB HEADER"# 1360 F$(1)=V9$ : F1$(1)=V7$ : REM OPEN IN EXCLUSIVE SHOULD FAIL : GOSUB '101(N$,T$,"X") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - OPEN IN EXCLUSIVE MODE SUCCEEDS!"# 1370 REM OPEN IN EXTENDED SHOULD FAIL : GOSUB '101(N$,T$,"E") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - OPEN IN EXTENDED MODE SUCCEEDS!"# 1380 REM OPEN IN READONLY SHOULD FAIL : GOSUB '101(N$,T$,"R") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN SHARED - OPEN IN READONLY SUCCEEDS!"# 1400 REM CLOSE FILES : GOSUB '102(F$(1),F1$(1)) : IF V0$<>HEX(FF) THEN STOP "CLOSE FAILS - SHARED"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - SHARED"# 1410 REM % TEST OPEN MODES : PRINT "TEST OPEN MODES - EXCLUSIVE" : T$="C" : GOSUB '101 (N$,T$,"X") : IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN - EXCLUSIVE MODE"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN EXCLUSIVE MODE SMB HEADER"# 1420 F$(1)=V9$ : F1$(1)=V7$ : REM OPEN IN SHARED SHOULD FAIL : GOSUB '101(N$,T$,"S") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - OPEN IN SHARED MODE SUCCEEDS!"# 1430 REM OPEN IN EXTENDED SHOULD FAIL : GOSUB '101(N$,T$,"E") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - OPEN IN EXTEND ED MODE SUCCEEDS!"# 1440 REM OPEN IN READONLY SHOULD FAIL : GOSUB '101(N$,T$,"R") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXTENDED - OPEN IN READONL Y SUCCEEDS!"# 1450 REM CLOSE FILES : GOSUB '102(F$(1),F1$(1)) : IF V0$<>HEX(FF) THEN STOP "CLOSE FAILS - EXCLUSIVE"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - EXCLUSIVE"# 1460 REM % TEST OPEN MODES : PRINT "TEST OPEN MODES - EXTENDED" : T$="C" : GOSUB '101 (N$,T$,"E") : IF V0$<>HEX(FF) THEN STOP "ERROR IN OPEN - EXTENDED MODE"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN EXTENDED MODE SMB HEADER"# 1470 F$(1)=V9$ : F1$(1)=V7$ : REM OPEN IN SHARED SHOULD FAIL : GOSUB '101(N$,T$,"S") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXTENDED - OPEN IN SHARED MODE SUCCEEDS!"# 1480 REM OPEN IN EXCLUSIVE SHOULD FAIL : GOSUB '101(N$,T$,"X") : IF STR(V7$,8,2)<>HEX(0015) THEN STOP "ERROR IN EXCLUSIVE - OPEN IN EXCLUS IVE MODE SUCCEEDS!"# 1500 REM CLOSE FILES : GOSUB '102(F$(1),F1$(1)) : IF V0$<>HEX(FF) THEN STOP "CLOSE FAILS - EXTENDED"# : IF STR(V7$,6,1)<>HEX(00) THEN STOP "SMB ERROR IN CLOSE - EXTENDED"# 1870 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"# 1880 REM % TEST GET FILE ATTRIBUTES ON RENAMED FILE : PRINT "TEST GET FILE ATTRIBUTES OF RENAMED FILE" 1890 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"# 1900 Z$=STR(V9$(),7,40) 1910 IF STR(Z$,1,4)<>"CFNA" THEN 1940 : IF STR(Z$,5,2)<>HEX(0000) THEN 1940 : IF VAL(STR(Z$,7,2),2)<>A THEN 1940 1920 IF STR(Z$,9,2)<>HEX(0000) THEN 1940 : IF VAL(STR(Z$,11,2),2)<>A1 THEN 1940 1930 GOTO 1950 1940 STOP "ERROR IN GET FILE ATTRIBUTE DATA"# 1950 REM % DELETE FILE : PRINT "DELETE FILE - ";N1$ 1960 GOSUB '201 (N1$) : IF V0$<>HEX(FF) THEN STOP "ERROR IN DELETE"# 1970 IF STR(V7$,6,1)<>HEX(00) THEN STOP "ERROR IN DELETE SMB HEADER"# 2000 END 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) 2259 REM / If SHARED mode for CONSECUTIVE file, then open the file in SHARED I /O mode/ ROCStart for lock/2200SRV Rel 01.60.00/Ram/19 Oct., '90/ 2260 V1=POS(" SXER"=V2$) : IF V1<12OR V1>15THEN 2278 : IF V1$="C" AND V2$="S" THEN V2=(2^V1)+(2^(V1+1)) : ELSE 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$(),36,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) 3201 REM / If SHARED mode for CONSECUTIVE file, then open the file in SHARED I /O mode/ROCStart for 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90/ 3202 V1=POS(" SXER"=V2$) : IF V1<12OR V1>15THEN 3230 : IF V1$="C" AND V2$="S" THEN V2=(2^V1)+(2^(V1+1)) : ELSE 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$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 3550 V0$=HEX(FF) : RETURN 3552 V0$=HEX(A5) : RETURN 3554 V0$=HEX(00) : RETURN 4078 DEFFN'103(V9$,V7$,V3$,V6) 4080 STR(V7$,6,4)=HEX(00090000) 4082 STR(V8$())=HEX(04)&V9$ 4084 IF V3$<>" "THEN 4086 : STR(V8$(),4,2),STR(V8$(),8,2)=HEX(0000) : GOTO 4088 4086 STR(V8$(),4,2)="HH" : STR(V8$(),8,2)=BIN(V6,2) 4088 STR(V8$(),6,2)=HEX(0001) : STR(V8$(),10,3)=HEX(000000) 4090 GOSUB '199 : IF V0$<>HEX(FF)THEN 4098 4092 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4100 4094 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4096 V0$=HEX(FF) 4098 RETURN 4100 V0$=HEX(00) : RETURN 4160 DEFFN'104(V9$,V7$,V9$()) 4162 STR(V7$,6,4)=HEX(00110000) 4164 STR(V8$())=HEX(02)&V9$ 4166 V1=LEN(V9$()) : STR(V8$(),4,V1+8)=HEX(0001)&BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1) &HEX(00) 4168 GOSUB '199 : IF V0$<>HEX(FF)THEN 4176 4170 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4178 4172 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4174 V0$=HEX(FF) 4176 RETURN 4178 V0$=HEX(00) : RETURN 4238 DEFFN'105(V9$,V7$,V1,V9$()) 4240 STR(V7$,6,4)=HEX(00160000) 4242 STR(V8$())=HEX(01)&V9$ 4244 STR(V8$(),4,V1+6)=BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(00) 4246 GOSUB '199 : IF V0$<>HEX(FF)THEN 4252 4248 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4254 4250 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4252 RETURN 4254 V0$=HEX(00) : RETURN 4312 DEFFN'106(V9$,V7$,V7) 4314 STR(V7$,6,4)=HEX(00270000) 4316 STR(V8$())=HEX(03)&V9$ 4318 IF V7>=(2^32)OR V7<=(-2^32)THEN 4332 : IF V7<0THEN 4320 : V1=INT(V7/(2^16)) : STR(V8$(),4,2)=BIN(V1,2) : STR(V8$(),6,2)=BIN(V7-V1*2^16,2) : GOTO 4322 4320 V7=ABS(V7) : V1=INT(V7/(2^16)) : STR(V8$(),4,2)=BIN(V1,2) : STR(V8$(),6,2)=BIN(V7-V1*2^16,2) : STR(V8$(),4,4)=XOR HEX(FFFFFFFF)ADDCHEX(01) 4322 STR(V8$(),8,3)=HEX(000000) 4324 GOSUB '199 : IF V0$<>HEX(FF)THEN 4334 4326 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4332 4328 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4330 V0$=HEX(FF) : GOTO 4334 4332 V0$=HEX(00) 4334 RETURN 4386 DEFFN'107(V9$,V7$,V2$) 4388 STR(V7$,6,4)=HEX(001F0000) 4389 REM / Modified lines 4390, 4392, 4394 and 4396 for CONSECUTIVE lock throu gh ROCStart with 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90/ 4390 STR(V8$())=HEX(02)&V9$&"HH"&HEX(00000000) 4392 REM STR(V8$(),4,6)=HEX(00 00 00 00 00 00) 4394 REM V1=POS(" SXER"=V2$) : REM IF V1<12OR V1>15THEN 4410 : REM V2=2^V1 : REM STR(V8$(),10,2)=BIN(V2,2) 4396 REM STR(V8$(),12,3)=HEX(00 00 00) 4398 GOSUB '199 : IF V0$<>HEX(FF)THEN 4408 4400 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4410 4402 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4404 V0$=HEX(FF) 4408 RETURN 4410 V0$=HEX(00) : RETURN 4460 DEFFN'108(V9$,V7$) 4461 REM / Modified line 4462 and 4464 for CONSECUTIVE unlock through ROCStart for 2200SRV Rel 01.60.00 and above/ 4462 STR(V7$,6,4)=HEX(001F0000) 4464 STR(V8$())=HEX(02)&V9$&HEX(0202)&HEX(00000000) 4466 GOSUB '199 : IF V0$<>HEX(FF)THEN 4474 4468 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 4476 4470 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4472 V0$=HEX(FF) 4474 RETURN 4476 V0$=HEX(00) : RETURN 6082 DEFFN'117(V9$,V7$,V3$,V0,V7) 6084 STR(V7$,6,4)=HEX(00060000) 6086 STR(V8$())=HEX(06)&V9$ 6088 IF V3$<>" "THEN 6090 : STR(V8$(),4,2),STR(V8$(),10,2)=HEX(0000) : GOTO 6092 6090 STR(V8$(),4,2)="HH" : STR(V8$(),10,2)=HEX(0000) 6092 IF V0>=(2^32)THEN 6110 : V1=INT(V0/(2^16)) : STR(V8$(),6,2)=BIN(V1,2) : STR(V8$(),8,2)=BIN(V0-(V1*2^16),2) 6094 STR(V8$(),12,2)=BIN(V7,2) 6096 STR(V8$(),14,3)=HEX(000000) 6098 GOSUB '199 : IF V0$<>HEX(FF)THEN 6106 6100 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 6108 6102 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 6104 V0$=HEX(FF) 6106 RETURN 6108 V0$=HEX(A5) : RETURN 6110 V0$=HEX(00) : RETURN 6172 DEFFN'118(V9$,V7$,V7,V9$()) 6174 STR(V7$,6,4)=HEX(000F0000) 6176 STR(V8$())=HEX(02)&V9$ 6178 STR(V8$(),4,2)=BIN(V7,2) 6182 V1=LEN(V9$()) : STR(V8$(),6,V1+8)=BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(00) 6184 GOSUB '199 : IF V0$<>HEX(FF)THEN 6192 6186 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 6194 6188 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 6190 V0$=HEX(FF) 6192 RETURN 6194 V0$=HEX(00) 6256 DEFFN'119(V9$,V7$,V0,V1,V9$()) 6258 STR(V7$,6,4)=HEX(00140000) 6260 STR(V8$())=HEX(03)&V9$ 6264 IF V0>=(2^32)THEN 6278 : V2=INT(V0/(2^16)) : STR(V8$(),4,2)=BIN(V2,2) : STR(V8$(),6,2)=BIN(V0-(V2*2^16),2) 6266 STR(V8$(),8,V1+6)=BIN(V1+3,2)&HEX(01)&BIN(V1,2)&STR(V9$(),1,V1)&HEX(00) 6268 GOSUB '199 : IF V0$<>HEX(FF)THEN 6276 6270 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 6278 6272 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 6274 V0$=HEX(FF) 6276 RETURN 6278 V0$=HEX(00) : RETURN 6330 DEFFN'120(V9$,V7$,V0) 6332 STR(V7$,6,4)=HEX(00180000) 6334 STR(V8$())=HEX(03)&V9$ 6338 IF V0>=(2^32)THEN 6352 : V1=INT(V0/(2^16)) : STR(V8$(),4,2)=BIN(V1,2) : STR(V8$(),6,2)=BIN(V0-(V1*2^16),2) 6340 STR(V8$(),8,3)=HEX(000000) 6342 GOSUB '199 : IF V0$<>HEX(FF)THEN 6350 6344 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 6352 6346 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 6348 V0$=HEX(FF) 6350 RETURN 6352 V0$=HEX(5A) : RETURN 7046 DEFFN'121(V9$,V7$,V7) 7048 STR(V7$,7,1)=HEX(05) 7050 STR(V8$())=HEX(04)&V9$&HEX(0001) 7054 V1=INT(V7/(2^16)) : STR(V8$(),6,2)=BIN(V1,2) 7056 V1=INT(V7-(V1*(2^16))) : STR(V8$(),8,6)=BIN(V1,2)&HEX(00000000) 7058 GOSUB '199 : IF V0$<>HEX(FF)THEN 7066 7060 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 7068 7062 V1=VAL(STR(V9$(),39,2),2) : STR(V9$(),1,V1)=STR(V9$(),41,V1) 7064 V0$=HEX(FF) 7066 RETURN 7068 V0$=HEX(00) : RETURN 7110 DEFFN'122(V9$,V7$,V7,V9$()) 7112 STR(V7$,7,1)=HEX(0E) 7114 STR(V8$())=HEX(04)&V9$&HEX(0001) 7118 V1=INT(V7/(2^16)) : STR(V8$(),6,2)=BIN(V1,2) 7120 V1=INT(V7-(V1*(2^16))) : STR(V8$(),8,6)=BIN(V1,2)&HEX(00000000) 7122 STR(V8$(),10,2054)=BIN(2051,2)&HEX(01)&BIN(2048,2)&STR(V9$(),,2048)&HEX(0 0) 7124 GOSUB '199 : IF V0$<>HEX(FF)THEN 7130 7126 V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00)THEN 7132 7128 V0$=HEX(FF) 7130 RETURN 7132 V0$=HEX(00) : RETURN 9999 DEFFN'31"N$=";HEX(22);"TESTCON1";HEX(22);":SCRATCH T N$: SAVE T () N$"