Listing of file='VSACESS3' on disk='vmedia/731-8012A.wvd.zip'
# Sector 192, program filename = 'VSACESS3' 6000 REM VSACESS3 10 SEPT 86 6002 REM % (c) Copyright Wang Laboratories, Inc. 1986 6004 REM SUPPORTS RELATIVE FILE SUBROUTINES 6006 REM RELATIVE READ, RELATIVE WRITE, RELATIVE RE-WRITE 6008 REM RELATIVE DELETE 6010 REM 6012 REM % RELATIVE READ SUBROUTINE ('117) 6014 REM ***************************************************************** 6016 REM * READ A RELATIVE RECORD ('117) * 6018 REM * * 6020 REM * FORM - GOSUB '117 (H$,H1$,"H",R,R1) * 6022 REM * * 6024 REM * WHERE H$ = FILE HANDLE * 6026 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 6028 REM * "H" = HOLD OPTION, OTHERWISE " ". * 6030 REM * R = RELATIVE # OF RECORD TO BE READ * 6032 REM * R1 = NUMBER OF RECORDS TO BE READ * 6034 REM * * 6036 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 6038 REM * (5A = ERROR IN 2258 HANDLING) * 6040 REM * (A5 = ERROR IN SMB HEADER) * 6042 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 6044 REM * V7$ = SMB HEADER BLOCK * 6046 REM * V9$() = RETURN DATA * 6048 REM * 1 BYTE - # WORDS IN WORD BLOCK = 01 * 6050 REM * 2 BYTE - # OF RECORDS READ * 6052 REM * 2 BYTE - # BYTES IN BYTE BLOCK * 6054 REM * DATA READ * 6056 REM * 1 BYTE DATABLOCK ID = 01 * 6058 REM * 2 BYTE # BYTES READ * 6060 REM * X BYTE DATA READ * 6062 REM * * 6064 REM * EXAMPLE * 6066 REM * 10 DIM C1$5,N1$30,B1$3,W$8,H$2,H1$32 * 6068 REM * 20 W$=HEX(A005A01EA0035205) * 6070 REM * 30 GOSUB '117 (H$, H1$, " ",125,1) * 6072 REM * 40 IF V0$ <> HEX(00) THEN 60 * 6074 REM * 50 STOP "ERROR IN READ" * 6076 REM * 60 $UNPACK (F=W$) STR(V9$(),9) TO C1$,N1$,B1$,A1 * 6078 REM * * 6080 REM ***************************************************************** 6082 DEFFN '117 (V9$,V7$,V3$,V0,V7) 6084 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00060000) 6086 REM READ A RELATIVE RECORD CMD STRUCTURE : STR(V8$())=HEX(06) & V9$ 6088 REM CHECK IF HOLD : IF V3$<>" " THEN 6090 : STR(V8$(),4,2),STR(V8$(),10,2)=HEX(0000) : GOTO 6092 6090 REM HOLD : STR(V8$(),4,2)="HH" : STR(V8$(),10,2)=HEX(0000) 6092 REM RELATIVE OFFSET OF RECORD TO BE READ : 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 REM NUMBER OF RECORDS TO BE READ : STR(V8$(),12,2)=BIN(V7,2) 6096 REM BYTE BLOCK & TRAILER : STR(V8$(),14,3)=HEX(000000) 6098 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 RRRR 01 XXXX DD DD DD ... 00 : GOSUB '199 : IF V0$<>HEX(FF) THEN 6106 6100 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 6108 6102 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(" ") 6104 REM GOOD RETURN : V0$=HEX(FF) 6106 RETURN 6108 V0$=HEX(A5) : RETURN 6110 REM BAD ARGUMENT : V0$=HEX(00) : RETURN 6112 REM % RELATIVE WRITE SUBROUTINE ('118) 6114 REM ***************************************************************** 6116 REM * WRITE A RELATIVE RECORD ('118) * 6118 REM * * 6120 REM * FORM - GOSUB '118 (H$,H1$,R1,D$) * 6122 REM * * 6124 REM * WHERE H$ = FILE HANDLE * 6126 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 6128 REM * R1 = # OF RECORDS TO BE WRITTEN * 6130 REM * D$ = WRITE DATA BUFFER * 6132 REM * * 6134 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 6136 REM * (5A = ERROR IN 2258 HANDLING) * 6138 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 6140 REM * V7$ = SMB HEADER BLOCK * 6142 REM * V9$() = RETURN DATA * 6144 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 01 * 6146 REM * 2 BYTE - # OF RECORDS WRITTEN * 6148 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 6150 REM * * 6152 REM * EXAMPLE * 6154 REM * 10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32 * 6156 REM * 20 W$=HEX(A005A01EA0035205) * 6158 REM * 30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1 * 6160 REM * 40 GOSUB '118 (H$, H1$, 1, D$) * 6162 REM * 50 IF V0$ <> HEX(00) THEN 70 * 6164 REM * 60 STOP "ERROR IN WRITE" * 6166 REM * 70 ...... * 6168 REM * * 6170 REM ***************************************************************** 6172 DEFFN '118 (V9$,V7$,V7,V9$()) 6174 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(000F0000) 6176 REM READ A CONSECUTIVE RECORD CMD STRUCTURE : STR(V8$())=HEX(02) & V9$ 6178 REM # RECORDS TO BE WRITTEN : STR(V8$(),4,2)=BIN(V7,2) 6180 REM DATA BLOCK TO BE WRITTEN 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 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 01 WWWW 0000 00 : GOSUB '199 : IF V0$<>HEX(FF) THEN 6192 6186 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 6194 6188 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(" ") 6190 REM GOOD RETURN : V0$=HEX(FF) 6192 RETURN 6194 V0$=HEX(00) 6196 REM % RELATIVE RE-WRITE SUBROUTINE ('119) 6198 REM ***************************************************************** 6200 REM * RE-WRITE A RELATIVE RECORD ('119) * 6202 REM * * 6204 REM * FORM - GOSUB '119 (H$,H1$,R,R1,D$) * 6206 REM * * 6208 REM * WHERE H$ = FILE HANDLE * 6210 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 6212 REM * R = # OF THE RECORD TO BE RE-WRITTEN * 6214 REM * R1 = LENGTH OF DATA TO BE WRITTEN * 6216 REM * D$ = WRITE DATA BUFFER * 6218 REM * * 6220 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 6222 REM * (5A = ERROR IN 2258 HANDLING) * 6224 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 6226 REM * V7$ = SMB HEADER BLOCK * 6228 REM * V9$() = RETURN DATA * 6230 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 6232 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 6234 REM * * 6236 REM * EXAMPLE * 6238 REM * 10 DIM C1$5,N1$30,B1$3,W$8,D$43,H$2,H1$32 * 6240 REM * 20 W$=HEX(A005A01EA0035205) * 6242 REM * 30 $PACK (F=W$) D$ FROM C1$,N1$,B1$,A1 * 6244 REM * 40 GOSUB '119 (H$, H1$, 5, 43, D$) * 6246 REM * 50 IF V0$ <> HEX(00) THEN 70 * 6248 REM * 60 STOP "ERROR IN RE-WRITE" * 6250 REM * 70 ...... * 6252 REM * * 6254 REM ***************************************************************** 6256 DEFFN '119 (V9$,V7$,V0,V1,V9$()) 6258 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00140000) 6260 REM RE-WRITE A CONSECUTIVE RECORD CMD STRUCTURE : STR(V8$())=HEX(03) & V9$ 6262 REM RELATIVE OFFSET OF RECORD TO BE RE-WRITTEN 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 REM SEND REQUEST TO 2258 AND ACCEPT REPLY 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 6276 6270 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 6278 6272 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(" ") 6274 REM GOOD RETURN : V0$=HEX(FF) 6276 RETURN 6278 REM BAD ARGUMENTS : V0$=HEX(00) : RETURN 6280 REM % RELATIVE DELETE ('120) 6282 REM ***************************************************************** 6284 REM * DELETE CURRENT RELATIVE RECORD ('120) * 6286 REM * * 6288 REM * FORM - GOSUB '120 (H$,H1$,R) * 6290 REM * * 6292 REM * WHERE H$ = FILE HANDLE * 6294 REM * H1$ = SMB\A0HEADER FOR FILE HANDLE H$ * 6296 REM * R = NUMBER OF THE RECORD TO BE DELETED * 6298 REM * * 6300 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) * 6302 REM * (5A = ERROR IN 2258 HANDLING) * 6304 REM * (FF = OKAY CHECK SMB HDR FOR ERR) * 6306 REM * V7$ = SMB HEADER BLOCK * 6308 REM * V9$() = RETURN DATA * 6310 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 * 6312 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 * 6314 REM * * 6316 REM * EXAMPLE * 6318 REM * 40 GOSUB '120 (H$, H1$,5) * 6320 REM * 50 IF V0$ <> HEX(00) THEN 70 * 6322 REM * 60 STOP "ERROR IN DELETE" * 6324 REM * 70 ...... * 6326 REM * * 6328 REM ***************************************************************** 6330 DEFFN '120 (V9$,V7$,V0) 6332 REM UPDATE COMMAND AND INIT ERRORS IN SMB\A0HDR : STR(V7$,6,4)=HEX(00180000) 6334 REM DELETE RELATIVE COMMAND STRUCTURE : STR(V8$())=HEX(03) & V9$ 6336 REM RELATIVE OFFSET OF RECORD TO BE DELETED 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 REM BYTE BLOCK & COMMAND TRAILER : STR(V8$(),8,3)=HEX(000000) 6342 REM SENT REQUEST TO 2200, GET BACK 00 0000 : GOSUB '199 : IF V0$<>HEX(FF) THEN 6350 6344 REM SET UP SMB HEADER : V7$=STR(V9$(),1,32) : IF STR(V7$,6,1)<>HEX(00) THEN 6352 6346 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(" ") 6348 REM GOOD RETURN : V0$=HEX(FF) 6350 REM RETURN : RETURN 6352 REM BAD ARGUMENT : V0$=HEX(5A) : RETURN 6354 DEFFN'31 "N$=";HEX(22);"VSACESS3";HEX(22);":SCRATCH T N$: SAVE T () N$"