               <<< DUA0:[NOTES$LIBRARY]PROGRAMMATHEQUE.NOTE;1 >>>
                        -< Suivi des programmes DECUS >-
================================================================================
Note 24.0                       Procédures utiles                     12 replies
DECUSF::DIAKONOFF_N "Responsable programmathèque"     8 lines  15-JUN-1989 19:03
--------------------------------------------------------------------------------

    
    	Vous trouverez en REPLY quelques petits bricolos que j'ai récupéré
    à droite et à gauche.
    	Ils sont tels quels.
    	A vous de les adapter à votre cas particulier.
    
    	Ces bricolos sont tous en language DCL et fonctionnent chez
    moi en V4.7
================================================================================
Note 24.1                       Procédures utiles                        1 of 12
DECUSF::DIAKONOFF_N "Responsable programmathèque"    80 lines  15-JUN-1989 19:04
                                -< BLOCAGE.COM >-
--------------------------------------------------------------------------------

$ ! ---------------------------------------------------------------------------
$ !
$ !	Procédure de commande : BLOCAGE.COM
$ !				A inclure dans votre SYLOGIN.COM
$ !	But   :
$ !
$ !	Cette partie de programme va permettre de savoir si l'utilisateur qui
$ !	se connecte est déjà connecté.
$ !	Si oui et s'il n'a pas le droit : LOGOUT.
$ !	ATTENTION : Il faut modifier les lignes suivantes dans le source ...
$ ! if (NOM_PERSO.eqs."LE_CHEF     ") then A_EJECTER=1
$ ! if (NOM_PERSO.eqs."LE_RALEUR   ") then A_EJECTER=1
$ !	Ainsi que celles là :
$ ! if (NOEUD.eqs."NODE_2") then goto noeud_ok		!**001
$ ! if (NOEUD.eqs."NODE_3") then goto noeud_ok		!**001
$ !	Sans oublier :
$ ! if (NOM_PERSO.eqs."USER_NODE_2 ") then A_EJECTER=1	!**001
$ ! if (NOM_PERSO.eqs."USER_NODE_3 ") then A_EJECTER=1	!**001
$ !
$ !
$ !	Date   : 18-01-1989
$ !
$ !	Auteur : JFR
$ !
$ !	Modification : ND le 30 Mars 1989
$ !
$ !		La modification permet de tester maintenant uniquement les
$ !	 process INTERACTIF ou NETWORK ( Ne fait rien si OTHER ou BATCH).
$ !		Modification du test sur les valeurs retournées par f$pid
$ !	car les valeurs retournées sont des strings.
$ !		Si le process est DECNET alors pas de deconnection.
$ !
$ !	Modification : JFR le 31 Mai 1989
$ !
$ !		Intégration des VS2000		**001
$ ! ---------------------------------------------------------------------------
$ !
$	On Control_y Then LOGOUT
$	On Error     Then LOGOUT
$	PID_PERSO  == f$getjpi ("","PID")
$	NOM_PERSO  == f$getjpi ("","USERNAME")
$	A_EJECTER  = 0
$	if (NOM_PERSO.eqs."LE_CHEF     ") then A_EJECTER=1
$	if (NOM_PERSO.eqs."LE_RALEUR   ") then A_EJECTER=1
$	if (NOM_PERSO.eqs."SYSTEM      ") then A_EJECTER=1
$	if (NOM_PERSO.eqs."DECNET      ") then exit
$	NOEUD	   == f$getsyi("NODENAME")			!**001
$	if (NOEUD.eqs."NODE_2") then goto noeud_ok		!**001
$	if (NOEUD.eqs."NODE_3") then goto noeud_ok		!**001
$	goto NON_VAX_STATION					!**001
$NOEUD_OK:							!**001
$	if (NOM_PERSO.eqs."USER_NODE_2 ") then A_EJECTER=1	!**001
$	if (NOM_PERSO.eqs."USER_NODE_3 ") then A_EJECTER=1	!**001
$NON_VAX_STATION:						!**001
$!
$!  write sys$output PID_PERSO,NOM_PERSO
$!
$
$BOUCLE:
$ !
$ ! Recherche du prochain PID courant
$ !
$	PID_COURANT = f$pid (CONTEXT)
$	if (PID_COURANT.eqs."") then exit
$	if (f$getjpi(PID_COURANT,"MODE").eqs."OTHER") then goto BOUCLE
$	if (f$getjpi(PID_COURANT,"MODE").eqs."BATCH") then goto BOUCLE
$	NOM_COURANT = f$getjpi(PID_COURANT,"USERNAME")
$!	write sys$output nom_perso,nom_courant,pid_perso,"  ",pid_courant
$	if (NOM_PERSO.nes.NOM_COURANT) then goto BOUCLE
$	if (PID_PERSO.eqs.PID_COURANT) then goto BOUCLE
$ !
$ !------- Erreur détectée ........
$ !
$	write sys$output -
 f$fao("	[1;7mVérification des personnes connectées[0m     [1;4mLe !%D[0m",0)
$	types sys$input
	Vous êtes connecté au moins 2 fois sur le système !"
$ !
$	if (A_EJECTER.eq.0) then LOGOUT
$	exit
================================================================================
Note 24.2                       Procédures utiles                        2 of 12
DECUSF::DIAKONOFF_N "Responsable programmathèque"   284 lines  15-JUN-1989 19:05
--------------------------------------------------------------------------------

$SET NOVER
$!	Procédure : ETIQUETTES.COM
$!	Auteur    : N_DIAKONOFF
$!	Création  : 11 Avril 89
$!	But	  : Edition d'étiquettes autocollantes sur LNO3.
$!
$	On Control_y Then Goto END
$	On Error     Then Goto END
$!
$	GOTO AFAIRE
$!
$ AIDE:
$   SAY "[2J[1;60HMode d'emploi 1/3"
$   SAY ""
$   SAY ""
$   SAY "	Procédure ETIQUETTES"
$   SAY "		  =========="
$   SAY ""
$   SAY "But    : Edition d'étiquettes autocollantes sur LN03"
$   SAY ""
$   SAY "Format : LOGO CNI : Les étiquettes font 6 lignes sur 26 colonnes"
$   SAY "         VIERGES  : Les étiquettes font 6 lignes sur 38 colonnes"
$   SAY ""
$   SAY "         Vous pouvez imprimer une seule étiquette à l'endroit où vous"
$   SAY "         le désirez en indiquant le numéro de la colonne et l'endroit"
$   SAY "         gauche (défaut) ou droite."
$   SAY ""
$   SAY "         Au dessus de 1, les impressions se font par paire."
$   SAY "         Par exemple 3 exemplaires demandés feront 4 étiquettes."
$   SAY ""
$   SAY "         L'imprimante par défaut est la LN03 de la DT."
$   SAY "         Pour changer ce défaut, il faut répondre par exemple : DG"
$   SAY "         et l'impression se fera sur l'imprimante IMP9."
$   SAY ""
$   SAY ""
$	Inquire P1 "Appuyer sur une touche pour continuer "
$   SAY "[2J[1;60HMode d'emploi 2/3"
$   SAY ""
$   SAY "Les touches de commandes sont les suivantes ( les mêmes que DCL) :"
$   SAY ""
$   SAY " <Retour> ou <Valider> = Validation de la zone à saisir."
$   SAY ""
$   SAY " Flèches (Haut, Bas, Gauche, Droite) = Déplacement du curseur."
$   SAY "	      Les flèches Haut et Bas rapellent les lignes."
$   SAY ""
$   SAY " <x]       = Effacement du caractère précédent."
$   SAY ""
$   SAY " <CTRL> U  = Effacement de la ligne complète."
$   SAY ""
$   SAY " <CTRL> H  = Déplacement du curseur en début de ligne."
$   SAY ""
$   SAY " <CTRL> E  = Déplacement du curseur en fin de ligne"
$   SAY ""
$   SAY " <CRTL> A  = Changement de mode insertion (défaut)/ Réécriture."
$   SAY ""
$   SAY ""
$	Inquire P1 "Appuyer sur une touche pour continuer "
$   SAY "[2J[1;60HMode d'emploi 3/3"
$   SAY ""
$   SAY "Les particularités sont les suivantes :"
$   SAY ""
$   SAY "Si la ligne commence par $, elle est graissée."
$   SAY ""
$   SAY "Si la ligne commence par #, elle est graissée et soulignée."
$   SAY ""
$   SAY "Pour mettre des minuscules, des apostrophes, des tirets, des blancs"
$   SAY "devant ou un caratère spécial, mettre la ligne entre des GUILLEMETS."
$   SAY ""
$   SAY "Retour à la ligne supérieure, taper @@ (=Exit sur Ligne 1)"
$   SAY ""
$   SAY "? à la réponse de la ligne 1 donne ce mode d'emploi."
$   SAY ""
$   SAY "Les réponses par défaut sont entre crochets [..]."
$   SAY ""
$   SAY "PS : Les deux dernières étiquettes de la feuille ne peuvent être"
$   SAY "     imprimées (dépasse les 66 lignes admises pour la LN03"
$   SAY ""
$   SAY ""
$!
$	Inquire P1 "Appuyer sur une touche pour continuer "
$!
$ AFAIRE:
$   SAY "[2J[1;70H[1m[5m[7mETIQUETTES[0m"
$   SAY ""
$   SAY ""
$	Inquire FORMAT "Etiquettes LOGO CNI (L) ou VIERGES (V) [L] "
$	If FORMAT.eqs.""  Then FORMAT="L"
$	If FORMAT.eqs."l" Then FORMAT="L"
$	If FORMAT.eqs."v" Then FORMAT="V"
$	If (FORMAT.eqs."L") .or. (FORMAT.eqs."V") Then Goto REPONSEOK
$	If FORMAT.eqs."@@" then Goto END
$	Goto AFAIRE
$ REPONSEOK:
$   If FORMAT.eqs."L" Then SAY "[2J[1;56H[1m[5m[7mETIQUETTES LOGO C.N.I.[0m"
$   If FORMAT.eqs."V" Then SAY "[2J[1;56H[1m[5m[7mETIQUETTES VIERGES[0m"
$   SAY "Si la ligne commence par $, elle est graissée."
$   SAY "Si la ligne commence par #, elle est graissée et soulignée."
$   SAY "Pour caractères minus., blancs ou spéciaux, ligne entre GUILLEMETS."
$   SAY "Retour à la ligne supérieure, taper @@ (=Exit sur Ligne 1)"
$   SAY ""
$   SAY "Pour avoir le mode d'emploi, appuyer sur ? à la Ligne 1."
$   SAY ""
$   If FORMAT.eqs."L" Then SAY "                            1.......10....5...20.....6"
$   If FORMAT.eqs."V" Then SAY "                            1.......10....5...20....5...30....5..8"
$   SAY ""
$	If FORMAT.eqs."L" Then Goto PARA_LOGO
$	NBRCAR = 38
$	NBRMAX = 39
$	BLANC12 = ""
$	LONGMAX = 42
$	Goto NOTP1
$ PARA_LOGO:
$	NBRCAR = 26
$	NBRMAX = 27
$	BLANC12 = "            "
$	LONGMAX = 30
$!
$ NOTP1:
$	Inquire P1 "Ligne 1 de ''NBRCAR' caractères "
$	If F$LENGTH(''P1').ge.NBRMAX then goto NOTP1
$	If P1.eqs."?"  then Goto AIDE
$	If P1.eqs."@@" then Goto END
$ NOTP2:
$	Inquire P2 "Ligne 2 de ''NBRCAR' caractères "
$	If F$LENGTH(''P2').ge.NBRMAX then goto NOTP2
$	If P2.eqs."@@" then Goto NOTP1
$ NOTP3:
$	Inquire P3 "Ligne 3 de ''NBRCAR' caractères "
$	If F$LENGTH(''P3').ge.NBRMAX then goto NOTP3
$	If P3.eqs."@@" then Goto NOTP2
$ NOTP4:
$	Inquire P4 "Ligne 4 de ''NBRCAR' caractères "
$	If F$LENGTH(''P4').ge.NBRMAX then goto NOTP4
$	If P4.eqs."@@" then Goto NOTP3
$ NOTP5:
$	Inquire P5 "Ligne 5 de ''NBRCAR' caractères "
$	If F$LENGTH(''P5').ge.NBRMAX then goto NOTP5
$	If P5.eqs."@@" then Goto NOTP4
$ NOTP6:
$	Inquire P6 "Ligne 6 de ''NBRCAR' caractères "
$	If F$LENGTH(''P6').ge.NBRMAX then goto NOTP6
$	If P6.eqs."@@" then Goto NOTP5
$!
$   SAY ""
$ FAUXP8:
$	COTE = ""
$	Inquire P8 "Nombre d'exemplaires     "
$	If P8.eqs."@@" then Goto NOTP6
$	If (P8.le.0) .or. (P8.ge.321) Then Goto FAUXP8
$	If P8.ne.1 Then Goto FAUXP9
$ FAUXCOTE:
$	Inquire COTE "Côté Droit (D) ou Gauche (G) [G]  "
$	If COTE.eqs."@@" then Goto FAUXP8
$	If COTE.eqs."" Then COTE = "G"
$	If (COTE.eqs."D") .or. (COTE.eqs."G") Then Goto FAUXP9
$	If (COTE.eqs."d") .or. (COTE.eqs."g") Then Goto FAUXP9
$	Goto FAUXCOTE
$!
$ FAUXP9:
$	If P8.ne.1 Then P8 = ( ( P8 - 1 ) / 2 ) + 1
$	Inquire P9 "Numéro ligne étiquette   "
$	If P9.eqs."@@" then Goto FAUXCOTE
$	If (P9.le.0) .or. (P9.ge.8) Then Goto FAUXP9
$!
$   SAY ""
$	Inquire IMPRIMANTE "Nom de l'imprimante [LA] "
$	If IMPRIMANTE.eqs."@@" then Goto FAUXP9
$	If IMPRIMANTE.eqs."" then IMPRIMANTE="LA/NOHEADER/NONOTIFY"
$!
$	LENP1   = LONGMAX - F$LENGTH(''P1')
$	FIRST   = F$extract(0,1,''P1')
$	If FIRST.eqs."$" Then P1 = "[1m"     + ( ''P1' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P1 = "[1m[3m" + ( ''P1' - "#" ) + "[0m "
$	P1      = BLANC12 + F$FAO("''P1'!#* ",LENP1)
$	LENP2   = LONGMAX - F$LENGTH(''P2')
$	FIRST   = F$extract(0,1,''P2')
$	If FIRST.eqs."$" Then P2 = "[1m"     + ( ''P2' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P2 = "[1m[3m" + ( ''P2' - "#" ) + "[0m "
$	P2      = BLANC12 + F$FAO("''P2'!#* ",LENP2)
$	LENP3   = LONGMAX - F$LENGTH(''P3')
$	FIRST   = F$extract(0,1,''P3')
$	If FIRST.eqs."$" Then P3 = "[1m"     + ( ''P3' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P3 = "[1m[3m" + ( ''P3' - "#" ) + "[0m "
$	P3      = BLANC12 + F$FAO("''P3'!#* ",LENP3)
$	LENP4   = LONGMAX - F$LENGTH(''P4')
$	FIRST   = F$extract(0,1,''P4')
$	If FIRST.eqs."$" Then P4 = "[1m"     + ( ''P4' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P4 = "[1m[3m" + ( ''P4' - "#" ) + "[0m "
$	P4      = BLANC12 + F$FAO("''P4'!#* ",LENP4)
$	LENP5   = LONGMAX - F$LENGTH(''P5')
$	FIRST   = F$extract(0,1,''P5')
$	If FIRST.eqs."$" Then P5 = "[1m"     + ( ''P5' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P5 = "[1m[3m" + ( ''P5' - "#" ) + "[0m "
$	P5      = BLANC12 + F$FAO("''P5'!#* ",LENP5)
$	LENP6   = LONGMAX - F$LENGTH(''P6')
$	FIRST   = F$extract(0,1,''P6')
$	If FIRST.eqs."$" Then P6 = "[1m"     + ( ''P6' - "$" ) + "[0m "
$	If FIRST.eqs."#" Then P6 = "[1m[3m" + ( ''P6' - "#" ) + "[0m "
$	P6      = BLANC12 + F$FAO("''P6'!#* ",LENP6)
$! 
$	Open/Write CMD SYS$SCRATCH:ETIQUETTES.TMP
$	On Control_y Then Goto CLEANUP
$	On Error     Then Goto CLEANUP
$!
$	BOUCLE = 0
$	NBRP9  = 1
$	If FORMAT.eqs."L" Then Write CMD ""
$ AJUST:
$	If P9.eq.NBRP9 Then Goto FINAJUST
$	NBRP9 = NBRP9 + 1
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	If NBRP9.eq.2 Then Goto AJUST
$	If NBRP9.eq.4 Then Goto AJUST
$	If NBRP9.eq.5 Then Goto AJUST
$	Write CMD ""
$ Goto AJUST
$ FINAJUST:
$	If COTE.eqs."" Then Goto LOOP
$	If NBRP9.ne.7  Then WRITE CMD ""
$	If (COTE.eqs."D") .or. (COTE.eqs."d") Then Goto DROIT_AFAIRE
$	Write CMD "''P1'"
$	Write CMD "''P2'"
$	Write CMD "''P3'"
$	Write CMD "''P4'"
$	Write CMD "''P5'"
$	Write CMD "''P6'"
$	Goto C_FINI
$ DROIT_AFAIRE:
$	BLANC_SECOND = "                                          "
$	Write CMD BLANC_SECOND + "''P1'"
$	Write CMD BLANC_SECOND + "''P2'"
$	Write CMD BLANC_SECOND + "''P3'"
$	Write CMD BLANC_SECOND + "''P4'"
$	Write CMD BLANC_SECOND + "''P5'"
$	Write CMD BLANC_SECOND + "''P6'"
$	Goto C_FINI
$ LOOP:
$	BOUCLE = BOUCLE + 1
$	If NBRP9.ne.5 Then Write CMD ""
$	If (NBRP9.eq.5) .and. (FORMAT.eq."V") Then Write CMD ""
$	Write CMD "''P1'"+"''P1'"
$	Write CMD "''P2'"+"''P2'"
$	Write CMD "''P3'"+"''P3'"
$	Write CMD "''P4'"+"''P4'"
$	Write CMD "''P5'"+"''P5'"
$	Write CMD "''P6'"+"''P6'"
$	If NBRP9.ne.5     Then Write CMD ""
$	If (NBRP9.eq.2) .and. (FORMAT.eq."V") Then Write CMD ""
$	If (NBRP9.eq.5) .and. (FORMAT.eq."V") Then Write CMD ""
$	If (NBRP9.eq.5) .and. (FORMAT.eq."V") Then Write CMD ""
$	NBRP9 = NBRP9 + 1
$	IF P8.eq.BOUCLE  Then Goto C_FINI
$	If NBRP9.le.7    Then Goto LOOP
$	NBRP9 = 1
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	Write CMD ""
$	If FORMAT.eq."V" Then Write CMD ""
$	If FORMAT.eq."V" Then Write CMD ""
$	If FORMAT.eq."V" Then Write CMD ""
$ Goto LOOP
$!
$ C_FINI:
$	Close CMD
$	'IMPRIMANTE SYS$SCRATCH:ETIQUETTES.TMP
$ END:
$	FILE = F$search("SYS$SCRATCH:ETIQUETTES.TMP")
$	If FILE.eqs."" Then Exit
$	Delete/NoConfirm/NoLog SYS$SCRATCH:ETIQUETTES.TMP;*
$	Goto REPONSEOK
$!
$ CLEANUP:
$	Close CMD
$	Goto END
$!---------------------------------------------- Fin de la procédure ----------
================================================================================
Note 24.3                       Procédures utiles                        3 of 12
DECUSF::DIAKONOFF_N "Responsable programmathèque"    70 lines  15-JUN-1989 19:06
                              -< SHOW DEV AND % >-
--------------------------------------------------------------------------------

û$!	SHOW_DEV_D.COM
$!
$	SHOW DEV D
$!
$!	DISK.COM	- GRAPHIC DISPLAY OF DISK USAGE
$!
$	norme[0,32] = %x6D305B1B			! Normal rendition
$	blink[0,32] = %x6D355B1B			! blinking
$	say " "
$	say " "
$	say F$FAO("!28<DISK N. Log. Physique     % !>!15*x ''F$TIME()' !10*x")
$	say           "---- ------- ----------- --"
$	unit_number = 0				! Start with unit 0
$ suite_zero:
$	device_name  = "CNI$DUA" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_1
$	GOSUB dk_ok
$	GOTO suite_zero
$ suite_1:
$	unit_number = 0				! Start with unit 0
$ suite_un:
$	device_name  = "CNI01$DUA" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_2
$	GOSUB dk_ok
$	GOTO suite_un
$ suite_2:
$	unit_number = 0				! Start with unit 0
$ suite_deux:
$	device_name  = "CNI$DUB" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_3
$	GOSUB dk_ok
$	GOTO suite_deux
$ suite_3:
$	unit_number = 0				! Start with unit 0
$ suite_trois:
$	device_name  = "CNI01$DUB" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_4
$	GOSUB dk_ok
$	GOTO suite_trois
$ suite_4:
$	unit_number = 0				! Start with unit 0
$	device_name  = "CNI02$DUA" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_5
$	GOSUB dk_ok
$ suite_5:
$	unit_number = 0				! Start with unit 0
$	device_name  = "CNI03$DUA" + F$STRING(unit_number) + ":"
$	IF .NOT. F$GETDVI(device_name,"EXISTS") THEN GOTO suite_6
$	GOSUB dk_ok
$ suite_6:
$	say " "
$ EXIT
$------------------- subroutine
$ dk_ok:
$	unit_number = unit_number + 1
$	IF .NOT. F$GETDVI(device_name,"MNT") THEN RETURN
$	logvolnam = F$GETDVI(device_name,"LOGVOLNAM")
$	logvolnam = logvolnam - "DISK$"
$	IF F$LOCATE(P1,logvolnam) .EQS. F$LENGTH(logvolnam) THEN RETURN
$	media_name = F$GETDVI(device_name,"MEDIA_NAME")
$	freeblocks = F$GETDVI(device_name,"FREEBLOCKS")
$	maxblock   = F$GETDVI(device_name,"MAXBLOCK")
$	percent    = (maxblock-freeblocks) * 100 / maxblock
$	IF percent .GE.  0 THEN percent_bar = F$FAO("!#*¨",percent/2)
$	IF percent .LT.  0 THEN percent_bar = blink + "Erreur unité" + norme
$	IF percent .GE. 80 THEN percent_bar = blink + percent_bar + norme
$	say F$FAO("!28<!AS !7AS !11AS !UL!>!AS", -
	     media_name, logvolnam, device_name, percent, percent_bar)
$	RETURN
$
================================================================================
Note 24.4                       Procédures utiles                        4 of 12
DECUSF::DIAKONOFF_N "Responsable programmathèque"    65 lines  15-JUN-1989 19:07
                             -< ASSIGNATIONS.COM >-
--------------------------------------------------------------------------------

$ START:	! ASSIGN_KEEP.COM
$!
$!	Cette procédure de commande permet de créer des assignations logiques
$!	qui sont misent dans le fichier ASSIGNATIONS.COM.
$!
$!	A mettre dans votre LOGIN.COM : @ASSIGNATIONS
$!
$!	Pour l'ensemble des utilisateurs, le définir en symbol global ...
$!
$!	Vient de DECUS US CHAPTER VOLUME 4 NUMBER 8 APRIL.
$!	By John H.KREHBIEL, Cooper Tire and Rubber Company, FINDLAY, OHIO.
$!
$	DEFIL = "SYS$LOGIN:ASSIGNATIONS.COM"	! Fichier par défaut contenant
$						! les symboles.
$!
$	IF (P1 .EQS. "") THEN INQUIRE P1 "[F10] Assignation logique  "
$	IF (P1 .EQS. "") THEN GOTO END
$	LOGNAM = P1
$!
$	IF (P2 .EQS. "") THEN INQUIRE P2 "[F10] Assignation physique "
$	IF (P2 .EQS. "") THEN GOTO END
$	ASGNMT = P2
$!
$! L'assignation existe-t-elle ?
$!
$	IF (F$LOGICAL ("''LOGNAM'") .NES. "") THEN GOTO SUPERCEDE
$ CRE_ASS:
$! Si erreur de création alors message pour l'utilisateur.
$	ON ERROR THEN GOTO BAD_ASS
$! Création du symbole global.
$	DEFINE/NOLOG 'LOGNAM' 'ASGNMT' 
$! Faut-il mettre ce symbole dans un fichier ?
$	INQUIRE FILOUT "[''DEFIL'] L'inclure dans quel fichier ?"
$	IF (FILOUT .EQS. "") THEN FILOUT = DEFIL
$! Faut-il créer le fichier ou existe-t-il déjà ?
$	OPEN/APPEND/ERROR=OPEN_NEW ASSFIL 'FILOUT'
$ WRT_ASS:
	WRITE ASSFIL "$ ASSIGN ''LOGNAM'	''ASGNMT'"
$ CLS_ASS:
$	CLOSE ASSFIL
$	SORT 'FILOUT'  'FILOUT'		! Tri du fichier par nom de symbole.
$	PURGE/KEEP=1/NOLOG 'FILOUT'	! Nettoyage des versions.
$	GOTO END
$!
$ OPEN_NEW:	! Création du fichier.
$	OPEN/WRITE/ERROR=BAD_OPN ASSFIL 'FILOUT'
$	GOTO WRT_ASS
$!
$SUPERCEDE:
$	WRITE SYS$OUTPUT " Ce nom logique existe déjà :"
$	SHO LOGICAL 'LOGNAM'
$	INQUIRE ANS "[F10] Voulez-vous recréer cette assignation ? "
$	IF (ANS) THEN GOTO CRE_ASS
$	GOTO END
$!
$ BAD_OPN:
$	WRITE SYS$OUTPUT "Impossible d'ouvrir le fichier   . Recommencez"
$	GOTO END
$!
$ BAD_ASS:
$	WRITE SYS$OUTPUT "Impossible de créer l'assignation. Recommencez"
$	GOTO END
$!
$ END:
$	EXIT
================================================================================
Note 24.5                       Procédures utiles                        5 of 12
DECUSF::DIAKONOFF_N "Responsable programmathèque"    68 lines  15-JUN-1989 19:08
                                -< SYMBOL.com >-
--------------------------------------------------------------------------------

$ START:	! SYMBOL_KEEP.COM
$!
$!	Cette procédure de commande permet de créer des symboles globaux
$!	qui sont mis dans le fichier SYMBOLS.COM
$!	Mettre dans votre login : @SYMBOLS
$!	Vient de DECUS US CHAPTER VOLUME 4 NUMBER 8 APRIL.
$!	By John H.KREHBIEL, Cooper Tire and Rubber Company, F10DLAY, OHIO.
$!
$	DEFIL = "SYS$LOGIN:SYMBOLS.COM"		! Fichier par défaut contenant
$						! les symboles.
$!
$	IF (P1 .EQS. "") THEN INQUIRE P1 "[F10] Nom du symbole       "
$	IF (P1 .EQS. "") THEN GOTO END
$	GLOSYM = P1
$!
$	IF (P2 .EQS. "") THEN INQUIRE P2 "[F10] Commande équivalente "
$	IF (P2 .EQS. "") THEN GOTO END
$	EQVSTR = P2
$!
$!	Pour les paramètres de la commande (options)
$!
$	IF (P3 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P3'"
$	IF (P4 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P4'"
$	IF (P5 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P5'"
$	IF (P6 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P6'"
$	IF (P7 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P7'"
$	IF (P8 .NES. "") THEN EQVSTR = "'' EQVSTR' ''P8'"
$!
$! Le symbole existe-t-il ?
$!
$	IF (F$TYPE ('GLOSYM') .EQS. "") THEN GOTO CRE_DEF
$!
$! Il existe, il faut l'afficher.
$!
$	SHO SYMBOL 'GLOSYM'
$!
$! Faut-il le modifier ?
$!
$	INQUIRE ANS "[F10] Voulez-vous modifier ce symbole ?"
$	IF (.NOT. ANS) THEN GOTO END
$ CRE_DEF:
$! Si erreur de création alors message pour l'utilisateur.
$	ON ERROR THEN GOTO BAD_DEF
$	'GLOSYM' == "''EQVSTR'"		! Création du symbole global.
$! Faut-il mettre ce symbole dans un fichier ?
$	INQUIRE FILOUT "[''DEFIL'] L'inclure dans quel fichier ?"
$	IF (FILOUT .EQS. "") THEN FILOUT = DEFIL
$! Faut-il créer le fichier ou existe-t-il déjà ?
$	OPEN/APPEND/ERROR=OPEN_NEW DEFFIL 'FILOUT'
$ WRT_DEF:
	WRITE DEFFIL "$ ''GLOSYM'	== """, EQVSTR, """
$ CLS_DEF:
$	CLOSE DEFFIL
$	SORT 'FILOUT'  'FILOUT'		! Tri du fichier par nom de symbole.
$	PURGE/KEEP=1/NOLOG 'FILOUT'	! Nettoyage des versions.
$	GOTO END
$!
$ OPEN_NEW:	! Création du fichier.
$	OPEN/WRITE/ERROR=BAD_OPN DEFFIL 'FILOUT'
$	GOTO WRT_DEF
$ BAD_OPN:
$	WRITE SYS$OUTPUT "Impossible d'ouvrir le fichier. Recommencez"
$	GOTO END
$ BAD_DEF:
$	WRITE SYS$OUTPUT "Impossible de créer ce symbole. Recommencez"
$!
$ END:
$	EXIT
================================================================================
Note 24.6                       Procédures utiles                        6 of 12
DECUSF::VIBERT_JF "Dr J-F Vibert, Vice-President, Re" 3 lines  16-JUN-1989 01:39
                               -< Merci Nicolas >-
--------------------------------------------------------------------------------

    Bravo et Merci Nicolas, moi qui suis un debutant VMS et qui l'utilise
    en second apres Ultrix, ces petites procedures vont me simplifier
    la vie. Je pense que ce" sera le cas pour beaucoup.
================================================================================
Note 24.7                       Procédures utiles                        7 of 12
DECUSF::POLIN_C "Christian POLIN CGA-HBS Alcatel"   115 lines  19-JUN-1989 18:09
                             -< BLOCAGE.COM like. >-
--------------------------------------------------------------------------------

    Ci-après une variante à 24.1 (BLOCAGE.COM) 
    (à inclure dans SYS$SYLOGIN).
    
$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$!PROCÉDURE CONTRÔLE NB PROCESS INTERACTIFS DE CET UTILISATEUR
$! Le "logical" LOGIN_MAX_INTER definit le nombre de fois qu'un utilisateur
$! peut se logger sur le systeme (j'attends la prochaine FMR pour passer
$! en cluster). Il existe une valeur par défaut (cf PC_NMAX).
$! Ce logical peut être défini au niveau groupe ou system.
$! Le "logical" LOGIN_MAX_INTER_TOTO permet de donner un nombre de login
$! différent (+ grand ou petit) à l'utilisateur TOTO (username).
$! L'utilisateur a le choix du process à stopper.
$
$ pc_verify = f$verify(0)
$!(tous les symboles avec préfixe pc_)
$ pc_old_control = f$environment("control")
$ set nocontrol_y
$! pour recherche (f$pid) des processes de même UIC
$ pc_old_priv = f$setprv("noworld,nogroup")
$
$! CETTE PROCÉDURE NE DOIT ÊTRE EXÉCUTÉE QU'EN INTERACTIF ! ! ! !
$ if .not. f$environment("interactive") then goto pc_fin
$
$! détermination nombre de login interactif autorisé
$! valeur par défaut :
$ PC_NMAX = 4
$
$! niveau général ou groupe
$! contrôle que l'assignation est bien /executive (SYSNAM? requis pour le
$! définir)
$ pc_logical = "LOGIN_MAX_INTER"
$ pc_table = "LNM$GROUP"
$ if f$trnlnm(pc_logical,pc_table,,,,"access_mode") .eqs. "EXECUTIVE" -
then goto pc_ok
$ pc_table = "LNM$SYSTEM"
$ if f$trnlnm(pc_logical,pc_table,,,,"access_mode") .eqs. "EXECUTIVE" -
then goto pc_ok
$ goto pc_ok1
$pc_ok:
$ PC_NMAX = f$integer(f$trnlnm(pc_logical,pc_table))
$pc_ok1:
$
$! niveau username
$! contrôle que l'assignation est bien /executive
$ pc_logical = "LOGIN_MAX_INTER_" + f$edit(f$getjpi(0,"username"),"collapse")
$ pc_table = "LNM$GROUP"
$ if f$trnlnm(pc_logical,pc_table,,,,"access_mode") .eqs. "EXECUTIVE" -
then goto pc_ok2
$ pc_table = "LNM$SYSTEM"
$ if f$trnlnm(pc_logical,pc_table,,,,"access_mode") .eqs. "EXECUTIVE" -
then goto pc_ok2
$ goto pc_ok3 ! rien de spécifié pour cet user
$pc_ok2:
$ PC_NMAX = f$integer(f$trnlnm(pc_logical,pc_table))
$pc_ok3:
$
$
$ if PC_NMAX .eq. 0 then goto pc_fin
$ pc_context = ""
$ PC_N = 0
$pc_loop:
$ PC_PID = f$pid(pc_context)
$ if PC_PID .eqs. "" then goto pc_suite
$ ! saut des non-interactifs :
$ if f$getjpi(PC_PID,"mode") .nes. "INTERACTIVE" then goto pc_loop
$ ! saut des sous-processes :
$ if f$getjpi(PC_PID,"master_pid") .nes. PC_PID then goto pc_loop
$ PC_N = PC_N + 1
$ PC_PID'PC_N' = PC_PID
$goto pc_loop
$pc_suite:
$ if PC_N .le. 1 then goto pc_fin
$ set prompt = "''PC_N'_''f$environment(""prompt"")"
$pc_repeter:
$ write sys$output ""
$ write sys$output ""
$ write sys$output -
"Vous êtes actuellement connecté sur ce système ''PC_N' fois"
$ write sys$output ""
$ PC_I = 1
$pc_loop2:
$ if PC_I .gt. PC_N then goto pc_fin2
$ pc_imagename = f$parse(f$getjpi(PC_PID'PC_I',"imagname"),,,"name")
$ if pc_imagename .eqs. "" then -
$	pc_imagename = "(" + f$getjpi(PC_PID'PC_I',"cliname") + ")"
$ pc_terminal = f$getjpi(PC_PID'PC_I',"terminal")
$ pc_devnam = f$getdvi(pc_terminal,"tt_phydevnam")
$ if pc_devnam .eqs. "" then pc_devnam = "déconnecté de " + pc_terminal
$ pc_prcnam = f$getjpi(PC_PID'PC_I',"prcnam")
$ write sys$output f$fao("	!SL   !12AS !12AS	!AS"-
,PC_I,pc_prcnam,pc_imagename,pc_devnam)$ PC_I = PC_I + 1
$goto pc_loop2
$pc_fin2:
$ write sys$output ""
$ if PC_N .le. PC_NMAX then goto pc_fin
$ write sys$output "C'est trop pour un seul username !"
$ write sys$output ""
$ inquire/nopunc PC_CHOIX "Quel process faut-il arrêter ? "
$ PC_CHOIX = f$integer("''PC_CHOIX'")
$ if PC_CHOIX .gt. PC_N then goto pc_repeter
$ if PC_CHOIX .eq. 0 then goto pc_repeter
$ PC_DEBUG = PC_CHOIX .lt. 0 			! "No" plus tard
$ If PC_DEBUG then PC_CHOIX = -1 * PC_CHOIX 
$ PC_PID = PC_PID'PC_CHOIX'
$ if .not. PC_DEBUG then Stop /id='PC_PID'
$ write sys$output f$environment("prompt"),"stop /id=''PC_PID'"
$
$pc_fin:
$ pc_old_priv = f$setprv(pc_old_priv)
$ set control = ('pc_old_control')
$ pc_verify   = f$verify(pc_verify)
$ 
$!Fin Procédure contrôle nb process interactifs 
$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

================================================================================
Note 24.8                       Procédures utiles                        8 of 12
DECUSF::POLIN_C "Christian POLIN CGA-HBS Alcatel"    18 lines  19-JUN-1989 18:17
                        -< set def sys$login d'un user >-
--------------------------------------------------------------------------------

un autre bricolo bien pratique :
(je pense qu'il n'y a pas besoin de mode d'emploi)

---------------------------------------------------------
$ l0: if p1 .nes. "" then goto l1
$ inquire/nopunct p1 "username : "
$ goto l0
$ l1: UAF = f$parse("SYSUAF","SYS$SYSTEM:SYSUAF.DAT")
$ OPEN/SHARE/READ UAF 'UAF'
$ READ/KEY='P1' UAF U
$ CLOSE UAF
$ UDIR== F$EX(117,F$CVU(0,8,F$EX(116,1,U)),U)+-
F$EX(149,F$CVU(0,8,F$EX(148,1,U)),U)
$ SDU :== set default 'UDIR'
$ SHOW SYMBOL SDU
---------------------------------------------------------
il suffit de faire ensuite 
$ SDU
================================================================================
Note 24.9                       Procédures utiles                        9 of 12
DECUSF::MANET_P "Philippe - SECMAI - 60.17.16.16"     7 lines  12-JUL-1989 11:44
                             -< CLEANUP_MAIL.COM >-
--------------------------------------------------------------------------------

    
    Dans la meme famille, j'ai mis dans la directory VMS une procedure
    CLEANUP_MAIL.COM qui permet de supprimer de VMSMAIL_PROFILE.DAT
    les utilisateurs n'ayant plus de compte dans SYSUAF.
    
    Attention elle ne marche qu'en V5.x puisqu'elle utilise la nouvelle
    commande REMOVE de mail. Il faut aussi le privilege SYSPRV.
================================================================================
Note 24.10                      Procédures utiles                       10 of 12
DECUSF::GRACIA_J "José GRACIA - GRL/ELF Lacq"         9 lines  25-SEP-1989 14:22
                      -< -< Format du fichier SYSUAF >- >-
--------------------------------------------------------------------------------

   Quelqu'un connait-il la structure du fichier SYSUAF et existe-t-il
    une procédure pour le remettre en forme dans un autre format
    (DTR,ORACLE ou RdB...)?
    Objectif:
    	- passer plusieurs machines départementales en LAVC et reconstituer
    un SYSUAF (tout au moins l'essentiel) pour le SERVEUR
    	- pouvoir reformater mieux qu'avec AUTHORIZE l'information de
    SYSUAF
 
================================================================================
Note 24.11                      Procédures utiles                       11 of 12
DECUSF::GERARD_G "G. Gerard ENST centre de calcul"    5 lines  25-SEP-1989 15:39
                             -< sys$library:lib.* >-
--------------------------------------------------------------------------------

	Il y a $UAFDEF qui decrit les enregistrements de ce fichier
	... programmation accessible en MACRO et en BLISS ...
	sinon y a $GETUAI qui permet d'obtenir ces memes renseignements,
	mais bonjour les performances...
	pour fusionner les fichiers, sort/merge fonctionne, en gros...
================================================================================
Note 24.12                      Procédures utiles                       12 of 12
DECUSF::POLIN_C "Christian POLIN CGA-HBS Alcatel"     0 lines  25-SEP-1989 15:46
                                -< sysuaf.dtr >-
--------------------------------------------------------------------------------