| 
***************************************************************** * * * CE PROGRAMME CONVERTI UN SOURCE EN HTML * * * ***************************************************************** h datedit(*YMD) F* F* Déclaration des fichiers F* FQtxtsrc IF F 112 DISK F INFDS(DSFIC) FSORTIE O F 1024 DISK D DSFIC DS D MEMBRE 129 138 D NOMBRE 156 159 0 d car s 1 dim(80) ctdata perrcd(80) d carspc s 8 dim(80) ctdata perrcd(1) d i s 3 0 d numligne s 2 0 d htmldata s 1012 d origine DS d tbo 1 dim(100) d o s 3 0 d o2 s like(o) d saveo s like(o) d remplace DS d tbr 1 dim(1000) d r s 4 0 d gras s n d souligne s n IQtxtSRC NS 01 I 1 6 0SRCSEQ I 7 12 0SRCDAT I 13 112 SRCDTA C* 001C *ENTRY PLIST |
|
C PARM FONP 8 C PARM DEBP 8 C PARM FINP 8 C PARM texte 50 C PARM chemin 80 C* C* Création de l'entête C* Début HTML C eval htmldata = '<HTML>' C Z-ADD 1 noseq 6 0 C Z-ADD UDATE date 6 0 C EXCEPT ligne C* Titre C eval htmldata = '<TITLE> ' + c %trim(MEMBRE) + c ' </TITLE>' C ADD 1 noseq C EXCEPT ligne C* Début Corps c IF FONP = *blanks c eval htmldata = '<BODY BGCOLOR="#FFFFCC">' c else C eval htmldata = '<BODY BGCOLOR="#FFFFCC" ' + c 'BACKGROUND = "' + c %trim(FONP) + '.GIF >' c endif C ADD 1 noseq C EXCEPT ligne C* Commentaire ligne début c eval htmldata = '<!-- CVTMBRHTM 2.0 ' + c %trim(MEMBRE) + '-->' C ADD 1 noseq C EXCEPT ligne C* Ligne TITRE DU DOCUMENT c eval htmldata = '<CENTER> <H1> ' + c %trim(MEMBRE) + c '</H1> </CENTER> <BR>' C ADD 1 noseq C EXCEPT ligne C* Ligne TITRE DU DOCUMENT (suite avec le texte du membre) c eval htmldata = '<CENTER> <H2> ' + c %trim(TEXTE) + c '</H2> </CENTER> <BR>' |
|
C ADD 1 noseq C EXCEPT ligne C* Tag de début c eval htmldata = '<A NAME = "DEB"> <BR>' C ADD 1 noseq C EXCEPT ligne C* Ligne de séparation c eval htmldata = ' <HR> ' C ADD 1 noseq C EXCEPT ligne C* BOUTON FIN c eval htmldata = '<A HREF = "#FIN"> ' c if finp <> ' ' c eval htmldata = %trim(htmldata) + c '<IMG SRC=' + FINp +'.GIF"' c + 'ALT = "BoTTom"> </A> <BR>' c else c eval htmldata = %trim(htmldata) + c 'Fin </A> <BR>' c endif C ADD 1 noseq C EXCEPT ligne C* C* Boucle de lecture du fichier C* 001C DOU %eof DEB001 001C READ Qtxtsrc * 002C if %eof DEB002 c leave c endif C* af400 c if %subst(srcdta : 1 : 2) <> '//' c c exsr convert c* c if remplace = ' ' c eval htmldata = '<BR>' c else c eval htmldata = %trim(remplace) c endif c eval numligne = numligne + 1 c if numligne = 1 |
|
c eval htmldata = '<PRE>' + %trim(htmldata) c endif c if numligne = 22 c eval htmldata = %trim(htmldata) + '</PRE>' c endif C ADD 1 noseq C EXCEPT ligne c if numligne = 22 c exsr lignesup c eval numligne = 0 c endif c endif C* C* 001C ENDDO FIN001 C* Tag de fin c eval htmldata = '<A NAME = "FIN"> <BR>' C ADD 1 noseq C EXCEPT ligne C* BOUTON DEBUT c eval htmldata = '<A HREF = "#DEB"> ' c if debp <> ' ' c eval htmldata = %trim(htmldata) + c '<IMG SRC=' + DEBp +'.GIF"' c + 'ALT = "Top"> </A> <BR>' c else c eval htmldata = %trim(htmldata) + c 'Début </A> <BR>' c endif C ADD 1 noseq C EXCEPT ligne c exsr lignesup c eval htmldata = '<H3> CVTMBRHTML 2.0 </H3> + c un des outils de <H3> AF400 + c </H3>' C ADD 1 noseq C EXCEPT ligne C* C* fin du HTML C MOVEL(P) '</BODY>' htmldata C ADD 1 noseq |
|
C EXCEPT ligne C* C MOVEL(P) '</HTML>' htmldata C ADD 1 noseq C EXCEPT ligne C* C* FIN DE PROGRAMME C* 000C eval *inlr = *on c convert begsr c eval origine = srcdta c eval remplace = *blanks c eval r = 1 c do 100 o c select * * reste de la ligne à blanc * c when tbo(o) = ' ' c if %subst(origine : o : 100 - o + 1) c = *blanks c leave c else * * un blanc significatif * c movea ' ' tbr(r) c eval r = r + 6 c endif c other * * car <> de blanc * c eval i = 1 * * car spécial ? (é,è,â,...) * c tbo(o) lookup car(i) 50 * * oui => remplacé par é &eagrave; â etc... (voir tableau) |
|
* c if *in50 c movea carspc(i) tbr(r) c eval r = r + %len(%trimr(carspc(i))) c movea *blank tbr(r) c else * * non => recherche d'un attribut (HI, UL) * C if tbo(o) < ' ' and tbo(o) >= x'20' C TESTB '7' tbo(o) 27 RI C TESTB '6' tbo(o) 26 HI C TESTB '5' tbo(o) 25 UL * * un attribut est-il déja utilisé, si oui celui-ci vaut fin du * précédent==> il faut gérer fin de gras, fin de soulignement * c if gras c movea '</B>' tbr(r) c eval r = r + 4 c eval gras = *off c endif c if souligne c movea '</U>' tbr(r) c eval r = r + 4 c eval souligne = *off c endif * * gestion de l'attribut trouvé * c if *in27 or *in26 c movea '<B> ' tbr(r) c eval r = r + 9 c eval gras = *on c exsr barre c endif c if *in25 c movea '<U> ' tbr(r) c eval r = r + 9 c eval souligne = *on c endif * cararctère non affichable (et pas un attribut) ==> remplacé par ' ' |
|
c if not *in25 and not *in26 and not *in27
c movea ' ' tbr(r)
c eval r = r + 6
c endif
c
C else
*
*caractère spécial ('x'41) pour simuler une fenêtre avec des '#'
* (c'est la routine barre qui a placé ces x'41' si il n' y a que des
* blancs entre HI et x'20, pour traitement maintenant)
*
c if tbo(o) = x'41'
c movea '#' tbr(r)
c eval r = r + 6
c else
*
*caractère normal ==> placé tel que !
*
c eval tbr(r) = tbo(o)
c eval r = r + 1
c endif
c endif
c endif
c endsl
c enddo
c endsr
c lignesup begsr
C* Ligne de séparation
C MOVEL(P) '<HR>' htmldata
C ADD 1 noseq
C EXCEPT ligne
c endsr
c barre begsr
C* recherche si suite de blanc en inverse video
c eval saveo = o + 1
c dow saveo < 100
c if tbo(saveo) > x'19' and tbo(saveo) < ' '
c eval o2 = saveo - o - 1
c if %subst(origine : o + 1 : o2) = *blanks
c eval %subst(origine : o + 1 : o2) = *ALLX'41'
c endif
c leave
|
|
c endif c eval saveo = saveo + 1 c enddo c endsr OSORTIE E ligne O noseq 06 O date 12 O htmldata 1024 ** "&<>£|àâäçèéêëîïñôöùûüÀÂÄÉÈÊËÎÏÔÖÙÛÜ ** " & < > £ | à â ä ç è é ê ë î ï ñ ô ö ù û ü À Â Ä É È Ê Ë |
|
Î Ï Ô Ö Ù Û Ü |
