Listing of file='VSACESS1' on disk='vmedia/731-8012A.wvd.zip'
# Sector 472, program filename = 'VSACESS1' 4000 REM VSACESS1 30 JUNE 86 4002 REM % (c) Copyright Wang Laboratories, Inc. 1986 4004 REM SUPPORTS CONSECUTIVE FILE SUBROUTINES 4006 REM READ A RECORD, WRITE A RECORD, RE-WRITE A RECORD 4008 REM SKIP A CONSECUTIVE RECORD, LOCK & UNLOCK RECORDS 4010 REM 4012 REM % CONSECUTIVE READ SUBROUTINE ('103) 4014 REM ***************************************************************** 4016 REM * READ A CONSECUTIVE RECORD ('103) * 4018 REM * * 4020 REM * FORM - GOSUB '103 (H$,H1$,"H",H) * 4022 REM * * 4024 REM * WHERE H$ = FILE HANDLE * 4026 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4028 REM * "H" = HOLD OPTION, OTHERWISE " ". * 4030 REM * H = TIMEOUT FOR HOLD (IN SECONDS) * 4032 REM * * 4034 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4036 REM * (5A = ERROR IN 2258 HANDLING) * 4038 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4040 REM * V7$ = SMB HEADER BLOCK * 4042 REM * V9$() = RETURN DATA * 4044 REM * 1 BYTE - # WORDS IN WORD BLOCK = 01 * 4046 REM * 2 BYTE - # OF RECORDS READ * 4048 REM * 2 BYTE - # BYTES IN BYTE BLOCK * 4050 REM * DATA READ * 4052 REM * 1 BYTE DATABLOCK ID = 01 * 4054 REM * 2 BYTE # BYTES READ * 4056 REM * X BYTE DATA READ * 4058 REM * * 4060 REM * EXAMPLE * 4062 REM * 10 DIM C1$5,N1$30,B1$3,W$8,H$2,H1$32 * 4064 REM * 20 W$=HEX(A005A01EA0035205) * 4066 REM * 30 GOSUB '103 (H$, H1$, " ") * 4068 REM * 40 IF V0$ <> HEX(00) THEN 60 * 4070 REM * 50 STOP "ERROR IN READ" * 4072 REM * 60 $UNPACK (F=W$) STR(V9$(),9) TO C1$,N1$,B1$,A1 * 4074 REM * * 4076 REM ***************************************************************** 4078 DEFFN '103 (V9$,V7$,V3$,V6) 4080 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00090000) 4082 REM READ A CONSECUTIVE RECORD CMD STRUCTURE : STR(V8$())=HEX(04) & V9$ 4084 REM CHECK IF HOLD : IF V3$<>" " THEN 4086 : STR(V8$(),4,2),STR(V8$(),8,2)=HEX(0000) : GOTO 4088 4086 REM HOLD : 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 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 0001 01 XXXX DD DD DD ... 00 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4098 4092 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4100 4094 REM SET UP RETURN DATA : V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4096 REM GOOD RETURN : V0$=HEX(FF) 4098 RETURN 4100 V0$=HEX(00) : RETURN 4102 REM % CONSECUTIVE WRITE SUBROUTINE ('104) 4104 REM ***************************************************************** 4106 REM * WRITE A CONSECUTIVE RECORD ('104) * 4108 REM * * 4110 REM * FORM - GOSUB '104 (H$,H1$,D$) * 4112 REM * * 4114 REM * WHERE H$ = FILE HANDLE * 4116 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4118 REM * D$ = WRITE DATA BUFFER * 4120 REM * * 4122 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4124 REM * (5A = ERROR IN 2258 HANDLING) * 4126 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4128 REM * V7$ = SMB HEADER BLOCK * 4130 REM * V9$() = RETURN DATA * 4132 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 01 * 4134 REM * 2 BYTE - # OF BYTES WRITTEN * 4136 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 4138 REM * * 4140 REM * EXAMPLE * 4142 REM * 10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32 * 4144 REM * 20 W$=HEX(A005A01EA0035205) * 4146 REM * 30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1 * 4148 REM * 40 GOSUB '104 (H$, H1$, D$) * 4150 REM * 50 IF V0$ <> HEX(00) THEN 70 * 4152 REM * 60 STOP "ERROR IN WRITE" * 4154 REM * 70 ...... * 4156 REM * * 4158 REM ***************************************************************** 4160 DEFFN '104 (V9$,V7$,V9$()) 4162 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00110000) 4164 REM READ A CONSECUTIVE RECORD CMD STRUCTURE : 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 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 0001 01 00 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4176 4170 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4178 4172 REM SET UP RETURN DATA : V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4174 REM GOOD RETURN : V0$=HEX(FF) 4176 RETURN 4178 V0$=HEX(00) : RETURN 4180 REM % CONSECUTIVE RE-WRITE SUBROUTINE ('105) 4182 REM ***************************************************************** 4184 REM * RE-WRITE A CONSECUTIVE RECORD ('105) * 4186 REM * * 4188 REM * FORM - GOSUB '105 (H$,H1$,L,D$) * 4190 REM * * 4192 REM * WHERE H$ = FILE HANDLE * 4194 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4196 REM * L = LENGTH OF RECORD TO BE WRITTEN * 4198 REM * D$ = WRITE DATA BUFFER * 4200 REM * * 4202 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4204 REM * (5A = ERROR IN 2258 HANDLING) * 4206 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4208 REM * V7$ = SMB HEADER BLOCK * 4210 REM * V9$() = RETURN DATA * 4212 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 4214 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 4216 REM * * 4218 REM * EXAMPLE * 4220 REM * 10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32 * 4222 REM * 20 W$=HEX(A005A01EA0035205) * 4224 REM * 30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1 * 4226 REM * 40 GOSUB '105 (H$, H1$, 41, D$) * 4228 REM * 50 IF V0$ <> HEX(00) THEN 70 * 4230 REM * 60 STOP "ERROR IN RE-WRITE" * 4232 REM * 70 ...... * 4234 REM * * 4236 REM ***************************************************************** 4238 DEFFN '105 (V9$,V7$,V1,V9$()) 4240 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00160000) 4242 REM RE-WRITE A CONSECUTIVE RECORD CMD STRUCTURE : 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 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4252 4248 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4254 4250 REM SET UP RETURN DATA : 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 4256 REM % CONSECUTIVE SKIP SUBROUTINE ('106) 4258 REM ***************************************************************** 4260 REM * SKIP N NUMBER OF CONSECUTIVE RECORDS ('106) * 4262 REM * * 4264 REM * FORM - GOSUB '106 (H$,H1$,R) * 4266 REM * * 4268 REM * WHERE H$ = FILE HANDLE * 4270 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4272 REM * R = NUMBER OF RECORDS TO SKIP * 4274 REM * RELATIVE FROM CURRENT POSITION * 4276 REM * NEGATIVE IS BACKWARDS SKIP * 4278 REM * * 4280 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4282 REM * (5A = ERROR IN 2258 HANDLING) * 4284 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4286 REM * V7$ = SMB HEADER BLOCK * 4288 REM * V9$() = RETURN DATA * 4290 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 4292 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 4294 REM * * 4296 REM * EXAMPLE * 4298 REM * 30 R = 30 * 4300 REM * 40 GOSUB '106 (H$, H1$, R) * 4302 REM * 50 IF V0$ <> HEX(00) THEN 70 * 4304 REM * 60 STOP "ERROR IN SKIP" * 4306 REM * 70 ...... * 4308 REM * * 4310 REM ***************************************************************** 4312 DEFFN '106 (V9$,V7$,V7) 4314 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00270000) 4316 REM SKIP CONSECUTIVE COMMAND STRUCTURE : STR(V8$())=HEX(03) & V9$ 4318 REM 32 BIT COUNT OF RECORDS TO SKIP : IF V7 >= (2^32) OR V7 <=(-2^32) THEN 4332 : IF V7 < 0 THEN 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 REM NEGATIVE SKIP : 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) ADDC HEX(01) 4322 REM BYTE BLOCK & COMMAND TRAILER : STR(V8$(),8,3)=HEX(000000) 4324 REM SENT REQUEST TO 2200, GET BACK 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4334 4326 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4332 4328 REM SET UP RETURN DATA : V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4330 REM GOOD RETURN : V0$=HEX(FF) : GOTO 4334 4332 REM SUBR ERROR : V0$=HEX(00) 4334 REM RETURN : RETURN 4336 REM % CONSECUTIVE LOCK SUBROUTINE ('107) 4338 REM ***************************************************************** 4340 REM * LOCK A CONSECUTIVE FILE ('107) * 4342 REM * * 4344 REM * FORM - GOSUB '107 (H$, H1$, M$) * 4346 REM * * 4348 REM * WHERE H$ = FILE HANDLE * 4350 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4352 REM * M$ = FILE OPEN MODE * 4354 REM * * 4356 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4358 REM * (5A = ERROR IN 2258 HANDLING) * 4360 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4362 REM * V7$ = SMB HEADER BLOCK * 4364 REM * V9$() = RETURN DATA * 4366 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 4368 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 4370 REM * * 4372 REM * EXAMPLE * 4374 REM * 40 GOSUB '107 (H$,H1$,M$) * 4376 REM * 50 IF V0$ <> HEX(00) THEN 70 * 4378 REM * 60 STOP "ERROR IN LOCK" * 4380 REM * 70 ...... * 4382 REM * * 4384 REM ***************************************************************** 4386 DEFFN '107 (V9$,V7$,V2$) 4388 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(001F0000) 4389 REM / Modified lines 4390, 4392, 4394 and 4396 to implement CONSECUTIVE LOCK through ROCStart for 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90/ 4390 REM LOCK CONSECUTIVE COMMAND STRUCTURE : STR(V8$())=HEX(02) & V9$ & "HH" & HEX(00000000) 4392 REM INIT FUTURE VALUES : REM STR(V8$(),4,6)=HEX(00 00 00 00 00 00) 4394 REM FILE OPEN MODE : REM V1=POS(" SXER"=V2$) : REM IF V1<12 OR V1>15 THEN 4410 : REM V2=2^V1 : REM STR(V8$(),10,2)=BIN(V2,2) 4396 REM BYTE BLOCK & COMMAND TRAILER : REM STR(V8$(),12,3)=HEX(00 00 00) 4398 REM SENT REQUEST TO 2200, GET BACK 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4408 4400 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4410 4402 REM SET UP RETURN DATA : V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4404 REM GOOD RETURN : V0$=HEX(FF) 4406 REM INIT 4408 RETURN 4410 V0$=HEX(00) : RETURN 4412 REM % CONSECUTIVE UNLOCK SUBROUTINE ('108) 4414 REM ***************************************************************** 4416 REM * UNLOCK A CONSECUTIVE FILE ('108) * 4418 REM * * 4420 REM * FORM - GOSUB '108 (H$,H1$) * 4422 REM * * 4424 REM * WHERE H$ = FILE HANDLE * 4426 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 4428 REM * * 4430 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 4432 REM * (5A = ERROR IN 2258 HANDLING) * 4434 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 4436 REM * V7$ = SMB HEADER BLOCK * 4438 REM * V9$() = RETURN DATA * 4440 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 4442 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 4444 REM * * 4446 REM * EXAMPLE * 4448 REM * 40 GOSUB '108 (H$,H1$) * 4450 REM * 50 IF V0$ = HEX(FF) THEN 70 * 4452 REM * 60 STOP "ERROR IN UNLOCK" * 4454 REM * 70 ...... * 4456 REM * * 4458 REM ***************************************************************** 4460 DEFFN '108 (V9$,V7$) 4461 REM /Modified lines 4462 and 4464 to implement CONSECUTIVE UNLOCK through ROCStart for 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90/ 4462 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(001F0000) 4464 REM UNLOCK CONSECUTIVE COMMAND STRUCTURE : STR(V8$())=HEX(02) & V9$ & HEX(0202) & HEX(00000000) 4466 REM SENT REQUEST TO 2200, GET BACK 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 4474 4468 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 4476 4470 REM SET UP RETURN DATA : V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),1,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 4472 REM GOOD RETURN : V0$=HEX(FF) 4474 RETURN 4476 V0$=HEX(00) : RETURN 4478 DEFFN'31 "N$=";HEX(22);"VSACESS1";HEX(22);":SCRATCH T N$: SAVE T () N$"