* * SIGNATUR : écriture dans le fichier SIGNP1 des signatures(e-mail) * * Ce pgm est appellé après SIGNATURCL qui passe la cde ADDLIBLE * -------------------------------------------------------------- * * ps: LINKER CE PGM AVEC QTMHCGI *SRVPGM * FSIGNPF1 O E DISK **************************************************************** * Fonction C2N transforme le CHAR en numérique (donnée par la doc IBM) Dc2n PR 30p 9 Dc 32 options(*varsize) * buffers pour écriture (SORTIE) et lecture (RECUE) ************ DSORTIE S 240 DSORTIELG S 10I 0 INZ(%LEN(SORTIE)) DRECUE S 1024 DRECUELG S 10I 0 INZ(%LEN(RECUE)) DVALEURLG S 10I 0 * variables d'env. Denv S 1024 Denvlg S 10I 0 INZ(%size(env)) DenvvalLG S 10I 0 Denvname S 1024 Denvnamelg S 10I 0 Ddebut S 10I 0 Dfin S 10I 0 * Structure pour gestion des erreurs (API) DAPIERR DS D ERRLG 10I 0 INZ(%len(apierr)) D ERRLGDISPO 10I 0 D ERRID 7 D ERRRESERVE 1 D ERRMSG 50 **** API (programme de service QTMHCGI) * API POUR recevoir la saisie (lecture) DQREAD PR EXTPROC('QtmhRdStin') D wRECUE like(recue) D wRECUELG like(recuelg) D wVALEURLG like(valeurlg) D wAPIERR like(apierr) * API POUR générer la sortie (écriture) DQWRITE PR EXTPROC('QtmhWrStout') D wSORTIE like(sortie) D wSORTIELG like(sortielg) D wAPIERR like(apierr) * API POUR lire une variable d'env. Dgetenv PR EXTPROC('QtmhGetEnv') D wenv like(env) D wenvlg like(envlg) D wenvvallg like(envvallg) D wenvname like(envname) D wenvnamelg like(envnamelg) D wAPIERR like(apierr) * CONSTANTES DEOL C X'15' DPROBLEME C 'location: http:/html/cgi/+ D erreur.html' DPROBLEM2 C 'location: http:/html/cgi/+ D mailfr.html' Dentete C 'Content-type: text/html' dACCORD1 C '
+ d CGI : Signature enregistré:e + d
+ d

Merci

+ d Merci ' DACCORD2 C ' ,et a bientot !
+ d ' DXZERO s 5i 0 * récupération de la lg des données recues par une variable d'env. c eval envname = 'CONTENT_LENGTH' c eval envnamelg = %len(%trim(envname)) C CALLP getenv(env : envlg : envvallg : C envname : envnamelg : APIERR) * transformation en numérique c EVAL XZERO = %scan(x'00':env) C if XZERO > 0 c eval env = %replace(' ':env:Xzero:1) C endif c eval recuelg = c2n(env) c if recuelg > %size(recue) c eval recuelg = %size(recue) c endif * lecture des données C CALLP QREAD(RECUE : RECUELG : VALEURLG : C APIERR) * découpage du buffer c exsr decoup C IF NOM = ' ' OR EMAIL = ' ' * ici on répond par une référence à une page statique (location:) C EVAL SORTIE = PROBLEME + EOL + EOL C ELSE * vérification de l'email en .fr, car sinon, des données sont injectées par des hackers * qui ne lisent pas le Français, donc les messages d'erreur C IF %subst(%trimr(email):%len(%trimr(email))-1:2) C <> 'fr' and C %subst(%trimr(email):%len(%trimr(email))-1:2) C <> 'FR' C EVAL SORTIE = PROBLEM2 + EOL + EOL C ELSE * ici on répond par un contenu (content-type: text/html). C EVAL SORTIE = entete + EOL + EOL + C ACCORD1 + PRENOM + C ACCORD2 + EOL c time timestp C WRITE SIGNF1 C ENDIF C ENDIF C * génération de la réponse C CALLP QWRITE(SORTIE : SORTIELG : C APIERR) C EVAL *INLR = *ON * * les données recues sont structurées de la manière suivante : * nom1-dansleformulaire=valeur&nom2=valeur2&nom3=valeur3z * ^ * z= x'00'----! en V4R20 C decoup begsr * recherche de la zone NOM C eval debut = %scan('NOM=' : recue : 1) C if debut = 0 C eval nom = *blanks C else C eval debut = debut + 4 C eval fin = %scan('&' : recue : debut) C if fin > debut c eval nom = %subst(recue: debut : c fin - debut ) C endif C endif * zone PRENOM C eval debut = %scan('PRENOM=' : recue : fin) C if debut = 0 C eval prenom = *blanks C else C eval debut = debut + 7 C eval fin = %scan('&' : recue : debut) C if fin > debut c eval prenom = %subst(recue: debut: c fin - debut ) C endif C endif * zone EMAIL (dernier champ) * C eval debut = %scan('EMAIL=' : recue : fin) C if debut = 0 C eval EMAIl = *blanks C else C eval debut = debut + 6 c eval fin = 0 C eval fin = %scan(x'00' : recue : debut) * il n'y a plus de x'00' en V4R30 ==> recherche d'un espace c if fin = 0 C eval fin = %scan(' ' : recue : debut) c endif C if fin > debut c eval email = %subst(recue: debut : c fin - debut ) C endif C endif * * vous pouvez aussi utiliser l'API (c'est + simple) QtmhCvtDb * * mais il faut que les zones du formulaire portent le même nom * que les champs base de données. * ** déclaration *============== * API POUR découper dans une DS externe *Dcvtdb PR EXTPROC('QtmhCvtDb') *D wficlib 20 const *D wbuffer like(recue) *D wbufferlg like(recuelg) *D wenreg like(enregDB) *D wenreglg like(enreglg) *D wretourlg like(retourlg) *D wcode like(retourcode) *D wAPIERR like(apierr) * * et utilisation *C CALLP cvtdb('SIGNF1 *LIBL' : recue : *C recuelg : enregDB : enreglg : retourlg *C : retourcode : APIERR) C endsr ******************************************************** * Function: Convert a character to numeric value. * ******************************************************** * nomain c2n subprocedure Pc2n B export Dc2n PI 30p 9 Dc 32 options(*varsize) * variables Dn s 30p 9 Dwknum s 30p 0 Dsign s 1 0 inz(1) Ddecpos s 3 0 inz(0) Dindecimal s 1 inz('0') Di s 3 0 Dj s 3 0 D ds Dalpha1 1 Dnumber1 1 0 overlay(alpha1) inz(0) C eval c = %triml(c) C ' ' checkr c j C 1 do j i C eval alpha1=%subst(c:i:1) C select C when alpha1='-' C eval sign= -1 C when alpha1='.' C eval indecimal='1' C when alpha1 >='0' and alpha1 <= '9' C eval wknum = wknum * 10 + number1 C if indecimal = '1' C eval decpos = decpos + 1 C endif C endsl C enddo c eval n = wknum * sign / 10 ** decpos c return n Pc2n e