pause-café
rendez-vous technique
Pause-Café est une réunion technique
destinée aux informaticiens sur plateforme IBM i.
destinée aux informaticiens sur plateforme IBM i.
Elle a lieu 3 à 4 fois par an : en Bretagne et sur internet.
Pause-café #15
Juin 1998
API Messages (permettent de traiter les messages en pgm HLL). Exemple : Déplacement de messages vers une autre PGMQ (dans la liste d'invocation) ATTENTION: Les messages *ESCAPE deviennent *DIAG + QMHMOVPM - BIN(4) clé du message (blanc = tous) - x fois CHAR(10) = type(s) de messages *COMP,*DIAG,*ESCAPE,*INFO 0 = par clé 1 à 4 si clé = blanc - BIN(4) nombre de types (0 à 4) - CHAR(10) PGMQ contenant les messages - un nom de pgm - '*' = le pgm en cours. - BIN(4) n° dans la pile 0 = le pgm en cours 1 = l'appelant x = x niveau au dessus - CHAR(?) Zone de retour d'erreur
API Messages
+ QMHRCVM Réception de messages à partir d'une MSGQ
(RCVMSG MSGQ(xxx).)
+ QMHRCVPM Réception de messages à partir d'une PGMQ
(RCVMSG PGMQ(xxx).)
+ QMHRMVM suppression de message(s) d'une MSGQ
(RMVMSG)
+ QMHRMVPM suppression de message(s) d'une PGMQ
(RMVMSG)
+ QMHRSNEM Renvoi le dernier message *ESCAPE reçu par un pgm vers l'appelant, toujours de type *ESCAPE. + QMHRTVM Retrouve la définition d'un message. (RTVMSG) + QMHRTVRQ Réception de messages *RQS PRATIQUE POUR (RCVMSG PGMQ(*EXT).) GERER F9 sur une ligne de cde. + QMHSNDBM envoi un message en BREAK (SNDBRKMSG) + QMHSNDM envoi un message à une MSGQ (SNDPGMMSG TOMSGQ(xxx).) + QMHSNDPM envoi un message à une PGMQ (SNDPGMMSG TOPGMQ(xxx).)
Quelques exemples d'utilisation en RPG:
* déclarations communes
E MTYP 2 10
IMSGTB DS
I 1 20 MTYP
IMSGDS DS
I 1 10 MSGF
I 11 20 MSGL
I 1 20 MSGFL
I B 21 240LENTXT
I B 25 280STACK
I B 29 320KEY
I B 33 360NBTYP
ICODERR DS
I I 16 B 1 40LGCOD
I B 5 80LGUTIL
I 9 15 MSGID
I 16 16 RESERV
* gestion des erreurs en cas de probleme
...............
*
* EN CAS D'ERREUR ==> RENVOI DES MESSAGES ET CANCEL DU PGM
*
C *PSSR BEGSR
C MOVEL'*DIAG' MTYP,1
C MOVEL'*ESCAPE' MTYP,2
C CALL 'QMHMOVPM'
C PARM MSGCLE 4
C PARM MSGTB
C PARM 2 NBTYP
C PARM '*' PGMQ 10
C PARM 1 STACK
C PARM CODERR
C ENDSR'*CANCL'
* envoi de message *STATUS dans l'external I 'Liste en cours..' C MTX I 'Liste terminée ' C MTX2 C MOVEL'QCPFMSG' MSGF C MOVEL'*LIBL' MSGL C MOVELMTX MSGTXT C CALL 'QMHSNDPM' C PARM 'CPF9898' ID 7 C PARM MSGFL C PARM MSGTXT 50 C PARM 50 LENTXT C PARM '*STATUS' MSGTYP 10 C PARM '*EXT' PGMQ 10 C PARM 0 STACK C PARM KEY C PARM CODERR * sous programme de chargement C EXSR ---- *
C MOVELMTX2 MSGTXT
C CALL 'QMHSNDPM'
C PARM 'CPF9898' ID 7
C PARM MSGFL
C PARM MSGTXT 50
C PARM 50 LENTXT
C PARM '*STATUS' MSGTYP 10
C PARM '*EXT' PGMQ 10
C PARM 0 STACK
C PARM KEY
C PARM CODERR
* supprime tous les messages reçus entre deux affichages
* (DSPF avec sous-fichier message)
C CALL 'QMHRMVPM'
C PARM '*' PGMQ 10
C PARM 0 STACK
C PARM KEY
C PARM '*ALL' RMVOPT 10
C PARM CODERR
*
* exemple en RPG-IV, retrouve le nom du pgm appellant
*
Dbinaire S 10I 0
DLENTXT S like(binaire)
DSTACK S like(binaire)
DKEY S like(binaire)
DATTENTE S like(binaire)
DCODERR DS
D LGCOD like(binaire) INZ(16)
D LGUTIL like(binaire)
D MSGID 7
D RESERV 1
*
* on envoi un message au programme au-dessus (stack = 1)
* et on le relit (dans les infos retournées il y a le nom du pgm)
*
C CALL 'QMHSNDPM' C PARM ID 7 C PARM MSGFL 20 C PARM 'peu importe' MSGTXT 10 C PARM 10 LENTXT C PARM '*INFO ' MSGTYP 10 C PARM '*' PGMQ 10 C PARM 1 STACK C PARM KEY C PARM CODERR C CALL 'QMHRCVPM' C PARM retour 120 C PARM 120 lentxt C PARM 'RCVM0200' format 8 C PARM '*' PGMQ 10 C PARM 1 STACK C PARM '*ANY' MSGTYP C PARM KEY C PARM 0 ATTENTE C PARM '*REMOVE' ACTION 10 C PARM CODERR c eval pgm = %subst(retour:111:10)
* * le même exemple en RPG-IV, sous forme d'une fonction * * utilisable sous la forme if quiappel(1) = 'xxxx' H nomain * prototype de la fonction * * (tout programme utilisant la fonction doit lui-même * contenir les deux lignes qui suivent) Dquiappel PR 10 D 10I 0 * corps de la fonction Pquiappel B D PI 10 D niveau 10I 0 * variables locales Dbinaire S 10I 0
DLENTXT S like(binaire) DSTACK S like(binaire) DKEY S like(binaire) DATTENTE S like(binaire) DCODERR DS D LGCOD like(binaire) INZ(16) D LGUTIL like(binaire) D MSGID 7 D RESERV 1 * * on envoi un message au programme au-dessus * et on le relit (dans les infos retournées il y a le nom du pgm) * * on rajoute UN pour tenir compte de la place occupée par le pgm * utilisant lui même la fonction et de laplace du PEP (entry point) c eval stack = niveau + 2 C CALL 'QMHSNDPM'
C PARM ID 7 C PARM MSGFL 20 C PARM 'peu importe' MSGTXT 10 C PARM 10 LENTXT C PARM '*INFO ' MSGTYP 10 C PARM '*' PGMQ 10 C PARM STACK C PARM KEY C PARM CODERR C CALL 'QMHRCVPM' C PARM retour 120 C PARM 120 lentxt C PARM 'RCVM0200' format 8 C PARM '*' PGMQ 10 C PARM STACK C PARM '*ANY' MSGTYP C PARM KEY C PARM 0 ATTENTE C PARM '*REMOVE' ACTION 10 C PARM CODERR c return %subst(retour:111:10) Pquiappel E
Registration Facility Nouvelles fonction de l'OS permettant d'associer à une fonction logiciel un pgm de contrôle entreprise chargé de valider une action. DEUX NOTIONS : - Exit POINT : association d'un point d'appel de programme à une action logiciel. ce point d'appel est nommé sur 20 caractères. Exemple : QIBM_QPWSF_File_Serveur la fonction serveur de fichier de Client/Access est reconnue, il est possible de lui associer un pgm de validation. > APIs : QUSRGPT permet de définir un point d'exit. + paramètres : nom du point d'exit, modifiable ou non action et format des données transmises au pgm nombre de programes d'exit maxi # possibilité d'enlever ce point d'exit ou non. QUSDRGPT permet d'enlever ce point d'exit.
Registration Facility Nouvelles fonction de l'OS permettant d'associer à une action logiciel un pgm de contrôle entreprise chargé de valider cette action. DEUX NOTIONS : - Exit program : programme associé à un point d'exit. l'écriture est à votre charge il reçoit deux paramètres 1/ 1 alpha renvoyé par le programme '0' = refus '1' = validation 2/ données reçues (description suivant le format) > APIs : QUSADDEP ajout d'un programe d'exit QUSRMVEP retrait un programe d'exit QUSRTVEI extraction d'informations > Commandes : WRKREGINF # ADDEXITPGM RMVEXITPGM
Attributs du réseau Système: S4409790 Nombre maximal d'étapes . . . . . . . . . . . . : 16 Accès aux demandes DDM . . . . . . . . . . . . . : *OBJAUT Accès aux demandes Client Access . . . . . . . . : *REGFAC <-- Type du réseau RNIS par défaut . . . . . . . . . : Liste de connexion RNIS par défaut . . . . . . . : QDCCNNLANY Support ANYNET admis . . . . . . . . . . . . . . : *NO Domaine du serveur de réseau . . . . . . . . . . : S4409790 ######################################################################## # # # Pour utiliser ces concepts avec Client/Access vous devez saisir : # # CHGNETA PCSACC(*REGFAC) # # # # ce qui permet d'avoir un pgm de contrôle par fonction # # (et non un pgm général comme en V2R30) # # # ######################################################################## Fin Appuyez sur ENTREE pour continuer. F3=Exit F12=Annuler
Work with Registration Info (WRKREGINF) Indiquez vos choix, puis appuyez sur ENTREE. Exit point . . . . . . . . . . . EXITPNT *REGISTERED Exit point format . . . . . . . FORMAT *ALL Output . . . . . . . . . . . . . OUTPUT * ######################################################################### # # # Puis utilisez WRKREGINF qui affiche tous les points d'exit définis. # # # ######################################################################### Fin F3=Exit F4=Invite F5=Réafficher F12=Annuler F13=Mode d'emploi invite F24=Autres touches
voici la liste des points d'exit définis en V4R20 :
Exit
Point Format Text
---------------------------------------------------------------------------
QIBM_QHQ_DTAQ DTAQ0100 Original Data Queue Server
QIBM_QJO_DLT_JRNRCV DRCV0100 Delete Journal Receiver
QIBM_QLZP_LICENSE LICM0100 Original License Mgmt Server
QIBM_QMF_MESSAGE MESS0100 Original Message Server
QIBM_QNPS_ENTRY ENTR0100 Network Print Server - entry
QIBM_QNPS_SPLF SPLF0100 Network Print Server - spool
QIBM_QOE_OV_USR_ADM UADM0100 OfficeVision/400 Administration
QIBM_QOE_OV_USR_SND DOCI0900 OfficeVision/400 Mail Send Exit point
QIBM_QOK_NOTIFY VRFY0100 System Directory Notify Exit point
QIBM_QOK_SUPPLIER SUPL0100 System Directory Supplier Exit point
QIBM_QOK_VERIFY VRFY0100 System Directory Verify Exit point
QIBM_QPWFS_FILE_SERV PWFS0100 File Server
QIBM_QRQ_SQL RSQL0100 Original Remote SQL Server
QIBM_QSU_LCMD EXTP0100 EXIT POINT FOR SEU USER DEFINE COMMANDS
QIBM_QSY_CHG_PROFILE CHGP0100 Change User Profile
QIBM_QSY_CRT_PROFILE CRTP0100 Create User Profile
QIBM_QSY_DLT_PROFILE DLTP0100 Delete User Profile - after delete
QIBM_QSY_DLT_PROFILE DLTP0200 Delete User Profile - before delete
QIBM_QSY_RST_PROFILE RSTP0100 Restore User Profile
QIBM_QTA_STOR_EX400 EX400200 Storage Extension Exit Program
QIBM_QTA_TAPE_TMS TMS00200 Tape Management Exit Program
QIBM_QTF_TRANSFER TRAN0100 Original File Transfer Function
QIBM_QTG_DEVINIT INIT0100 Telnet Device Initialization
QIBM_QTG_DEVTERM TERM0100 Telnet Device Termination
QIBM_QTMF_CLIENT_REQ VLRQ0100 FTP Client Request Validation
QIBM_QTMF_SERVER_REQ VLRQ0100 FTP Server Request Validation
QIBM_QTMF_SVR_LOGON TCPL0100 FTP Server Logon
QIBM_QTMT_WSG QAPP0100 WSG Server Sign-On Validation
QIBM_QTMX_SERVER_REQ VLRQ0100 REXEC Server Request Validation
QIBM_QTMX_SVR_LOGON TCPL0100 REXEC Server Logon
QIBM_QTOD_DHCP_ABND DHCA0100 DHCP Address Binding Notify
QIBM_QTOD_DHCP_ARLS DHCR0100 DHCP Address Release Notify
QIBM_QTOD_DHCP_REQ DHCV0100 DHCP Request Packet Validation
QIBM_QTOD_SERVER_REQ VLRQ0100 TFTP Server Request Validation
QIBM_QVP_PRINTERS PRNT0100 Original Virtual Print Server
QIBM_QWC_PWRDWNSYS PWRD0100 Prepower down system exit point
QIBM_QWC_QSTGLOWACN STGL0100 Auxiliary storage lower limit
QIBM_QWT_JOBNOTIFY NTFY0100 JOB NOTIFICATION
QIBM_QWT_PREATTNPGMS ATTN0100 Preattention program exit point
QIBM_QWT_SYSREQPGMS SREQ0100 Presystem request pgm exit point
QIBM_QZCA_ADDC ZCAA0100 Add Client exit point
QIBM_QZCA_REFC ZCAF0100 Refresh Client Information exit point
QIBM_QZCA_RMVC ZCAR0100 Remove Client exit point
QIBM_QZCA_SNMPTRAP ZCAT0100 SNMP trap routing exit point
QIBM_QZCA_UPDC ZCAU0100 Update Client Information exi
QIBM_QZDA_INIT ZDAI0100 Database Server - entry
QIBM_QZDA_NDB1 ZDAD0100 Database Server - data base access
QIBM_QZDA_NDB1 ZDAD0200 Database Server - data base access
QIBM_QZDA_ROI1 ZDAR0100 Database Server - object information
QIBM_QZDA_ROI1 ZDAR0200 Database Server - object information
QIBM_QZDA_SQL1 ZDAQ0100 Database Server - SQL access
QIBM_QZDA_SQL2 ZDAQ0200 Database Server - SQL access
QIBM_QZHQ_DATA_QUEUE ZHQ00100 Data Queue Server
QIBM_QZMFMSF_ACT MSFF0100 MSF Accounting Exit
QIBM_QZMFMSF_ADR_RSL MSFF0100 MSF Address Resolution
QIBM_QZMFMSF_ATT_CNV MSFF0100 MSF Attachment Conversion
QIBM_QZMFMSF_ATT_MGT MSFF0100 MSF Attachment Management
QIBM_QZMFMSF_ENL_PSS MSFF0100 MSF Envelope Processing
QIBM_QZMFMSF_LCL_DEL MSFF0100 MSF Local Delivery
QIBM_QZMFMSF_LST_EXP MSFF0100 MSF List Expansion
QIBM_QZMFMSF_MSG_FWD MSFF0100 MSF Message Forwarding
QIBM_QZMFMSF_NON_DEL MSFF0100 MSF Non Delivery
QIBM_QZMFMSF_SEC_AUT MSFF0100 MSF Security and Authority
QIBM_QZMFMSF_TRK_CHG MSFF0100 MSF Track Mail Message Change
QIBM_QZMFMSF_VLD_TYP MSFF0100 MSF Validate Type
QIBM_QZRC_RMT CZRC0100 Remote Command/Program Call
QIBM_QZSC_LM ZSCL0100 Central Server - license mgmt
QIBM_QZSC_NLS ZSCN0100 Central Server - conversion map
QIBM_QZSC_SM ZSCS0100 Central Server - client mgmt
QIBM_QZSO_SIGNONSRV ZSOY0100 TCP Signon Server
comment associer un programme :
Work with Registration Information Type options, press Enter. 5=Display exit point 8=Work with exit programs <-- Exit Exit Point Opt Point Format Registered Text QIBM_QHQ_DTAQ DTAQ0100 *YES Original Data Queue Server QIBM_QLZP_LICENSE LICM0100 *YES Original License Mgmt Server QIBM_QMF_MESSAGE MESS0100 *YES Original Message Server QIBM_QNPS_ENTRY ENTR0100 *YES Network Print Server - entry QIBM_QNPS_SPLF SPLF0100 *YES Network Print Server - spool QIBM_QOE_OV_USR_ADM UADM0100 *YES OfficeVision/400 Administrati QIBM_QOK_SUPPLIER SUPL0100 *YES System Directory Supplier Exi QIBM_QOK_VERIFY VRFY0100 *YES System Directory Verify Exit 8 QIBM_QPWFS_FILE_SERV PWFS0100 *YES File Server QIBM_QRQ_SQL RSQL0100 *YES Original Remote SQL Server A suivre... Command ===> F3=Exit F4=Prompt F9=Retrieve F12=Cancel
Work with Exit Programs Exit point: QIBM_QPWFS_FILE_SERV Format: PWFS0100 Type options, press Enter. 1=Add 4=Remove 5=Display 10=Replace Exit Program Exit Opt Number Program Library 1 (No exit programs found.) #################################################################### # # # Sur cet écran 1 = ADDEXITPGM : ajout d'un pgm d'exit # # 4 = RMVEXITPGM : retrait d'un pgm d'exit # # # #################################################################### Fin Command ===> F3=Exit F4=Prompt F5=Refresh F9=Retrieve F12=Cancel
Quelques précisions :
un point d'exit peut avoir plusieurs "formats".
il s'agit de la définition de plusieurs actions pouvant être réalisées
par la même fonction.
exemple du point d'exit QIBM_QZDA_NDB1 serveur de données (ODBC) :
format ZDAD0100 = gestion de la base (CREATE, DROP, etc...)
ZDAD0200 = Gestion de la liste de bibliothèques (ADDLIBLE)
chaque format définit la structure des données envoyées au pgm.
pour connaitre le détail d'un format voir la documentation
SC41-374 : "OS/400 server concept and administration "
Ci-dessous, les plus importants :
QIBM_QPWSF_FIle_Serveur : serveur de fichier V3R10 Format PWFS0100 : - CHAR(10) Profil utilisateur - CHAR(10) fonction = '*FILESRV' - BIN(4) Action : 1 = modif des attributs 2 = création (STMF ou directory) 3 = supression ( " " ) 4 = liste des attributs 5 = MOV 6 = OPEN 7 = RNM 8 = Allocate d'une conversation - CHAR(8) format = 'PWFS0100' - CHAR(4) type d'ouverture (1=oui, 0=non) - CHAR(1) Read - CHAR(1) write - CHAR(1) Read/write - CHAR(1) delete possible
- BIN(4) lg du nom de fichier
- CHAR(??) nom du fichier
y compris le chemin, lg maxi 16Mo.
ATTENTION : le nom du fichier est donné en UNICODE.
Il s'agit d'une norme de codification ISO (basée sur l'ASCII) qui tient
compte des paramètres nationaux :
- codée sur deux octets pour les idéogrammes asiatiques (DBCS)
en france le premier octet vaut TOUJOURS x'00'
- tenant compte du code page et des caractères accentués (comme l'ANSI)
Voir l'exemple ci-dessous qui propose une conversion EBCDIC/UNICODE pour
les chiffres et les caractères sans accents (partie invariante du LATIN 1)
PGM PARM(&VALID &PARAM) DCL VAR(&VALID) TYPE(*CHAR) LEN(1) DCL VAR(&PARAM) TYPE(*CHAR) LEN(512) DCL VAR(&LGPATH) TYPE(*DEC) LEN(9 0) DCL VAR(&UNICODE) TYPE(*CHAR) LEN(128) DCL VAR(&PATH) TYPE(*CHAR) LEN(64) /*********************************************************************/ /*QIBM_QPWSF_FIle_Serveur : serveur de fichier V3R10 */ /* */ /*Format PWFS0100 : - CHAR(10) Profil utilisateur */ /* - CHAR(10) fonction = '*FILESRV' */ /* - BIN(4) Action : 1 = modif des attributs */ /* 2 = création (STMF ou director*/ /* 3 = supression ( " " */ /* 4 = liste des attributs */ /* 5 = MOV */ /* 6 = OPEN */ /* 7 = RNM */ /* 8 = Allocate d'une conversatio*/ /* */
/* - CHAR(8) format = 'PWFS0100' */ /* - CHAR(4) type d'ouverture (1=oui, 0=non) */ /* - CHAR(1) Read */ /* - CHAR(1) write */ /* - CHAR(1) Read/write */ /* - CHAR(1) delete possible */ /* 37 A 40 - BIN(4) lg du nom de fichier */ /* 41 A -- - CHAR(??) nom du fichier */ /* */ /*********************************************************************/ /* EXTRACTION DES PARAMETRES */ CHGVAR VAR(&LGPATH) VALUE(%BIN(&PARAM 37 4)) IF COND(&LGPATH > 128) THEN(CHGVAR VAR(&LGPATH) + VALUE(128)) CHGVAR VAR(&UNICODE) VALUE(%SST(&PARAM 41 &LGPATH)) /* CVT UNICODE -> EBCDIC */ CALL UNICODE PARM(&UNICODE 128 &PATH) /* REFUS SI CHEMIN COMMENCE PAR QSYS.LIB */ IF (%SST(&PATH 1 9) = '/QSYS.LIB') CHGVAR &VALID '0' /* SINON OK */ ELSE CHGVAR &VALID '1' ENDPGM
puis le PRG associé : *********************************************************************** ** ** ** Ce pgm convertit des données UNICODE en EBCDIC. ** ** ** ** le premier paramètre contient la chaîne de caractères en UNICODE ** ** - chaque caractère est codé sur 2 octets (pour DBCS) ** ** 1er octet x'00' ** ** 2ème octet le caractère en ASCII ** ** - le deuxième paramètre donne la longueur du premier ** ** - le troisième paramètre est la variable qui contiendra ** ** le code EBCDIC (elle doit être de 2 fois plus petite) ** ** ** ** ATTENTION ** ** ** ** ce programme ne tient pas compte des paramètres nationaux ** ** (caractères accentués), il n'est donc fiables que pour ** ** la partie invariante des codes page ** ***********************************************************************
Dinput s 2048
Doutput s 1024
Dunids ds
Dunicod 2048
Dunitab 1 dim(2048) overlay(unicod)
Debcds ds
Debcdic 1024
Debctab 1 dim(1024) overlay(ebcdic)
Dinl s 15 5
Dinl2 s 5 0
Doutl s 5 0
Di s 5 0
Dqebcdic s 10 inz('QEBCDIC')
Dqebcdiclib s 10 inz('*LIBL')
C *entry plist
C parm input
C parm inl
C parm output
* la lg d'output doit être inl / 2
c eval inl2 = inl
C eval unicod = %subst(input:1:inl2)
c eval outl = inl2 / 2
* ignorer tous les octets impaires (1,3,5,...)
c do inl2 z 4 0
c z div 2 result 4 0
c mvr reste 1 0
c if reste = 0
c eval i = i + 1
c eval ebctab(i) = unitab(z)
c endif
c enddo
* cvt ascii / ebcdic
c call 'QDCXLATE'
C PARM outl
C PARM ebcdic
C PARM qebcdic
C PARM qebcdiclib
c eval %subst(output:1:outl) = ebcdic
c eval *inlr = *on
QIBM_QTF_Transfert : Transfert de fichiers
Format TRAN0100 : - CHAR(10) Profil utilisateur
- CHAR(10) fonction = '*TFRCTL'
- CHAR(10) action 'SELECT'
'JOIN'
'REPLACE'
'EXTRACT'
- CHAR(10) fichier
- CHAR(10) bibliothèque
- CHAR(10) membre
- CHAR(8) format = 'TRAN0100'
- BIN(4) lg zone suivante
- CHAR(??) requête.
QIBM_QZDA_INIT : lancement de la fonction serveur de données (ODBC) Format ZDAI0100 - CHAR(10) Profil utilisateur - CHAR(10) fonction = '*SQL' - CHAR(8) format = 'ZDAI0100' - BIN(4) toujours à 0 QIBM_QZDA_NDB1 : fonction serveur de données (ODBC): Format ZDAD0100 : (gestion de la base de données) - CHAR(10) Profil utilisateur - CHAR(10) fonction = '*NDB' - CHAR(8) format = 'ZDAD0100' - BIN(4) action
actions possibles : 6144 CRTSRCPF
6145 Création d'un fichier (basé sur
un fichier modèle)
6146 Ajout de membre
6147 Mise à blanc d'un membre
6148 Supression d'un membre
6149 OVRDBF
6150 DLTOVR
6153 DLTF
- CHAR(128) Nom du fichier(support des noms longs SQL)
- CHAR(10) Bibliothèque
- CHAR(10) Membre
- CHAR(10) Autorisations (si création)
- CHAR(128) Nom du fichier sur modèle (création)
- CHAR(10) Bibliothèque
- CHAR(10) Nom du fichier de substitution
- CHAR(10) Bibliothèque de subsitution
- CHAR(10) membre de substitution
Format ZDAD0200 : (gestion de la liste de bibliothèques)
- CHAR(10) Profil utilisateur
- CHAR(10) fonction = '*NDB'
- CHAR(8) format = 'ZDAD0200'
- BIN(4) action : 6156 = ADDLIBLE
- BIN(4) nombre de bibliothèques ajoutées
- CHAR(??) liste des bibliothèques ajoutées.
QIBM_QZDA_SQL1 : fonction serveur de données (ODBC): Format ZDAQ0100 : (Requêtes SQL via ODBC) - CHAR(10) Profil utilisateur - CHAR(10) fonction = '*SQLSRV' - CHAR(8) format = 'ZDAQ0100' - BIN(4) action actions possibles : code| instruction SQL 6147 prepare & describe 6148 open 6149 execute 6150 execute immediate 6153 connect (DRDA) 6157 prepare & execute ou prepare & open 6158 open & fetch A suivre ...
6159 create package
6160 clear package
6161 delete package
6162 execute & open
6166 prepare
6158 open & fetch
- CHAR(18) Nom de l'instruction
- CHAR(18) Nom du curseur
- CHAR(2) options pour PREPARE
- CHAR(2) options pour OPEN
- CHAR(10) Nom du SQL Package
- CHAR(10) Bibliothèque du SQL Package
- BIN(2) DRDA 0 = base locale
1 = remote database
- CHAR(1) Type de validation et verrouillage
A = *ALL
C = *CHANGE
N = *NONE
S = *CS
- CHAR(512) 512 premiers caractères de la requête.
QIBM_QZRC_RNT : Remote commande et procédures cataloguées.
Format CZRC0100 :
- CHAR(10) Profil utilisateur
- CHAR(10) fonction = '*RMTSRV'
- CHAR(8) format = 'CZRC0100'
- BIN(4) action : 1002 remote commande
1003 remote procedure call
pour action 1002 (remote commande) - CHAR(10) réservé. - BIN(4) lg de la commande - CHAR(??) la commande pour action 1003 (remote procedure call) - CHAR(10) programme - CHAR(10) bibliothèque - BIN(4) nombre de paramètre - CHAR(??) paramètres /x fois le découpage suivant: . BIN(4) lg de la zone . BIN(4) lg maxi . BIN(2) 1=input,2=output,3=I/O . CHAR(??) paramètre
PGM PARM(&VALID &PARAM)
DCL VAR(&VALID) TYPE(*CHAR) LEN(1)
DCL VAR(&PARAM) TYPE(*CHAR) LEN(2028)
DCL VAR(&message) TYPE(*CHAR) LEN(512)
/*********************************************************************/
/*QIBM_QZDA_... : serveur de BASE DE DONNéES (TFR ET ODBC) */
/* */
/* */
/*********************************************************************/
CALLPRC PRC(FILSRVS2) PARM(&PARAM &message)
if (&message = ' ') then(chgvar &message ¶m)
SNDMSG MSG(&MESSAGE) TOUSR(*SYSOPR)
/* REFUS */
/* CHGVAR &VALID '0' */
/* SINON OK */
CHGVAR &VALID '1'
ENDPGM
* =============== copier le source de QSYSINC ======================
/copy qsysinc.qrpglesrc,EZDAEP
*===================================================================
... / ...
* =============== fin de copie======================================
Dparam DS
D profil 10
D serverID 10
D format 8
D filler 2000
dtblaction s 9B 0 dim(8)
d ctdata perrcd(1)
dtblcde s 10 dim(8)
d ctdata perrcd(1)
D i s 2 0
C *entry plist
C parm param
C parm msg 512
c select
* connection
c when format = 'ZDAI0100'
c eval ezdqif = param
c exsr connectSR
* gestion des fichiers
c when format = 'ZDAD0100'
c eval ezdndbf1 = param
c exsr wrkbaseSR
* gestion de *libl
c when format = 'ZDAD0200'
c eval ezdndbf2 = param
c exsr addliblSR
* extraction d'informations/fichier c when format = 'ZDAR0100' c eval ezdroif1 = param c exsr dspffdSR * extraction d'informations(clé primaire) c when format = 'ZDAR0200' c eval ezdroif2 = param c exsr pfcstSR * requete SQL (<= 512 octets) c when format = 'ZDAQ0100' c eval ezdqsqlf = param c exsr sql1SR * requete SQL (> 512 octets) c when format = 'ZDAQ0200' c eval ezdsqlf2 = param c exsr sql2SR c endsl c return
*+++
*+++ sous/pgms
*+++
c connectSR begsr
c eval msg = profil + ' se connecte'
c endsr
c wrkbaseSR begsr
c eval i = 1
c EZDFID00 lookup tblaction(i) 50
c eval msg = profil + ' lance la commande ' +
c tblcde(i)
c endsr
c addliblSR begsr
c eval msg = profil + ' ajoute ' +
c EZDLN00(1) + ' à *libl'
c endsr
c dspffdSR begsr c eval msg = profil + ' extrait des infos sur ' c + EZDFILN00 c endsr c pfcstSR begsr c eval msg = profil + ' demande la clé de ' c + EZDPKN c endsr c sql1SR begsr c eval msg = profil + ' exécute la requête ' c + EZDSQLST c endsr c sql2SR begsr c eval msg = profil + ' exécute la requête ' c + EZDSQLST00 c endsr
** tblaction
000006144
000006145
000006146
000006147
000006148
000006149
000006150
000006153
** tblcde
CRTSRCPF
CRTPF
ADDPFM
CLRPFM
RMVM
OVRDBF
DLTOVR
DLTF
En V4R2 : il y a de nombreux nouveaux points d'exit basés sur TCP/IP
remarquons QIBM_QTG_DEVINIT démarrage d'une session Telnet
QIBM_QTG_DEVTERM clôture d'une session Telnet
QIBM_QTG_DEVINIT
paramètres recus :
1/ User -> c'est un structure indiquant les
caractèristiques d'une ouverture avec
saut de signon
+ Binaire (4) lg de la structure
+ CHAR(10) profil à utiliser
+ CHAR(10) curlib [val. *USRPRF admise]
+ CHAR(10) pgm [val. *USRPRF admise]
+ CHAR(10) menu [val. *USRPRF admise]
2/ Device -> c'est un structure indiquant les
caractèristiques de l'unité à utiliser
+ CHAR(10) nom de l'unité
+ CHAR(8) format
DSPD0100 = Ecran (seul en V4R2)
+ CHAR(2) réservé
+ BIN(4) OFFSET pour dspd0100 = 29
+ BIN(4) lg de dspd0100 = 12
+ CHAR(16) structure DSPD0100 contenant
° CHAR(3) clavier = FAB en france
° CHAR(1) réservé
° BIN(4) code page = 297
° BIN(4) jeux de car. = 697
3/ infos de connexion (structure) + BIN(4) lg de la structure à suivre + sous-structure contenant l'adresse IP ° CHAR(1) taille de l'adresse en binaire ° CHAR(1) type d'adresse x'02' = IP x'06' = IPX ° BIN(2) n° de port ° CHAR(16) adresse IP constituée de 4 fois 4 octets binaires. + le mot de passe est-il validé ? - 0 = non - 1 = oui (transmis en clair) - 2 = oui (transmis crypté)
4/ environnement
selon la RFC1572 il est possible de fixer des
variables d'environnement pour TELNET
(particulièrement dans le monde Unix)
cette zone contient en clair les variables
d'environnement et leur contenu.
5/ lg de la zone environnement
6/ connexion
0 = rejeté
1 = autorisée
7/ saut du signon
0 = rejeté
1 = autorisée
QIBM_QTG_DEVTERM clôture d'une session TELNET
paramètres recus :
1/ CHAR(10) nom de l'unité
Voici un exemple de programme associé à l'initialisation d'une session
TELNET.
Il s'agit ici de refuser toute station dont l'adresse IP ne commence
PAS par 10.3.*
et d'attribuer des noms significatifs à certains postes (NS en autre)
(JUIN 98, cela ne marche pas en VT/100 ???)
Dbinaire S 10I 0
Dnomvalide S 10
Duser ds
D userlg like(binaire)
D profil like(nomvalide)
D curlib like(nomvalide)
D menu like(nomvalide)
Ddevice ds
D unite like(nomvalide)
D format 8
D filler 2
D offset like(binaire)
D dspd0100lg like(binaire)
d dspd0100 12
d clavier 3 overlay(dspd0100)
d codepage overlay(dspd0100:5) like(binaire)
d charset overlay(dspd0100:9) like(binaire)
Dconnection ds
D connectlg like(binaire)
D adresseclient 20
D adrtaille 1 overlay(adresseclient)
D adrtype 1 overlay(adresseclient:2)
D adrport 2 overlay(adresseclient:3)
D adresse 16 overlay(adresseclient:5)
D ip12 5I 0 overlay(adresse)
D ip34 5I 0 overlay(adresse:3)
D password 1
D adresseip c x'02'
D adresseipx c x'06'
D pas_de_pwd c 0
D pwd_en_clair c 1
D pwd_crypte c 2
Denv S 32
Denvlg S like(binaire)
Dconnect S 1
D connect_refus c '0'
D connect_ok c '1'
Dsaut_signon S 1
D saut_refus c '0'
D saut_ok c '1'
Dmessage s 1024
Dmessagelg s inz(%size(message)) like(binaire)
Dmessagetype s 10 inz('*INFO')
Dmessageq s 20 inz('PCAF4 *LIBL')
Dmessageqnb s inz(1) like(binaire)
DCODERR DS
D LGCOD like(binaire) INZ(16)
D LGUTIL like(binaire)
D MSGID 7
D RESERV 1
Dadrchar ds
D dec1 3 0
D dec2 3 0
D dec3 3 0 D dec4 3 0 C *entry plist C parm user C parm device C parm connection C parm env C parm envlg C parm connect C parm saut_signon c ip12 div 256 dec1 c mvr dec2 c ip34 div 256 dec3 c mvr dec4 c if dec1 <> 10 or dec2 <> 3 c eval connect = connect_refus
c else
c eval connect = connect_ok
c eval saut_signon = saut_refus
c eval format = 'DSPD0100'
c eval offset = 29
c eval dspd0100lg = 12
c eval clavier = 'FAB'
c eval codepage = 297
c eval charset = 697
c if dec3 = 1 and dec4 = 5
c eval unite = 'VTNT'
c endif
c if dec3 = 1 and dec4 = 9
c eval unite = 'VTLINUX'
c endif
c if dec3 = 2 and dec4 = 1
c eval unite = 'DSPNS'
c endif
c endif
c* c* envoi d'un message (voir plus haut) lors de la mise au point . c* c* eval message = user + '/' + device + '/' + c* connection + '/' + adrchar c* call 'QMHSNDBM' c* parm message c* parm messagelg c* parm messagetype c* parm messageq c* parm messageqnb c* parm messageq c* parm coderr c eval *inlr = *on début