ӡth~QUI.BCK\QUI.BCKBACKUP/LOG *.*; QUI.BCK/SAVE DIAKONOFF_N @b6V5.3 _DECUSF::  _DECUSF$DUA0: V5.3 ~ !*[DIAKONOFF_N.PROG]FAST_SCAN.FOR;1+,&./@ 4I-e 0123KPWO56%7a#89G@HJ subroutine FAST_SCAN; 1 (USER,FIRST_KEY,LAST_KEY,WILDCARD_FLAG,LAST_USED_FLAG) implicit integer (A-Z)!I! Cette fonction dtermine si l'exploration du fichier peut se faire dansI! un mode "fast" par dtermination de la 1re et de la dernire cl sur! lesquelles "scaner".!& character*(*) USER,FIRST_KEY,LAST_KEY LAST_USED_FLAG = USER.eq.'.' STAR = index(USER,'*') PERCENT = index(USER,'%') I = min(STAR,PERCENT)" if (I.eq.0) I = max(STAR,PERCENT) WILDCARD_FLAG = I.ne.0 if (I.le.1) then do J = 1, len(FIRST_KEY) FIRST_KEY(J:J) = char(0) end do do J = 1, len(LAST_KEY) LAST_KEY(J:J) = char(255) end do else LAST_KEY = USER do J = I, len(USER) LAST_KEY(J:J) = char(0) end do FIRST_KEY = LAST_KEY I = I-11 LAST_KEY(I:I) = char(ichar(LAST_KEY(I:I))+1) end if return end*[DIAKONOFF_N.PROG]QUI.FOR;1+,h./@ 4M-e 0123KPWO56ˌ7#89G@HJ  options /Extend_source program QUI implicit integer (A-Z)!L! Ce programme affiche les champs Username & Personnal Name du fichier! VMSMAIL_PROFILE.DATA.!! Modifications! -------------!F! ND 7 AUG 89 Numrotation des noms, Francisation des messages. (*01)F! ND 15 SEP 89 Correction bug dans numrotation. (*02)!4 character*31 FIRST_USER,LAST_USER,PATTERN character*255 BUFFER ICOUNT = 1 ! *01 do while (L.eq.0)K if (.not.LIB$GET_FOREIGN (PATTERN,'Nom de l''utilisateur: ',L)) 1 call EXIT enddoM open (unit=1, file='VMSMAIL_PROFILE', defaultfile='SYS$SYSTEM:.DATA',= 1 access='KEYED', recordtype='VARIABLE', status='OLD',, 2 readonly, shared, form='FORMATTED')M call FAST_SCAN (PATTERN,FIRST_USER,LAST_USER,WILDCARD,LAST_USED_FLAG) if (.not.WILDCARD) thenL read (unit=1,fmt=10,keyid=0,keyeq=PATTERN(:L),iostat=IOS) BUFFER10 format (A)> if (IOS.eq.0) call OUTPUT (BUFFER,ICOUNT) ! *02 elseK read (unit=1,fmt=10,keyid=0,keygt=FIRST_USER,iostat=IOS) BUFFER< do while (IOS.eq.0.and.BUFFER(:31).le.LAST_USER)F if (LIB_MATCH_WILDCARDS(BUFFER(:31),PATTERN(:L))) then9 call OUTPUT (BUFFER,ICOUNT) ! *02 end if6 read (unit=1,fmt=10,iostat=IOS) BUFFER end do end if end options /Extend_sourceB subroutine OUTPUT (BUFFER,ICOUNT) ! Rajout de ICOUNT *02 implicit integer*4 (A-Z) character*(*) BUFFER character*3 NUMERO ! *02 I = 32 K = 0$ ENCODE (3,5,NUMERO) ICOUNT ! *01 5 FORMAT (I3) ! *01% do while (I+2.lt.len(BUFFER))" K = ichar(BUFFER(I:I))& L = ichar(BUFFER(I+2:I+2)) if (K.eq.5)!!! Rajout dans le format de NUMERO.! et remplacement de ! par | (barre verticale)!2 1 call LIB$PUT_OUTPUT (NUMERO//' | '// = 2 BUFFER(:31)//'| '//BUFFER(I+4:I+3+L)) I = I + 4 + L, if (K.eq.5) ICOUNT = ICOUNT + 1 ! *02 end do return end!*[DIAKONOFF_N.PROG]WILDCARDS.MAR;1+,./@ 47,-e 0123KPWO56@7&R'89G@HJ .TITLE LIB_MATCH_WILDCARDS .IDENT /V2.0/; CANDIDATE = 4 PATTERN = 8; COMMA = ^X2C STAR = ^X2APERCENT = ^X25 BLANK = ^X20;& .PSECT CODE,LONG,PIC,RD,NOWRT,EXE,SHR7 .ENTRY LIB_MATCH_WILDCARDS,^M MOVQ @CANDIDATE(AP),R2 MOVZWL R2,R2 MOVQ @PATTERN(AP),R4 MOVZWL R4,R4 MOVQ R2,R0TRIM_CANDIDATE: LOCC #BLANK,R0,(R1) MOVW R0,R6 SKPC #BLANK,R0,(R1) BNEQ TRIM_CANDIDATE SUBW2 R6,R2 NEXT: LOCC #COMMA,R4,(R5) BEQL LAST PUSHR #^M SUBW2 R0,R4 BSBB MATCH TSTL R0 BNEQ RETURN POPR #^M ADDL2 R4,R5 INCL R5 SUBW3 #1,R0,R4 BRB NEXTLAST: MOVQ R4,R0 TRIM_PATTERN: LOCC #BLANK,R0,(R1) MOVW R0,R6 SKPC #BLANK,R0,(R1) BNEQ TRIM_PATTERN SUBW2 R6,R4 BSBB MATCHRETURN: RET;MATCH: PUSHR #^M MOVL #-1,R0 ; Assume success CLRL R6 BRB 5$1$: MOVZBL (R5)+,R1 CMPB R1,#STAR BEQL 7$ SOBGEQ R2,4$2$: CLRL R03$: POPR #^M RSB 4$: CMPB R1,(R3)+ BEQL 5$ CMPB R1,#PERCENT BNEQ 6$5$: SOBGEQ R4,1$ TSTL R2 BEQL 3$6$: DECL R6 BLSS 2$ INCL R7 MOVQ R6,R2 MOVQ R8,R4 BRB 5$7$: TSTL R4 BEQL 3$ MOVQ R2,R6 MOVQ R4,R8 BRB 5$; .ENDe3䐰~QUI.BCKQUI.BCKBACKUP/LOG *.*; QUI.BCK/SAVE DIAKONOFF_N @b6V5.3 _DECUSF::  _DECUSF$DUA0: V5.3 ~ !*[DIAKONOFF_N.PROG]FAST_SCAN.FOR;1+,&./@ 4I-e 0123KPWO56%7a#89G@HJ subroutine FAST_SCAN; 1 (USER,FIRST_KEY,LAST_KEY,WILDCARD_FLAG,LAST_USED_FLAG) implicit integer (A-Z)!I! Cette fonction dtermine si l'exploration du fichier peut se faire dansI! un mode "fast" par dtermination de la 1re et de la dernire cl sur! lesquelles "scaner".!& character*(*) USER,FIRST_KEY,LAST_KEY LAST_USED_FLAG = USER.eq.'.' STAR = index(USER,'*') PERCENT = index(USER,'%') I = min(STAR,PERCENT)" if (I.eq.0) I = max(STAR,PERCENT) WILDCARD_FLAG = I.ne.0 if (I.le.1) then do J = 1, len(FIRST_KEY) FIRST_KEY(J:J) = char(0) end do do J = 1, len(LAST_KEY) LAST_KEY(J:J) = char(255) end do else LAST_KEY = USER do J = I, len(USER) LAST_KEY(J:J) = char(0) end do FIRST_KEY = LAST_KEY I = I-11 LAST_KEY(I:I) = char(ichar(LAST_KEY(I:I))+1) end if return end*[DIAKONOFF_N.PROG]QUI.FOR;1+,h./@ 4M-e 0123KPWO56ˌ7#89G@HJ  options /Extend_source program QUI implicit integer (A-Z)!L! Ce programme affiche les champs Username & Personnal Name du fichier! VMSMAIL_PROFILE.DATA.!! Modifications! -------------!F! ND 7 AUG 89 Numrotation des noms, Francisation des messages. (*01)F! ND 15 SEP 89 Correction bug dans numrotation. (*02)!4 character*31 FIRST_USER,LAST_USER,PATTERN character*255 BUFFER ICOUNT = 1 ! *01 do while (L.eq.0)K if (.not.LIB$GET_FOREIGN (PATTERN,'Nom de l''utilisateur: ',L)) 1 call EXIT enddoM open (unit=1, file='VMSMAIL_PROFILE', defaultfile='SYS$SYSTEM:.DATA',= 1 access='KEYED', recordtype='VARIABLE', status='OLD',, 2 readonly, shared, form='FORMATTED')M call FAST_SCAN (PATTERN,FIRST_USER,LAST_USER,WILDCARD,LAST_USED_FLAG) if (.not.WILDCARD) thenL read (unit=1,fmt=10,keyid=0,keyeq=PATTERN(:L),iostat=IOS) BUFFER10 format (A)> if (IOS.eq.0) call OUTPUT (BUFFER,ICOUNT) ! *02 elseK read (unit=1,fmt=10,keyid=0,keygt=FIRST_USER,iostat=IOS) BUFFER< do while (IOS.eq.0.and.BUFFER(:31).le.LAST_USER)F if (LIB_MATCH_WILDCARDS(BUFFER(:31),PATTERN(:L))) then9 call OUTPUT (BUFFER,ICOUNT) ! *02 end if6 read (unit=1,fmt=10,iostat=IOS) BUFFER end do end if end options /Extend_sourceB subroutine OUTPUT (BUFFER,ICOUNT) ! Rajout de ICOUNT *02 implicit integer*4 (A-Z) character*(*) BUFFER character*3 NUMERO ! *02 I = 32 K = 0$ ENCODE (3,5,NUMERO) ICOUNT ! *01 5 FORMAT (I3) ! *01% do while (I+2.lt.len(BUFFER))" K = ichar(BUFFER(I:I))& L = ichar(BUFFER(I+2:I+2)) if (K.eq.5)!!! Rajout dans le format de NUMERO.! et remplacement de ! par | (barre verticale)!2 1 call LIB$PUT_OUTPUT (NUMERO//' | '// = 2 BUFFER(:31)//'| '//BUFFER(I+4:I+3+L)) I = I + 4 + L, if (K.eq.5) ICOUNT = ICOUNT + 1 ! *02 end do return end!*[DIAKONOFF_N.PROG]WILDCARDS.MAR;1+,./@ 47,-e 0123KPWO56@7&R'89G@HJ .TITLE LIB_MATCH_WILDCARDS .IDENT /V2.0/; CANDIDATE = 4 PATTERN = 8; COMMA = ^X2C STAR = ^X2APERCENT = ^X25 BLANK = ^X20;& .PSECT CODE,LONG,PIC,RD,NOWRT,EXE,SHR7 .ENTRY LIB_MATCH_WILDCARDS,^M MOVQ @CANDIDATE(AP),R2 MOVZWL R2,R2 MOVQ @PATTERN(AP),R4 MOVZWL R4,R4 MOVQ R2,R0TRIM_CANDIDATE: LOCC #BLANK,R0,(R1) MOVW R0,R6 SKPC #BLANK,R0,(R1) BNEQ TRIM_CANDIDATE SUBW2 R6,R2 NEXT: LOCC #COMMA,R4,(R5) BEQL LAST PUSHR #^M SUBW2 R0,R4 BSBB MATCH TSTL R0 BNEQ RETURN POPR #^M ADDL2 R4,R5 INCL R5 SUBW3 #1,R0,R4 BRB NEXTLAST: MOVQ R4,R0 TRIM_PATTERN: LOCC #BLANK,R0,(R1) MOVW R0,R6 SKPC #BLANK,R0,(R1) BNEQ TRIM_PATTERN SUBW2 R6,R4 BSBB MATCHRETURN: RET;MATCH: PUSHR #^M MOVL #-1,R0 ; Assume success CLRL R6 BRB 5$1$: MOVZBL (R5)+,R1 CMPB R1,#STAR BEQL 7$ SOBGEQ R2,4$2$: CLRL R03$: POPR #^M RSB 4$: CMPB R1,(R3)+ BEQL 5$ CMPB R1,#PERCENT BNEQ 6$5$: SOBGEQ R4,1$ TSTL R2 BEQL 3$6$: DECL R6 BLSS 2$ INCL R7 MOVQ R6,R2 MOVQ R8,R4 BRB 5$7$: TSTL R4 BEQL 3$ MOVQ R2,R6 MOVQ R4,R8 BRB 5$; .ENDe