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$"