Listing of file='VSACESS9' on disk='vmedia/731-8012A.wvd.zip'
# Sector 699, program filename = 'VSACESS9'
3000 REM VSACESS9 10/11/87
3002 REM % (c) Copyright Wang Laboratories, Inc. 1986
3003 REM REL.1.0 10 SEPTEMBER 1986
3004 REM SUPPORTS VARIABLE USAGE (DIM STATEMENTS)
3006 REM CATALOG OPERATIONS
3008 REM FILE CREATE
3010 REM FILE DELETE
3012 REM FILE RENAME
3014 REM
3016 REM % GENERAL FILE CREATE SUBROUTINE ('200)
3018 REM *****************************************************************
3020 REM * CREATE ANY DMS FILE ('200) *
3022 REM * *
3024 REM * FORM - GOSUB '200 (N$,T$,M$,O$,A$,A1$) *
3026 REM * *
3028 REM * WHERE N$ = NAME OF FILE *
3030 REM * T$ = FILE ORGANIZATION (TYPE) *
3032 REM * M$ = FILE OPEN MODE *
3034 REM * O$ = OPTION FLAG (TEMP, CREATE, CREATE& OPEN) *
3036 REM * A$ = CREATE PARAMETERS *
3038 REM * A1$ = ALTERNATE KEY DATA *
3040 REM * *
3042 REM * NAME OF FILE MAY BE - *
3044 REM * //SYSTEM/VOLUME/LIBRARY/FILE OR *
3046 REM * ///VOLUME/LIBRARY/FILE *
3048 REM * *
3050 REM * FILE ORGANIZATION (TYPE) *
3052 REM * 'I' = INDEXED *
3054 REM * 'C' = CONSECUTIVE *
3056 REM * 'R' = RELATIVE *
3058 REM * 'B' = BLOCK *
3060 REM * *
3062 REM * FILE OPEN MODE *
3064 REM * 'R' = READ ONLY *
3066 REM * 'S' = SHARED *
3068 REM * 'X' = EXCLUSIVE *
3070 REM * 'E' = EXTENDED *
3072 REM * *
3074 REM * OPTION FLAG *
3076 REM * 'T' = TEMPORARY FILE *
3078 REM * 'C' = JUST CREATE FILE *
3080 REM * 'O' = CREATE AND OPEN FILE *
3082 REM * *
3084 REM * CREATE DATA (40 BYTES OF DATA) *
3086 REM * 1 BYTE - FILE TYPE 'C','I','R',ETC. *
3088 REM * 1 BYTE - RECORD TYPE Fixed or Variable *
3090 REM * 1 BYTE - FILE CLASS A-Z,#,$,@ *
3092 REM * 1 BYTE - COMPRESS FLAG Y OR N *
3094 REM * 4 BYTE - NO. OF RECORDS *
3096 REM * 4 BYTE - RECORD SIZE *
3098 REM * 4 BYTE - BLOCK ALLOCATION *
3100 REM * 4 BYTE - BLOCK SIZE *
3102 REM * 6 BYTE - RETENTION PERIOD YYMMDD *
3104 REM * 1 BYTE - WP FILE PROLOGUE CREATE ? *
3106 REM * 2 BYTE - PRIMARY KEY POSITION (INDEXED) *
3108 REM * 2 BYTE - PRIMARY KEY LENGTH (INDEXED) *
3110 REM * 2 BYTE - NO. ALTERNATE KEYS (INDEXED) *
3112 REM * 1 BYTE - TAKE CREATED AREA Y/N *
3114 REM * 1 BYTE - PRINT FORM NUMBER *
3116 REM * 1 BYTE - PRINT CLASS *
3118 REM * 1 BYTE - DIRECTED PRTR DEVICE NO *
3120 REM * 1 BYTE - NUMBER OF COPIES *
3122 REM * 1 BYTE - STATUS (HOLD, RELEASE) *
3124 REM * 1 BYTE - DISPOSITION *
3126 REM * *
3128 REM * 8 BYTES ALTERNATE KEY DATA (IF APPLIC) *
3130 REM * (FOR EACH ALTERNATE KEY) *
3132 REM * 1 BYTE - DUPLICATES ALLOWED (INDEXED) *
3134 REM * 1 BYTE - COMPRESSION ON KEY (INDEXED) *
3136 REM * 2 BYTE - ORDINAL NUMBER (INDEXED) *
3138 REM * 2 BYTE - START POS. OF KEY (INDEXED) *
3140 REM * (ZERO BASED) *
3142 REM * 2 BYTE - KEY LENGTH (INDEXED) *
3144 REM * *
3146 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) *
3148 REM * (5A = ERROR IN '199 [2258 FIRM]) *
3150 REM * (A5 = ERROR IN SMB BLOCK) *
3152 REM * (FF = OKAY LOOK AT SMB HDR) *
3154 REM * V1 = LENGTH OF VALID DATA IN V9$() *
3156 REM * V7$ = SMB\A0HEADER FOR FILE HANDLE V9$ *
3158 REM * V9$ = FILE HANDLE *
3160 REM * V9$( = DATA RETURNED HEX(000000) *
3162 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 *
3164 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 *
3166 REM * EXAMPLE *
3168 REM * 10 DIM N$32, T$1, M$1, A$40, A1$8 *
3170 REM * 20 N$="///ANYVOL/ANYLIB/NAMEFILE" *
3172 REM * 30 T$="I" *
3174 REM * 40 M$="S" *
3176 REM * 50 GOSUB '200 (N$,T$,M$,"C",A$,A1$) *
3178 REM * 60 IF V0$ = HEX(FF) THEN 80 *
3180 REM * 70 STOP "ERROR IN OPEN" *
3182 REM * 80 REM FILE HANDLE = V9$ *
3184 REM * *
3186 REM *****************************************************************
3188 DEFFN '200 (V$,V1$,V2$,V3$,STR(V9$(),1,40),STR(V9$(),41))
3190 REM CONSTRUCT OMT HEADER & COMMAND STRUCTURE FOR OPEN
3192 REM DEFINE HDR
: 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 REM 'OPEN' CMD STRUCTURE
: V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(040000)
3196 REM CHECK NAME
: IF STR(V$,1,2)<>"//" THEN 3230
3198 REM TEMPORARY OPTION
: 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 REM OPEN 'TYPE'
: V1=POS(" IRCBS"=V1$)
: IF V1<11 OR V1>15 THEN 3230
: V2=2^V1
: STR(V8$(),6,2)=BIN(V2,2)
3201 REM / If the mode is SHARED for CONSECUTIVE file, then the file is opened
in SHARED I/O mode for 2200SRV Rel 01.60.00 and above/Ram/19 Oct., '90
/
3202 REM OPEN 'MODE'
: V1=POS(" SXER"=V2$)
: IF V1<12 OR V1>15 THEN 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 REM LENGTH OF BYTES
: 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 REM OBJECT NAME
: STR(V8$(),12,1)=HEX(04)
: STR(V8$(),13,LEN(V$)+1)=V$ & HEX(00)
3208 REM TYPE = FILE
: V1=14+LEN(V$)
: STR(V8$(),V1,6)=HEX(04) & "FILE" & HEX(00)
3210 REM GENERAL CREATE PARAMETERS
: 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 REM ALTERNATE KEY PARAMETERS
: STR(V8$(),V1,V3+3)=HEX(01) & BIN(V3,2) & STR(V9$(),41,V3)
: V1=V1+V3+3
3214 REM TERMINATOR
: STR(V8$(),V1,1)=HEX(00)
3216 REM SEND DATA TO 2258 AND GET RESPONSE
: GOSUB '199
: IF V0$<>HEX(FF) THEN 3230
3218 REM UPDATE SMB\A0HEADER
: V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00) THEN 3228
3220 REM HANDLE ONLY IF CREATE & OPEN
: IF V3$="O" THEN V9$=STR(V9$(),34,2)
3222 REM PROCESS DATA BLOCK
: 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 REM GOOD RETURN
: V0$=HEX(FF)
: RETURN
3228 REM SMB ERROR
: V0$=HEX(A5)
: RETURN
3230 REM BAD OPEN INIT RETURN VALUES TO 00'S AND 20'S
: V0$=HEX(00)
: RETURN
3232 REM % CATALOG FILE DELETE SUBROUTINE ('201)
3234 REM *****************************************************************
3236 REM * DELETE A DMS FILE FROM THE CATALOG ('201) *
3238 REM * *
3240 REM * FORM - GOSUB '201 (N$) *
3242 REM * *
3244 REM * WHERE N$ = NAME OF FILE *
3246 REM * *
3248 REM * NAME OF FILE MAY BE - *
3250 REM * //SYSTEM/VOLUME/LIBRARY/FILE OR *
3252 REM * ///VOLUME/LIBRARY/FILE *
3254 REM * *
3256 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) *
3258 REM * (5A = ERROR IN '199 [2258 FIRM]) *
3260 REM * (FF = OKAY LOOK AT SMB HDR) *
3262 REM * V1 = LENGTH OF VALID DATA IN V9$() *
3264 REM * V7$ = SMB\A0HEADER FOR FILE HANDLE V9$ *
3266 REM * V9$( = DATA RETURNED HEX(000000) *
3268 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 *
3270 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 *
3272 REM * *
3274 REM * EXAMPLE *
3276 REM * 10 DIM N$32 *
3278 REM * 20 N$="///ANYVOL/ANYLIB/NAMEFILE" *
3280 REM * 50 GOSUB '201 (N$) *
3282 REM * 60 IF V0$ = HEX(FF) THEN 80 *
3284 REM * 70 STOP "ERROR IN DELETE" *
3286 REM * 80 REM *
3288 REM * *
3290 REM *****************************************************************
3292 DEFFN '201 (V$)
3294 REM CONSTRUCT OMT HEADER & COMMAND STRUCTURE FOR CATALOG DELETE
3296 REM DEFINE HDR
: 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 REM CHECK NAME
: IF STR(V$,1,2)<>"//" THEN 3316
3300 REM COMMAND MESSAGE
: STR(V8$(),1,3)= HEX(010000)
3302 REM LENGTH OF BYTES
: V1=LEN(V$)
: STR(V8$(),4,2)=BIN(2+V1,2)
3304 REM OBJECT NAME
: STR(V8$(),6,V1+2)=HEX(04) & V$ & HEX(00)
3306 REM TERMINATOR
: V1=V1+8
: STR(V8$(),V1,1)=HEX(00)
3308 REM SEND DATA TO 2258 AND GET RESPONSE
: GOSUB '199
: IF V0$<>HEX(FF) THEN 3318
3310 REM UPDATE SMB\A0HEADER
: V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00) THEN 3316
3312 REM PROCESS DATA BLOCK
: V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
3314 REM GOOD RETURN
: V0$=HEX(FF)
: RETURN
3316 REM BAD OPEN INIT RETURN VALUES TO 00'S AND 20'S
: V0$=HEX(00)
3318 RETURN
3320 REM % CATALOG FILE RENAME SUBROUTINE ('202)
3322 REM *****************************************************************
3324 REM * RENAME A DMS FILE FROM THE CATALOG ('202) *
3326 REM * *
3328 REM * FORM - GOSUB '202 (O$,N$) *
3330 REM * *
3332 REM * WHERE O$ = OLD FILE NAME *
3334 REM * N$ = NEW FILE NAME *
3336 REM * *
3338 REM * NAME OF FILE MAY BE - *
3340 REM * //SYSTEM/VOLUME/LIBRARY/FILE OR *
3342 REM * ///VOLUME/LIBRARY/FILE *
3344 REM * *
3346 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) *
3348 REM * (5A = ERROR IN '199 [2258 FIRM]) *
3350 REM * (FF = OKAY LOOK AT SMB HDR) *
3352 REM * V1 = LENGTH OF VALID DATA IN V9$() *
3354 REM * V7$ = SMB\A0HEADER FOR FILE HANDLE V9$ *
3356 REM * V9$( = DATA RETURNED HEX(000000) *
3358 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 *
3360 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK = 0000 *
3362 REM * *
3364 REM * EXAMPLE *
3366 REM * 10 DIM N$32,O$32 *
3368 REM * 20 N$="///NEWVOL/NEWLIB/NEWNAME" *
3370 REM * 30 O$="///OLDVOL/OLDLIB/OLDNAME" *
3372 REM * 50 GOSUB '202 (O$,N$) *
3374 REM * 60 IF V0$ = HEX(FF) THEN 80 *
3376 REM * 70 STOP "ERROR IN RENAME" *
3378 REM * 80 REM FILE HANDLE = V9$ *
3380 REM * *
3382 REM *****************************************************************
3384 DEFFN '202 (V$,V9$())
3386 REM CONSTRUCT OMT HEADER & COMMAND STRUCTURE FOR OPEN
3388 REM DEFINE HDR
: 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 REM COMMAND MESSAGE
: STR(V8$(),1,3)= HEX(010000)
3392 IF STR(V$,1,2)<>"//" OR STR(V9$(),1,2)<>"//" THEN 3410
3394 REM LENGTH OF BYTES
: V1=LEN(V$)
: V2=LEN(V9$())
: STR(V8$(),4,2)=BIN(4+V1+V2,2)
3396 REM OLD NAME
: STR(V8$(),6,2+V1)=HEX(04) & V$ & HEX(00)
3398 REM NEW NAME
: STR(V8$(),8+V1,V2+2)=HEX(04) & STR(V9$(),1,V2) & HEX(00)
3400 REM TERMINATOR
: V1=10+V1+V2
: STR(V8$(),V1,1)=HEX(00)
3402 REM SEND DATA TO 2258 AND GET RESPONSE
: GOSUB '199
: IF V0$<>HEX(FF) THEN 3412
3404 REM UPDATE SMB\A0HEADER
: V7$=STR(V9$(),,32)
: IF STR(V7$,6,1)<>HEX(00) THEN 3410
3406 REM PROCESS DATA BLOCK
: V1=VAL(STR(V8$,3,2),2)-32
: STR(V9$(),,V1)=STR(V9$(),33,V1)
: STR(V9$(),V1+1)=ALL(" ")
3408 REM GOOD RETURN
: V0$=HEX(FF)
: RETURN
3410 REM BAD OPEN INIT RETURN VALUES TO 00'S AND 20'S
: V0$=HEX(00)
3412 RETURN
3414 REM % GET FILE ATTRIBUTES ('203)
3416 REM *****************************************************************
3418 REM * GET FILE ATTRIBUTES ('203) *
3420 REM * *
3422 REM * FORM - GOSUB '203 (N$) *
3424 REM * *
3426 REM * WHERE N$ = NAME OF FILE *
3428 REM * *
3430 REM * NAME OF FILE MAY BE - *
3432 REM * //SYSTEM/VOLUME/LIBRARY/FILE OR *
3434 REM * ///VOLUME/LIBRARY/FILE *
3436 REM * *
3438 REM * *
3440 REM * RETURN - V0$ = RETURN CODE (00 = ERROR IN SUBROUTINE CALL) *
3442 REM * (5A = ERROR IN '199 [2258 FIRM]) *
3444 REM * (A5 = ERROR IN SMB BLOCK) *
3446 REM * (FF = OKAY LOOK AT SMB HDR) *
3448 REM * V1 = LENGTH OF VALID DATA IN V9$() *
3450 REM * V7$ = SMB\A0HEADER FOR FILE HANDLE V9$ *
3452 REM * V9$( = DATA RETURNED *
3454 REM * 1 BYTE - # OF WORDS IN WORD BLOCK = 00 *
3456 REM * 2 BYTE - # OF BYTES IN BYTE BLOCK *
3457 REM * ATTRIBUTE DATA *
3458 REM * 1 BYTE - DATA BLOCK ID HEX(01) *
3459 REM * 2 BYTE - # BYTES IN DATA BLOCK *
3460 REM * 1 BYTE - FILE TYPE 'C','I','R',ETC. *
3462 REM * 1 BYTE - RECORD TYPE Fixed or Variable *
3464 REM * 1 BYTE - COMPRESS FLAG Y OR N *
3466 REM * 1 BYTE - FILE CLASS A-Z,#,$,@ *
3468 REM * 4 BYTE - NO. OF RECORDS *
3470 REM * 4 BYTE - RECORD SIZE *
3472 REM * 4 BYTE - NO. OF EXTENTS *
3474 REM * 4 BYTE - NO. OF BLOCKS USED *
3476 REM * 4 BYTE - NO. OF BLOCKS ALLOCATED *
3478 REM * 8 BYTE - CREATOR OF FILE (ID) *
3480 REM * 6 BYTE - CREATION DATE - YYMMDD *
3482 REM * 6 BYTE - MODIFIED DATE - YYMMDD *
3484 REM * 6 BYTE - EXPIRATION DATE - YYMMDD *
3486 REM * 1 BYTE - WP FILE PROLOGUE PRESENT ? *
3488 REM * 2 BYTE - PRIMARY KEY POSITION (INDEXED) *
3490 REM * 2 BYTE - PRIMARY KEY LENGTH (INDEXED) *
3492 REM * 2 BYTE - NO. ALTERNATE KEYS (INDEXED) *
3494 REM * 2 BYTE - ALTERNATE KEY MASK (INDEXED) *
3496 REM * *
3498 REM * 8 BYTES ALTERNATE KEY DATA (IF APPLIC) *
3500 REM * 1 BYTE - DUPLICATES ALLOWED (INDEXED) *
3502 REM * 1 BYTE - COMPRESSION ON KEY (INDEXED) *
3504 REM * 2 BYTE - ORDINAL NUMBER (INDEXED) *
3506 REM * 2 BYTE - START POS. OF KEY (INDEXED) *
3508 REM * 2 BYTE - KEY LENGTH (INDEXED) *
3510 REM * EXAMPLE *
3512 REM * 10 DIM N$32 *
3514 REM * 20 N$="///ANYVOL/ANYLIB/NAMEFILE" *
3516 REM * 50 GOSUB '203 (N$) *
3518 REM * 60 IF V0$ = HEX(FF) THEN 80 *
3520 REM * 70 STOP "ERROR IN OPEN" *
3522 REM * 80 REM FILE HANDLE = V9$ *
3524 REM * *
3526 REM *****************************************************************
3528 DEFFN '203 (V$)
3530 REM CONSTRUCT OMT HEADER & COMMAND STRUCTURE FOR GET ATTRIBUTE LIST
3532 REM DEFINE HDR
: 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 REM 'GETATTR' CMD STRUCTURE
: V8$()=ALL(" ")
: STR(V8$(),1,5)=HEX(0200000000)
3536 REM CHECK NAME
: IF STR(V$,1,2)<>"//" THEN 3552
3538 REM LENGTH OF BYTES
: V1=LEN(V$)
: V2=(V1+2)+6
: STR(V8$(),6,2)=BIN(V2,2)
3540 REM OBJECT NAME
: STR(V8$(),8,V1+2)=HEX(04) & V$ & HEX(00)
3542 REM TYPE = FILE
: V1=V1+10
: STR(V8$(),V1,7)=HEX(04) & "FILE" & HEX(0000)
3544 REM SEND DATA TO 2258 AND GET RESPONSE
: GOSUB '199
: IF V0$<>HEX(FF) THEN 3554
3546 REM UPDATE SMB\A0HEADER
: 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 REM GOOD RETURN
: V0$=HEX(FF)
: RETURN
3552 REM SMB ERROR
: V0$=HEX(A5)
: RETURN
3554 REM BAD OPEN INIT RETURN VALUES TO 00'S AND 20'S
: V0$=HEX(00)
: RETURN
3556 DEFFN'31"N$=";HEX(22);"VSACESS9";HEX(22);": SCRATCH T N$: SAVE T () N$"