| 
*
* 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 '<HTML> <HEADER> <TITLE> +
d CGI : Signature enregistré:e +
d </TITLE></HEADER> +
d <BODY> <H1>Merci</H1> +
d Merci <B> '
DACCORD2 C '</B> ,et a bientot !</BODY><HR>+
d </HTML>'
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
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 |
