⇧
initProcess - 22/05/2026 12:19:29
Capable de process préemptif
var $data : Object
ErrorNum:=0
ON ERR CALL(Formula(traceHandler).source) // gestion des erreurs
If (Current process name#"Process Web@")
Use (Storage.Processes)
Storage.Processes[Current process name]:=New shared object("Commande"; "")
End use
$data:=Storage.Processes[Current process name]
Use ($data)
$data.Status:=New shared object
// données du process courant (partageables)
$data.Data:=New shared object
// infos du process que le process courant a lancé
$data.ProcInProgress:=New shared object
$data.ProcInProgress.numProcess:=0
$data.ProcInProgress.nomProcess:=""
$data.ProcInProgress.Status:=New shared object
End use
End if
⇧
Lire_MarkersData - 30/01/2026 11:38:55
Disponible via les balises HTML et les URLs 4D (4DACTION...)
Capable de process préemptif
#DECLARE()->$result : Text
var $params : Object:=New object
var $dataTexte : Text
cs.xCarto.$carte.new().getCarteDataApp($params)
$dataTexte:=$params.MarkersData
BASE64 DECODE($dataTexte; $result)
$result:=Char(1)+$result
⇧
Traiter Action APP - 02/03/2025 11:01:59
Partagée entre composants et base hôte
Disponible via les balises HTML et les URLs 4D (4DACTION...)
Capable de process préemptif
#DECLARE($url : Text)->$result : Boolean
// Gestion des requetes 4DHTTP ou 4DCGI taguée /APP/ (application fusionnée)
// codes d'erreur : voir RFC 2616
var $data : Object
var $réception : Blob
ASSERT(cs._Trace.me.DebugerMethode($url; Current method name; "Commande : "+$url)) //; "Options"; 0x0002
$result:=True // commande acceptée par défaut
// attention : si les actions se font sans cookie => les commandes ont toujours en DERNIER paramètre "initSession"
Case of
// commencer par les URL 4DHTTP : elles gèrent les données de la session web APP
// rappel : ici, les URL en /4DHTTP/@ sont authentifiées, mais pas les URL /4DCGI/@
// test du serveur
: ($url="/4DHTTP/APP/WebServerState@")
// renvoyer les infos du serveur; rappel on peut recevoir des paramètres
OB SET($data; "EstActif"; True)
VARIABLE TO BLOB($data; $réception)
WEB SEND RAW DATA($réception)
Else
$result:=False // passer la main
End case
⇧
Bac à sable WEB - 06/06/2026 17:30:56
Partagée entre composants et base hôte
var $o; $oo; $sélectionEntités; $DataStore; $params : Object
var $x; $y : Text
var $commande; $numproc; $i; $j : Integer
var $bool : Boolean
var $c; $cc : Collection
var $blob : Blob
var $heure : Time
var $ptr : Pointer
Case of
: (Count parameters=0)
//APPELER WORKER("WK_Services";"initProcessWorker")
//$bool:=Lire activation assertions
// $x:=""
// UserIDentification ("EnregistrerIdentifiants";->$x)
$numproc:=New process(Current method name; 0; "tester"; Current process)
Else
initProcess
$o:=New object
$oo:=New object
$c:=New collection
ARRAY LONGINT($tabEL; 0)
ARRAY TEXT($Elements; 0)
$c:=New collection()
$commande:=0
For each ($i; $c)
$commande:=$commande ?+ $i
End for each
Case of
: ($commande ?? 1)
var $composant : Object
$composant:=cs.$composant.new()
$x:="/AinsiLaVie/data/medias/folder_1/"
$o:=$composant.serveur.LireCatalogueDuDossier($x; ->$o)
: ($commande ?? 2)
SET ASSERT ENABLED(True)
WEB SET OPTION(Web inactive process timeout; 1)
WEB SET OPTION(Web inactive session timeout; 1)
TRACE
var $dossierTravail; $data; $entité : Object
$dossierTravail:=Folder(fk documents folder).folder("tempo_ALV").folder("TempoWebMedia")
$dossierTravail.delete(Delete with contents)
$dossierTravail.create()
$data:=New object("dossierTravail"; $dossierTravail)
$entité:=New object("DataClassNom"; "Medias"; "ID"; 1000; "type"; 1; "Credits"; "toto"; "private"; 0)
//Volume de Media($entité; $data) obsolete
$data.IDnomFichier:=String($entité.ID)
$data.entité:=$entité
$data.fichierPath:=$data.dossierTravail.platformPath+String(Random)+".alvtmp"
//$data.cheminFTP:=Documents Serveur("GetHostFolderPath"; "BddMedia"; $entité) obsolète
: ($commande ?? 3)
$data:=New object
$data.functionID:="Créer"
$data.nomTache:="Création site Web"
$data.numProcessAppelant:=-1
$numProc:=Exécuter Function Préemptive(cs.$maintenanceSite; $data)
: ($commande ?? 4)
cs.$maintenance.new().Démarrer()
TRACE
cs.$maintenance.new().Arrêter()
: ($commande ?? 5)
TRACE
cs.$pageWeb.new().TraiterURL("test")
: ($commande ?? 31)
// ouvrir l'éditeur des traductions
cs.xSDK.TraductionsEditeur.new().ModifierTraductions()
End case
End case
⇧
EstDansCollection - 02/03/2025 10:23:18
Disponible via SQL
Capable de process préemptif
#DECLARE($nomCol : Text; $valeur : Integer)->$result : Integer
// test si $2 est dans la collection de nom $1
var $ptr : Pointer
$ptr:=Get pointer($nomCol)
If (Type($ptr->)=Is collection)
$result:=$ptr->indexOf($valeur)
Else
$result:=-1
End if
⇧
Exécuter Function Préemptive - 30/12/2024 14:12:14
Capable de process préemptif
#DECLARE($classe : Object; $params : Object)->$numProc : Integer
var $nomTache : Text
var $data : Object
var $trace : cs._Trace
$trace:=cs._Trace.me
$numProc:=0
Case of
: (Not(OB Is defined($params; "functionID")))
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'functionID' n'est pas défini dans $params")
: (Value type($params.functionID)#Is text)
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'$params.functionID' n'est pas un texte")
: (Not(OB Is defined($params; "nomTache")))
// nécessaire pour tuer la tâche
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'nomTache' n'est pas défini dans $params")
: (Not(OB Is defined($params; "numProcessAppelant")))
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "'numProcessAppelant' n'est pas défini dans $params")
: ($params.numProcessAppelant=-1)
$nomTache:=$params.nomTache
// supprimer un process existant
cs.xSDK.RegistreTaches.new().Tuer($nomTache)
// créer le nouveau process
$params.numProcessAppelant:=Current process
$numProc:=New process(Current method name; 0; "$WEB_process_"+$nomTache; $classe; $params; *)
Else
// c'est ok
initProcess
// construire la classe
$data:=$classe.new()
If ($data[$params.functionID]#Null)
// créer la tâche associée
// numProcessAppelant est nécessaire pour tuer toutes les tâches d'un mêm process
$params.tache:=cs.xSDK.RegistreTaches.new().Inscrire(New object("nomProcess"; Current process name; "nomTache"; $params.nomTache; "numProcessAppelant"; $params.numProcessAppelant))
// lancer le traitement demandé
$data[$params.functionID]($params)
// désinscrire la tâche 'nomTache'
$params.tache.DésInscrire()
Else
$trace.EnvoyerMessages([msgk_event; msgk_log]; "Initialisation :"; Current method name; "La classe "+$classe.name+" n'est pas de function "+$params.functionID)
End if
$numProc:=Current process
End case
⇧
EstDansTableauNumeric - 02/03/2025 10:20:56
Disponible via SQL
Capable de process préemptif
#DECLARE($nomTableau : Text; $valeur : Integer)->$result : Integer
// test si $2 est dans le tableau de nom $1
var $ptr : Pointer
$ptr:=Get pointer($nomTableau)
If (Type($ptr->)=LongInt array)
$result:=Find in array($ptr->; $valeur)
Else
$result:=-1
End if
⇧
traceHandler - 23/12/2024 11:38:27
Capable de process préemptif
cs._Trace.me.Intercepter()
⇧
EcrireElement - 07/09/2025 10:33:55
Partagée entre composants et base hôte
Disponible via les balises HTML et les URLs 4D (4DACTION...)
Capable de process préemptif
#DECLARE($url : Text)->$texte : Text
// traiter toutes les url envoyées par un formulaire en construction
var $serveur : cs.$serveur
var $result : Object
$serveur:=cs.$serveur.new()
$result:=$serveur.TraiterURL($url)
// renvoyer le resultat
$texte:=$result.resultat
⇧
COMPILER_WEB - 02/03/2025 11:15:58
// initialiser les variables process gérés par $composant.InitHTTPvars()
// *** session
var vs4D; wwwBtnSubmit; wwwRacineRessources; wwwEtatNavigation; wwwContexteWeb : Text
vs4D:=""
wwwBtnSubmit:="Valider"
wwwRacineRessources:="../../"
wwwEtatNavigation:=""
wwwContexteWeb:=""
// *** CARTO
var wwwCarto_LatitudeCentre; wwwCarto_LongitudeCentre : Text
wwwCarto_LatitudeCentre:=""
wwwCarto_LongitudeCentre:=""
var wwwCarto_Opacity_OSM : Text
wwwCarto_Opacity_OSM:=""
var wwwCarto_Opacity_GP; wwwCarto_Install_GP : Text
wwwCarto_Opacity_GP:=""
wwwCarto_Install_GP:=""
var wwwCarto_Opacity_Cible; wwwZoneWeb_ZoomMin; wwwZoneWeb_ZoomMax; wwwZoneWeb_Zoom : Text
wwwCarto_Opacity_Cible:=""
wwwZoneWeb_ZoomMin:=""
wwwZoneWeb_ZoomMax:=""
wwwZoneWeb_Zoom:=""
var MarkersData : Text
MarkersData:=""
var ZoneWeb_Largeur; ZoneWeb_Hauteur : Text
ZoneWeb_Largeur:=""
ZoneWeb_Hauteur:=""
// *** AG
var arbreXML : Text
arbreXML:=""
// *** saisie et recherche
var wwwNom; wwwPrenom; wwwSexe : Text
wwwNom:=""
wwwPrenom:=""
wwwSexe:=""
var wwwNaissanceStart; wwwNaissanceStop; wwwNaissanceLieu; wwwDecesStart; wwwDecesStop; wwwDecesLieu : Text
wwwNaissanceStart:=""
wwwNaissanceStop:=""
wwwNaissanceLieu:=""
wwwDecesStart:=""
wwwDecesStop:=""
wwwDecesLieu:=""
var wwwMariageStart; wwwMariageStop; wwwMariageLieu : Text
wwwMariageStart:=""
wwwMariageStop:=""
wwwMariageLieu:=""
// *** recherche
var wwwLieu : Text
wwwLieu:=""
// diaporama HTTP
var wwwMediaPath : Text
var wwwIndexMedia; wwwNbrMedias : Integer
wwwMediaPath:=""
wwwIndexMedia:=0
wwwNbrMedias:=0
var wwwCartoAPIkey : Text
wwwCartoAPIkey:=""
⇧
[class]Sites - 29/05/2025 18:57:03
property laCommune : cs.Communes
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
Super("Sites"; $IDentité)
⇧
[class]$pageWeb - 17/02/2026 18:20:58
property result : Object
property serveur : cs.xSDK.ServicesFTP
property balisesUrl; paramsUrl; Descripteur : Collection
// propriétés des appelants
property RacineXML : Text
Class extends $composant
Class constructor()
Super()
This.result:=This.InitResult()
// serveur FTP
This.serveur:=cs.xSDK.ServicesFTP.new()
//----------------------------------
// MARK:Traitement url
//----------------------------------
Function TraiterURL($url : Text)->$result : Object
// traitement des url internes au serveur (appel des classes $pageXXX par les templates)
// remarque : dans cette version, ces url ont le même format que celles des requêtes client HTTP
This.result.nomMethode:=Current method name
// récupérer les paramètres
This.LireParametresUrl($url)
// normalement .balise[2] est le nom d'une function de $pageXXX
Case of
: (This.balisesUrl.length<3)
This.result.Error:=-15068
This.result.ErrorDescription:="url incorrecte - il manque la paramètres .balise[2]"
: (Not(OB Is defined(This; This.balisesUrl[2])))
This.result.Error:=-15068
This.result.ErrorDescription:="url incorrecte - .balise[2] '"+This.balisesUrl[2]+"' n'est pas une function de this "+OB Class(This).name
Else
// on accepte la demande
// le résultat, s'il y a, est dans this.result.resultat
// exécuter la function, en cas d'erreur elle peut renseigner This.result
This[This.balisesUrl[2]]()
End case
$result:=This.result
Function LireParametresUrl($url : Text)
// $url est de la forme /4Dxxx/yyy/nomFunction {?param1 {+?param2...}}, avec xxx = CGI ou ACTION ou SCRIPT, yyy le contexte WEB, APP ...
// lire les balises
This.balisesUrl:=Split string($url; "/"; sk ignore empty strings)
// analyser la function
This.paramsUrl:=Split string(This.balisesUrl[This.balisesUrl.length-1]; "?")
// virer function+params
This.balisesUrl:=This.balisesUrl.slice(0; This.balisesUrl.length-1)
// ajouter la function seule
This.balisesUrl.push(This.paramsUrl[0])
// lister les paramètres
This.paramsUrl.shift()
// nettoyer les paramètres
Case of
: (This.paramsUrl.length<2)
// rien à faire
: (This.paramsUrl[0]="@+")
// nettoyer les '+'
This.paramsUrl:=Split string(This.paramsUrl.join(""); "+")
: (This.paramsUrl[0]="@&")
// l'url vient de javascript, le séparateur de params est '&' ('+' ne passe pas)
This.paramsUrl:=Split string(This.paramsUrl.join(""); "&")
End case
//----------------------------------
// MARK:Connexion
//----------------------------------
Function ServeurActif()
This.result.resultat:=Char(1)+"4D4D"
Function Connecter()
// cas normal (init de session) se connecter à la BDD
// initialiser les données d'un utilisateur non identifié
This.LireUserPréférences()
// envoyer l'accueil
This.Envoyer("accueil.shtml"; "accueil")
Function ConnecterEnPrivate()
This.Envoyer("profilAuthentification.shtml"; "accueil")
Function Authentifier()
// un utilisateur WEB est identifié
// idem que .Connecter()
This.LireUserPréférences()
// envoyer l'accueil
This.Envoyer("accueil.shtml"; "accueil")
Function Deconnecter()
This.FermerSession()
This.Rediriger(Session.storage.UserWebRequete.URLdomaine) // retour au site statique
Function SupprimerCookie()
// on ne peut pas supprimer le fichier cookie. Pour invalider l'authentification, on change le date d'expiration du cookie
var $rang : Integer
var $cookie : Text
ARRAY TEXT($clésEntête; 0)
ARRAY TEXT($valeursEntête; 0)
WEB GET HTTP HEADER($clésEntête; $valeursEntête)
$rang:=Find in array($clésEntête; "Cookie")
If (($rang#-1) && (Split string($valeursEntête{$rang}; "=")[0]="4DSID_@"))
$cookie:="Set-Cookie: "+$valeursEntête{$rang}+"; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/"
WEB SET HTTP HEADER($cookie)
End if
//----------------------------------
// MARK:Affichage
//----------------------------------
Function SelectionnerPatronymes()
// mettre à jour les préférences
If (This.paramsUrl.length>0)
Use (Session.storage.WebUserPrefs)
Session.storage.WebUserPrefs.rolodexPatronyme:=This.paramsUrl[0]
End use
End if
This.Envoyer("liste.shtml"; "liste_patronymes")
Function SelectionnerCommunes()
// mettre à jour les préférences
Use (Session.storage.UserParams)
Session.storage.UserParams.personne:=""
End use
If (This.paramsUrl.length>0)
Use (Session.storage.WebUserPrefs)
Session.storage.WebUserPrefs.rolodexCommune:=This.paramsUrl[0]
End use
End if
This.Envoyer("liste.shtml"; "liste_communes")
Function AfficherPersonnes()
// page des personnes du patronyme [0]
If (This.paramsUrl.length>0)
// mettre à jour les préférences
Use (Session.storage.UserParams)
Session.storage.UserParams.UUIDpatronyme:=This.paramsUrl[0]
End use
End if
// (re)intialiser la requête (en particulier en cas de pb)
Use (Session.storage)
Session.storage.UserWebRequetePersonnes:=Null
End use
// envoyer la page
This.Envoyer("liste.shtml"; "liste_personnes")
Function AfficherLaCommune()
var $entité : cs.Communes
var $classeObjet : Object
If (This.paramsUrl.length>0)
// mettre à jour les préférences
Use (Session.storage.UserParams)
Session.storage.UserParams.UUIDcommune:=This.paramsUrl[0]
Session.storage.UserParams.UUIDpatronyme:=""
If (This.paramsUrl.length>1)
Session.storage.UserParams.UUIDpatronyme:=This.paramsUrl[1]
End if
End use
// (re)intialiser la requête (en particulier en cas de pb)
Use (Session.storage)
Session.storage.UserWebRequeteEvents:=Null
End use
// initialiser les variables du formulaire (à faire ici)
$entité:=cs.Communes.new(This.paramsUrl[0])
// sélectionner les events de la commune demandée
$classeObjet:=$entité.LesEvents()
This.SessionStorageAjouter($classeObjet; "UserParams")
// sélectionner les medias de la commune demandée
$classeObjet:=$entité.LesMedias()
This.SessionStorageAjouter($classeObjet; "UserParams")
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.wwwNbrMedias:=$classeObjet.length
Session.storage.HTTPvars.wwwIndexMedia:=0
End use
// pour le menu de la page HTML
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.wwwLieu:=This.paramsUrl[0]
End use
End if
// (re) initialiser
Use (Session.storage.UserWebRequete)
Session.storage.UserWebRequete.evenements:=New shared object
End use
// envoyer la page
This.Envoyer("affichageCommune.shtml"; "commune")
Function AfficherArbre()
// commande de création de l'arbre généalogique de "?"
var $entité : cs.Personnes
var $classeObjet : Object
// mettre à jour les préférences
Use (Session.storage.UserParams)
Session.storage.UserParams.UUIDpersonne:=This.paramsUrl[0]
End use
// stocker les medias de la personne demandée
$entité:=cs.Personnes.new(This.paramsUrl[0])
$classeObjet:=$entité.LesMedias()
This.SessionStorageAjouter($classeObjet; "UserParams")
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.wwwNbrMedias:=$classeObjet.length
Session.storage.HTTPvars.wwwIndexMedia:=0
End use
// (re) initialiser, en prévision de la saisie
Use (Session.storage.UserParams)
Session.storage.UserParams.wwwNom:=""
Session.storage.UserParams.wwwPrenom:=""
End use
// envoyer la page
This.Envoyer("affichageArbre.shtml"; "arbre")
Function AfficherSaisie()
var $ID : Integer
var $entité : Object
var $contexte : Text
// qui modifie-t-on?
If (This.paramsUrl.length>0)
$ID:=Num(This.paramsUrl[0]) & 0x00FFFFFF
$entité:=cs.Personnes.new($ID)
$entité.lesEvents:=$entité.LesEvents()
This.SessionStorageAjouter($entité; "UserParams")
Use (Session.storage.UserParams)
Session.storage.UserParams.UUIDpersonne:=$entité.IDunique
End use
// aller à la page saisie
$contexte:=Choose(Session.isGuest(); "affichage"; "modification+"+This.paramsUrl.join("+"))
This.Envoyer("saisie.shtml"; $contexte)
End if
Function AjouterAlaPersonne()
var $classeObjet; $entité : Object
var $ID : Integer
$classeObjet:=New object
// paramètres de l'ajout : quoi, aQui (IDcodé) {, Qui (IDcodé)}
// le aQui
Case of
: (This.paramsUrl.length<2)
: (CodeEnreg(Num(This.paramsUrl[1]); [1])=1)
// le aQui est une entité de la table "Personnes"
$ID:=Num(This.paramsUrl[1]) & 0x00FFFFFF
$classeObjet:=cs.Personnes.new($ID)
$classeObjet.aQuiDataClassNom:="Personnes"
$classeObjet.aQuiIDunique:=$classeObjet.IDunique
: (CodeEnreg(Num(This.paramsUrl[1]); [5])=1)
// le aQui est une entité de la table "Unions"
$ID:=Num(This.paramsUrl[1]) & 0x00FFFFFF
$classeObjet:=cs.Unions.new($ID)
$classeObjet.aQuiDataClassNom:="Unions"
$classeObjet.aQuiIDunique:=$classeObjet.IDunique
Else
// cas non traité
End case
// le Qui
Case of
: (This.paramsUrl.length<3)
: (CodeEnreg(Num(This.paramsUrl[2]); [1])=0)
// le IDcodé doit être celui d'une table "Personnes"
Else
$ID:=Num(This.paramsUrl[2]) & 0x00FFFFFF
$entité:=cs.Personnes.new($ID)
$classeObjet.QuiDataClassNom:="Personnes"
$classeObjet.QuiIDunique:=$entité.IDunique
End case
// le Quoi
$classeObjet.Quoi:=Num(This.paramsUrl[0])
// on a tout
// on utilise $classeObjet comme porte d'entrée _Web_DataStore
If (OB Class($classeObjet)#Null)
$classeObjet.AjouterDansDataStore($classeObjet)
End if
// retour à l'arbre
$entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
This.Rediriger($entité.UrlDuLien("Web/AfficherArbre"))
Function AfficherRessources()
This.Envoyer("services.shtml"; "ressources")
//----------------------------------
// MARK:Gestion des pages
//----------------------------------
Function Envoyer($nomPageWeb : Text; $EtatNavigation : Text; $HTTPvars : Text)
// fixer les variables process
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.wwwEtatNavigation:=$EtatNavigation
End use
// définir les constantes process (et en mode interprété les variables process)
// init des variables process Web
COMPILER_WEB
// restaurer les variables process générales
This.RestaurerHTTPvars("HTTPvars")
// restaurer les variables process spécifiques du contexte
If (Count parameters>2)
This.RestaurerHTTPvars($HTTPvars)
End if
WEB SEND FILE($nomPageWeb)
Function Rediriger($url : Text)
WEB SEND HTTP REDIRECT($url)
//----------------------------------
// MARK:Variables process HTTP
//----------------------------------
Function LireHTTPvars()
var $data : Object
var $i : Integer
// depuis v14 les variables Form sont récupérées de cette façon
ARRAY TEXT($tableauDeNoms; 0)
ARRAY TEXT($tableauDeValeurs; 0)
// les variables récupérées correspondent à des objets de formulaire Web ayant un attribut "name"
WEB GET VARIABLES($tableauDeNoms; $tableauDeValeurs)
For ($i; 1; Size of array($tableauDeNoms))
// ne garder que les variables de type wwwXXX...
If ($tableauDeNoms{$i}="www@")
OB SET($data; $tableauDeNoms{$i}; $tableauDeValeurs{$i})
End if
End for
ASSERT(This.trace.DebugerVariables("$commande"; Current method name; New object("variablesHTTP"; $data))) //; "Options"; 0x0002
sharedObject($data; Session.storage.HTTPvars)
Function RestaurerHTTPvars($contexte : Text)
// copier $contexte dans les variables process
var $sessionStorage; $data : Object
var $attribut; $varNom : Text
var $numTable; $numChamp : Integer
var $ptr : Pointer
$sessionStorage:=This.getStorage()
If (OB Is defined($sessionStorage; $contexte))
$data:=$sessionStorage[$contexte]
For each ($attribut; $data)
RESOLVE POINTER(Get pointer($attribut); $varNom; $numTable; $numChamp)
Case of
: (($numTable=0) & ($numChamp=0))
// pointeur NIL
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Variable indéfinie"; Current method name; $contexte+" : la variable '"+$attribut+"' n'a pas une variable")
: (($numTable#-1) | ($numChamp#-1))
// pas une variable
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Variable indéfinie"; Current method name; $contexte+" : la variable '"+$attribut+"' n'a pas été initialisée dans COMPILER_xxx")
Else
// on a une variable : l'initialiser
$ptr:=Get pointer($attribut)
$ptr->:=$data[$attribut]
End case
End for each
End if
⇧
[class]$recherche - 06/06/2026 15:37:44
property Critères : Object
Class constructor()
This.Critères:=Null
// ----------------------
// MARK:Personnes
// -----------------------
Function RechercherPersonnes($params : Object)->$result : Collection
// créer la sélection de personnes répondant aux critères de recherche $params :
// nom, prénom, dates min / max de naissance / mariage / décès
var $c : Collection
var $c1; $c2 : Collection
var $critères : Object
var $attribut : Text
MESSAGES OFF
// initialiser les consignes de filtrage demandés
This.Critères:=OB Copy($params)
// une personne trouvée sera retenue si ses events (par type) sont présents dans les filtres locaux
// liste des types d'event pris en compte ; certains peuvent ne pas exister dans la demande $params
$c:=This.ListerParamsCritèresEvents()
// valider les paramètres de ces filtres fournis par l'utilisateur, par type d'event
For each ($critères; $c)
This.ValiderCritèresEvents($critères)
End for each
// * Rechercher selon nom et prénom
$c1:=This.SélectionnerPersonnesSurCritères()
// * Rechercher des events selon le ET des 3 types de critères
$c:=New collection
For each ($attribut; OB Keys(This.Critères.Events))
// les evenst
$c:=This.SélectionnerEventsSurCritères(This.Critères.Events[$attribut])
// les personnes liés à ces events
$c:=This.SélectionnerPersonnesSurEvents($c)
// cumuler avec $cumul
Case of
: ($c.length=0)
// rien de plus
: ($c2.length=0)
// les events trouvés ici
$c2:=$c
Else
// faire l'intersection des 2 collections
$c2:=$c2.filter(Formula($2.indexOf($1.value)>-1); $c)
End case
End for each
// finalement, fixer le résultat
$result:=New collection
Case of
: (($c1.length=0) & ($c2.length=0))
: (($c1.length>0) & ($c2.length>0))
// les 2 domaines ont données des résultats
// faire l'intersection (peut être vide !)
$result:=$c1.filter(Formula($2.indexOf($1.value)>-1); $c2)
: ($c2.length>0)
$result:=$c2
Else
// c'est $c1 qui est non vide
$result:=$c1
End case
MESSAGES ON
Function SélectionnerPersonnesSurCritères()->$result : Collection
// sélectionner toutes les personnes de nom et / ou prénom demandés et autorisées
var $class : cs.xSQL.PersonnesSelect
// par défaut sélection vide
$result:=New collection
If ((This.Critères.Nom#"") | (This.Critères.Prenom#""))
$class:=cs.xSQL.PersonnesSelect.new()
$class.Chercher(This.Critères).FiltrerSurID(This.Critères.FiltrePersonnes)
$result:=$class.collection
End if
$class:=Null
Function SélectionnerEventsSurCritères($params : Object)->$result : Collection
// collecter les ID de personnes liés aux les events de la commune de $params
// les filtres globaux (events et commune) sont appliqués à la collection
var $class : cs.xSQL.EventsSelect
var $c : Collection
$class:=cs.xSQL.EventsSelect.new()
If ($params.valide)
// on des choses à chercher
If (OB Is defined($params.lieu; "Nom"))
// on a un nom de commune
// sélectionner les events de cette commune
$c:=cs.xSQL.CommunesSelect.new().Chercher(New object("Nom"; $params.lieu.Nom)).LesEvents()
Else
// les events de toutes les communes
$c:=This.Critères.FiltreEvents
End if
// sélectionner les events suivant les critères events, et filtrer avec ceux du critère commune
$class.Chercher($params).FiltrerSurID($c)
$result:=$class.collection
Else
// rien
$result:=New collection
End if
$class:=Null
Function SélectionnerPersonnesSurEvents($c : Collection)->$result : Collection
// renvoyer la sélection des personnes de $c
var $class : cs.xSQL.EventsSelect
$class:=cs.xSQL.EventsSelect.new($c)
$result:=$class.LesProtagonistes()
$class:=Null
Function ListerParamsCritèresEvents()->$result : Collection
$result:=New collection
$result.push(New object("nomEvent"; "Naissances"; "typeMin"; 22000; "typeMax"; 22000))
$result.push(New object("nomEvent"; "Deces"; "typeMin"; 22100; "typeMax"; 22100))
$result.push(New object("nomEvent"; "Mariages"; "typeMin"; 33600; "typeMax"; 33699))
Function ValiderCritèresEvents($critères : Object)
// fixe des données de filtrage exploitables par la function de rechercher :
// .typeMin et Max, .dateMin et Max (dateNum), .lieuNom (nom de commune)
var $data : Object
var $nomEvent : Text
$nomEvent:=$critères.nomEvent
Case of
: (Not(OB Is defined(This.Critères; "Events")))
// créer des critères vides pour ce type d'event
This.Critères.Events:=New object($nomEvent; New object("valide"; False))
: (Not(OB Is defined(This.Critères.Events; $nomEvent)))
// créer des critères vides pour ce type d'event
This.Critères.Events[$nomEvent]:=New object("valide"; False)
: (Not(OB Is defined(This.Critères.Events[$nomEvent]; "date")))
// créer la date invalide par principe
This.Critères.Events[$nomEvent]["date"]:=New object("valide"; False)
Else
$data:=This.Critères.Events[$nomEvent]
// rappel cas du serveur Web : il envoie toujours une donnée, nulle si non utilisée
// rappel : une date peut être absente
// date de début
Case of
: (Not(OB Is defined($data; "date")))
: (Not(OB Is defined($data.date; "Start")))
: ($data.Start="")
: (Not(This.getDateNum($data.date.Start; $data)))
// erreur de conversion
Else
// on a une date numérique
$data.dateMin:=$data.dateNum
$data.valide:=True
// nettoyer
OB REMOVE($data; "dateNum")
End case
// date de fin
Case of
: (Not(OB Is defined($data; "date")))
: (Not(OB Is defined($data.date; "Stop")))
: ($data.Stop="")
: (Not(This.getDateNum($data.date.Stop; $data)))
// erreur de conversion
Else
// utiliser cette date chaine
$data.dateMax:=$data.dateNum
$data.valide:=True
// nettoyer
OB REMOVE($data; "dateNum")
End case
Case of
: (Not(OB Is defined(This.Critères.Events[$nomEvent]; "lieu")))
// créer le lieu invalide par principe
This.Critères.Events[$nomEvent]["lieu"]:=New object()
: (Not(OB Is defined(This.Critères.Events[$nomEvent]["lieu"]; "Nom")))
This.Critères.Events[$nomEvent]["lieu"]:=New object()
: (This.Critères.Events[$nomEvent]["lieu"]["Nom"]="")
This.Critères.Events[$nomEvent]["lieu"]:=New object()
Else
// c'est ok
$data.valide:=True
End case
// ici .valide vaut vrai si la date de début et / ou de fin est correcte et / ou commune existe
// recopier le filtrage sur le type
This.Critères.Events[$nomEvent].typeMin:=$critères.typeMin
This.Critères.Events[$nomEvent].typeMax:=$critères.typeMax
End case
// ----------------------
// MARK:Communes
// -----------------------
Function RechercherCommunes($params : Object)->$result : Collection
MESSAGES OFF
// initialiser les consignes de filtrage demandés
This.Critères:=OB Copy($params)
// valider les paramètres de ces filtres fournis par l'utilisateur
This.ValiderCritèresCommunes()
// * Rechercher selon nom et prénom
$result:=This.SélectionnerCommunesSurCritères()
MESSAGES ON
Function SélectionnerCommunesSurCritères()->$result : Collection
var $class : cs.xSQL.CommunesSelect
$result:=New collection
If (This.Critères.valide)
$class:=cs.xSQL.CommunesSelect.new()
$class.Chercher(New object("Nom"; This.Critères.nom)).FiltrerSurID(This.Critères.FiltreCommunes)
$result:=$class.collection
End if
Function ValiderCritèresCommunes()
Case of
: (Not(OB Is defined(This.Critères; "nom")))
This.Critères.nom:=""
This.Critères.valide:=False
: (Length(This.Critères.nom)>0)
//%W-533.1
This.Critères.nom[[1]]:=Uppercase(This.Critères.nom[[1]])
//%W+533.1
This.Critères.valide:=True
End case
// ----------------------
// MARK:Lieux
// -----------------------
Function RechercherLieux($params : Object; $resultRecherche : Pointer)
//Sinon
//// au cas où... (initialisation pas faite)
//Au cas ou
//: (Type($3->)=Est un objet)
//$3->:=Créer objet
//: (Type($3->)=Est une collection)
//$3->:=Créer collection
//Fin de cas
//Fin de cas
// ----------------------
// MARK:Utilitaires
// -----------------------
Function getDateNum($dateChaine : Text; $data : Object)->$result : Boolean
// convertit $dateChaine en une variable date valide
var $date; $jour; $mois; $année; $nomDuMois; $nomMois : Text
var $i : Integer
Case of
: (Match regex("[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{4}"; $dateChaine))
// $dateChaine = jj/mm/aaaa
$result:=True
$data.dateNum:=Date($dateChaine)
: (Match regex("[0-9]{1,2}\\ [a-z,é]{3,9}\\ [0-9]{4}"; $dateChaine))
// $dateChaine = jj mois aaaa
// créer la date numérique et la valider
$date:=$dateChaine
//le séparateur d'items de date est " "
$jour:=Substring($date; 1; Position(" "; $date; *)-1)
$date:=Delete string($date; 1; Position(" "; $date; *))
$nomDuMois:=Substring($date; 1; Position(" "; $date; *)-1)
$date:=Delete string($date; 1; Position(" "; $date; *))
$année:=Substring($date; 1; 4)
$result:=False
$mois:="01"
For ($i; 12; 1; -1)
$nomMois:=String(Add to date(!1999-12-01!; 0; $i; 0); Internal date long)
$nomMois:=Substring($nomMois; Position(" "; $nomMois; *)+1)
$nomMois:=Substring($nomMois; 1; Position(" "; $nomMois; *)-1) // nom du mois $1 dans la langue courante
If ($nomDuMois=$nomMois)
$mois:=String($i)
$result:=True
$i:=0
End if
End for
If (Num($année)=0)
$année:="100"
$result:=False
End if
If (Num($jour)=0) // dernier jour du mois $mois
$jour:=String(Day of(Add to date(Add to date(!00-00-00!; Num($année); Num($mois)+1; 1); 0; 0; -1)))
$result:=False
End if
$data.dateNum:=Add to date(!00-00-00!; Num($année); Num($mois); Num($jour))
Else
// $dateChaine autre format ou vide
$result:=False
End case
⇧
[class]$document - 22/05/2026 10:44:17
property fichier : 4D.File
property dossier : 4D.Folder
property exists : Boolean
Class constructor()
Function CréerFichier($chemin : Text; $chemins : Collection)->$result : 4D.File
// $2 est optionnel
var $path : Text
$path:=This._BuildPath($chemin; $chemins)
This.fichier:=File($path; fk posix path)
This.exists:=This.fichier.exists
$result:=This.fichier
Function CréerDossier($chemin : Text; $chemins : Collection)->$result : 4D.Folder
// $2 est optionnel
var $path : Text
$path:=This._BuildPath($chemin; $chemins)
This.dossier:=Folder($path+"/"; fk posix path)
This.dossier.create()
This.exists:=This.dossier.exists
$result:=This.dossier
Function _BuildPath($chemin : Text; $chemins : Collection)->$result : Text
// un chemin absolu, convertir en POSIX
If (($chemin[[1]]="/"))
$result:=$chemin
Else
$result:=Convert path system to POSIX($chemin)
End if
Case of
: ($chemins=Null)
: ($chemins.length=0)
Else
$result:=$result+$chemins.join("/")
End case
Function LireLocatedSTR($ID : Integer; $options : Object)->$result : Text
// lire la chaine $ID et traiter ses balises :
// . balise STR : lecture d'une chaine localisée du composant
// . balise xCode : lecture d'une variable
// :xCode?table+?numtable+?numChamp: de la sélection courante
// :xCode?var+?libellé: propriété 'libellé' de storage.STR
// . balise xliff : lecture d'une ressource
// :xliff?idSTR: ressource ALV
// :xliff?4D+?CommonMenuFile: ressource 4D
// :xliff?ALV+?path: ressource ALV
// . balise uri : lien dans un texte vers une page HTML
// :uri?libellé du lien+?IDobjetALV+?codeObjetALV: le clic sur le lien déclenche une action 4D avec le paramètre 'IDobjetALV' codé 'codeObjetALV'
var $début; $fin : Integer
var $libellé; $texte; $balise : Text
var $newTexte : Text:=""
var $UserPrefs : Object
var $c; $cEl : Collection
$UserPrefs:=New object("Apparence"; New object("CodeLangue"; "fr"))
$texte:=Localized string(String($ID))
// options
If (Count parameters=1)
// options par défaut
$options:=New object("genre"; False; "plur"; False)
End if
// traiter les chaines complexes dans un texte multistyle. Les balises d'éléments HTML sont traitées ailleurs (mécanisme différent)
// v7.4.5 Remarque : traiter toutes les chaines. Les balises ALV sont différentes du mécanisme de 4D : "Utiliser des références dans les textes statiques"
// rechercher dans $texte une balise d'un type de $c à partir de $début
// une balise est la forme :typeBalise?xxxx:
// d'abord chercher les balises xCode, référant un élément de langages
// puis traiter les balises xliff dans un texte multistyle
// puis traiter les balises uri dans un texte multistyle
$c:=New collection(":STR"; ":xCode"; ":xliff"; ":uri")
For each ($libellé; $c)
$début:=1
While ($début>0)
// chercher la balise
$fin:=Position($libellé; $texte; $début; *)
If ($fin=0)
// c'est fini : arrêter la recherche
$début:=-1
Else
// récupérer la balise
$début:=$fin
$fin:=Position(":"; $texte; $début+1; *)
$balise:=Substring($texte; $début; $fin-$début+1) // balise à remplacer
// récupérer les paramètres
$newTexte:=Substring($balise; 2; Length($balise)-2) // virer les marqueurs (plus propre)
$cEl:=Split string($newTexte; "?"; sk ignore empty strings)
// plusieurs cas
Case of
// il faut avoir trouvé la fin de la balise
: ($fin=0)
$début:=0
$newTexte:=""
cs._Trace.me.Créer(-15085; Current method name; "balise xliff incomplète dans la chaine "+String($ID)).LeverException([msgk_event; msgk_log])
// il faut au moins 1 élément
: ($cEl.length=0)
// effacer la balise
$texte:=Replace string($texte; $balise; "")
// calculer le texte remplaçant la balise
: ($libellé=":xCode")
Case of
// traiter les balises dont la valeur est contextuelle (paramètres de la méthode)
: ($cEl[1]="genre")
Case of
: (Not(OB Is defined($UserPrefs; "Apparence")))
// la langue n'est pas toujours définie (exemple : à l'ouverture de l'application, et avant l'ouverture de session)
// imposer le français
$newTexte:="e"*Num($options.genre)
: ($UserPrefs.Apparence.CodeLangue="fr")
$newTexte:="e"*Num($options.genre)
Else
$newTexte:="?"
End case
: ($cEl[1]="plur")
Case of
: (Not(OB Is defined($UserPrefs; "Apparence")))
// la langue n'est pas toujours définie (exemple : à l'ouverture de l'application, et avant l'ouverture de session)
// imposer le français
$newTexte:="s"*Num($options.plur)
: ($UserPrefs.Apparence.CodeLangue="fr")
$newTexte:="s"*Num($options.plur)
: ($UserPrefs.Apparence.CodeLangue="en")
$newTexte:="s"*Num($options.plur)
Else
$newTexte:="?"
End case
// pour le reste, il faut au moins 2 éléments
: ($cEl.length<3)
// effacer la balise
$newTexte:=""
// une variable, sa valeur est renseignée dans Storage.STR
: ($cEl[1]="variable")
$newTexte:="err :xCode?variable"
Case of
: (Not(OB Is defined(Storage; "STR")))
: (Not(OB Is defined(Storage.STR; $cEl[2])))
// pas créée
$newTexte:="err "+$cEl[2]
Else
// c'est ok
$newTexte:=Storage.STR[$cEl[2]]
End case
End case
: ($libellé=":xliff")
Case of
// une chaine localisée
: ($cEl.length=2)
// une balise xliff peut contenir des éléments calculés => on boucle
$newTexte:=This.LireLocatedSTR(Num($cEl[1]); $options)
// une chaine en ressource
: ($cEl.length=3)
Case of
: ($cEl[1]="4D")
// chaine ressource de 4D
$newTexte:=Localized string($cEl[2])
: ($cEl[1]="ALV")
// chaine ressource de ALV
$newTexte:=""
If (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; $cEl[2]; Is text; ->$newTexte)))
$newTexte:=$balise
End if
Else
// v6.7.1 : "Lire chaîne dans liste" : commande obsolète
$newTexte:=$cEl[2]
End case
End case
: ($libellé=":uri")
// plusieurs cas
Case of
// il faut au moins 3 éléments
: ($cEl.length<3)
// effacer la balise
$texte:=Replace string($texte; $balise; "")
Else
// un lien vers un objet ALV
$newTexte:=String(CodeEnreg(Num($cEl[1]); [Num($cEl[2])]))
//ST FIXER TEXTE($texte; "<span style=\"-d4-ref-user:'"+$newTexte+"'\">"+$Elements{1}+"</span>"; $début; $fin+1)
$texte:=Current method name+" - commabd ':uri' non faite"
End case
// continuer depuis le début (on ne connait pas la longueur de ce qui a été inséré)
$début:=1
// pour passer les tests suivants
$balise:=""
$newTexte:=""
: ($libellé=":STR")
Case of
// une chaine localisée
: ($cEl.length=2)
// une balise xliff peut contenir des éléments calculés => on boucle
$newTexte:=This.LireLocatedSTR(Num($cEl[1]); $options)
// une chaine localisée paramétrée
: ($cEl.length=4)
$newTexte:=This.LireLocatedSTR(Num($cEl[1]); New object("genre"; $cEl[2]="Vrai"; "plur"; $cEl[3]="Vrai"))
End case
Else
// on ne sait pas
$newTexte:="err locatedSTR "
End case
// traduire la balise (il peut y en avoir plusieurs)
$texte:=Replace string($texte; $balise; $newTexte)
// continuer
$début:=$début+Length($newTexte)
End if
End while
// balise suivante
End for each
$result:=$texte
//------------------
//mark: installation
//------------------
Function VolumeDeMedia($entité : Object; $data : Object)->$result : Object
// renvoyer dans $2 le nom du volume de l'entité media $1
var $ID; $volume : Integer
$result:=New object("Error"; 0)
$data.ID:=0
Case of
: ($entité.DataClassNom="Medias")
// ID du dossier et son volume du media
$ID:=$entité.ID
Begin SQL
SELECT Dossiers.ID, Dossiers.volume FROM Dossiers
INNER JOIN Fichiers ON Fichiers.dossier = Dossiers.ID
WHERE Fichiers.media = :$ID
INTO :$ID, :$volume;
End SQL
: ($entité.DataClassNom="Dossiers")
$ID:=$entité.ID
$volume:=$entité.volume
Else
$ID:=-1
End case
// remonter la chaine de sous dossiers jusqu'à la racine (n° volume > 0)
If ($ID>0)
$result.Error:=0
While ($volume<0)
// dossier précédent
Begin SQL
SELECT dossier FROM Arborescence WHERE SousDossier = :$ID INTO :$ID;
SELECT volume FROM Dossiers WHERE ID = :$ID INTO :$volume;
End SQL
End while
$data.ID:=$volume
Else
$result.Error:=-16999 // to define
End if
Function getDossierTravail()->$result : Object
$result:=Folder(fk home folder).folder("tempo_ALV")
$result.create()
//------------------
//mark: installation
//------------------
Function getUserFolderPath()->$result : Text
// renvoyer le chemin du dossier des documents utilisateur
// ce dossier est le même que celui du Serveur APP
var $dossier : Text
// utiliser le dossier par défaut (le créer au besoin)
$dossier:=This.getUserWorkSpacePath()
$result:=This.CréerDossier($dossier; New collection(This.LireLocatedSTR(103); Session.userName)).platformPath
Function getUsersPreferencesFolderPath()->$result : Text
// renvoyer le chemin du dossier des préférences des utilisateurs
// ce chemin est utilisé par toutes les sessions (BDD mère, APP client, appli fusionnée)
var $dossier; $sousDossier : Text
$dossier:=This.getUserFolderPath()
$sousDossier:=This.LireLocatedSTR(83)
$result:=This.CréerDossier($dossier; New collection($sousDossier)).platformPath
Function getUserWorkSpacePath()->$result : Text
// renvoyer le chemin du dossier utilisateur
// pour que ce dossier soit conservé après des mises à jour, il est dans le dossier système Documents utilisateur
var $sousDossier : Text
$sousDossier:=cs.xSDK.EnvironnementALV.new().infosApplication().nomLong
$result:=Folder(fk documents folder).folder($sousDossier).platformPath
Function getWebCartographieFolder($sousDossier : Text)->$result : Text
// v6.4.8 utilisation de la langue de la base, pas celle de l'utilisateur
var $c : Collection
$c:=New collection(Localized string("129"); $sousDossier; Lowercase(Localized string("177")))
$result:=$c.join(Folder separator)+Folder separator
Function getSessionFolder()->$result : Object
// le dossier de la session Web
$result:=This.getRacineHTMLFolder().folder(Localized string("129")).folder(Session.id)
Function getRacineHTMLFolder()->$result : 4D.Folder
var $texte : Text:=""
Case of
: (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Serveur_web/nomDossier_RacineWeb"; Is text; ->$texte)))
: (Storage.System.typeApplication=ALV Client APP)
// filtrer (pas concerné pour l'instant)
: (Storage.System.typeApplication=ALV Serveur APP)
// ouverture de l'APP serveur
$result:=Folder(Structure file(*); fk platform path).parent.parent.parent.parent.folder($texte)
: (Storage.System.typeApplication=ALV Serveur HTTP)
// ouverture du projet avec un 4D serveur non compilé
// dossier dans les document utilisateur
$result:=Folder(fk documents folder).parent.folder("Sites").folder($texte)
: (Storage.System.typeApplication=ALV BDD mère)
// composant dans la base mère
// dossier dans les document utilisateur
$result:=Folder(fk documents folder).parent.folder("Sites").folder($texte)
Else
// composant exécuté seul
$result:=Folder(Structure file(*); fk platform path).parent.parent.parent.folder($texte)
End case
// au besoin, créer le dossier
$result.create()
Function getCertificatSSLFolder()->$result : 4D.Folder
// fixe le chemin du dossier des certificats SSL du serveur Web
var $texte : Text:=""
Case of
: (Not(cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Serveur_web/nomDossier_CertificatSSL"; Is text; ->$texte)))
: (Storage.System.typeApplication=ALV Client APP)
// hors sujet
$result:=Null
Else
// serveurs APP ou HTTP
// le dossier des cert est au même niveau que le dossier racine HTML
$result:=This.getRacineHTMLFolder().parent.folder($texte)
Case of
: ($result.exists)
// c'est bon
: ($result.create())
// c'est créé
Else
$result:=Null
End case
End case
Function CertInformations()->$result : Object
var $params : Object
$params:=New object("CertificatSSLFolderPath"; This.getCertificatSSLFolder().platformPath)
cs.xSSL.$lectureCERT.new().getInformations($params)
$result:=$params.infos
//----------------------------
// MARK:chemins FTP ou URL Web
//----------------------------
Function getHostMediaPath($quoi : Text; $entité : Object; $params : Object)->$result : Text
// renvoie le chemin complet type $quoi (FTP ou URL Web) du fichier image de $entité sur le serveur, en fonction de $params
$result:=This.getHostFolderPath($quoi; $entité)+This.getNomFichierMedia($entité; $params)
Function getHostFolderPath($quoi : Text; $entité : Object)->$result : Text
// renvoie le chemin relatif (type FTP ou URL Web) des divers dossiers sur l'hébergeur
var $dossier; $texte : Text
var $data : Object
Case of
: ($quoi="BddMedia")
// chemin des media de la BDD, relatif la racine FTP
$texte:="Chemins/Media/Dossier"
: ($quoi="URLMedia")
// URL des media de la BDD, relatif la racine WEB
$texte:="Chemins/Media/URL"
: ($quoi="WebMedia")
// chemin des medias Web, relatif la racine FTP
$texte:="Chemins/Media/Path"
: ($quoi="WebIcons")
// chemin des icons Web, relatif la racine FTP
$texte:="Chemins/Icons/Path"
: ($quoi="URLIcons")
// URL des icons Web, relatif la racine WEB
$texte:="Chemins/Icons/URL"
Else
$texte:=""
End case
$dossier:=""
// lire le chemin
If ($texte#"")
cs.xSDK.ResourceALV.me.SetVariable(Est Ressource HOST; $texte; Is text; ->$dossier)
$data:=New object
// ajouter le sous dossier
Case of
: ($quoi#"@Media@")
// pas un dossier BDDmedia
: (Count parameters<2)
// il manque une entité media
: (This.VolumeDeMedia($entité; $data).Error#0)
// le dossier n'est pas connu
Else
// ajouter le sous dossier "folder_IDvolume"
$dossier:=$dossier+"folder_"+String($data.ID)+"/"
End case
// les données ne sont plus à la racine WEB du serveur WEB 4D : ajouter la racine WEB
Case of
: ($quoi#"@URL@")
// pas une URL
Else
// préfixer par l'URL de l'hébergeur
$dossier:=This.getHostURL($dossier)
End case
End if
$result:=$dossier
Function getNomFichierMedia($entité : Object; $params : Object)->$result : Text
// renvoie le nom du fichier image de $entité sur le serveur FTP (http), en fonction de $params
Case of
: (Not(OB Is defined($params; "attribute")))
// les medias
: ($entité.DataClassNom="Medias")
Case of
: ($params.attribute="ID")
// [Medias]ID
$result:=String(CodeEnreg($entité.ID; [19]))+"_img"
// ajouter l'extension
Case of
: ($entité.type=1)
$result:=$result+Web Image format
: ($entité.type=2)
$result:=$result+".pdf"
Else
$result:=Web Media Inconnu
End case
: ($params.attribute="icône")
// [Medias]icône)
$result:=String(CodeEnreg($entité.ID; [19]))+"_ico"
// ajouter l'extension
Case of
: ($entité.type=1)
$result:=$result+Web Imagette format
: ($entité.type=2)
$result:=$result+Web PDFimagette format
End case
End case
// les communes
: ($entité.DataClassNom="Communes")
// [Communes]blason)
$result:=String(CodeEnreg($entité.ID; [13]))+"_ico"+Web Icon format
Else
$result:=Web Media Inconnu
End case
Function getWebCartographieURL($chemin : Text)->$result : Text
// v6.4.8 utilisation de la langue de la base, pas celle de l'utilisateur
$result:=Localized string("129")+"/"+$chemin+"/"+Lowercase(Localized string("177"))
Function getHostURL($chemin : Text)->$result : Text
// chemin http des divers dossiers relatif à la racine Web de l'hébergeur
// le chemin $chemin est relatif à la racine Web. $2 doit être un sous dossier
var $texte : Text:=""
If (cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Hosting/URL"; Is text; ->$texte))
$texte:=$texte+$chemin
End if
$result:=$texte
//----------------------------
// MARK:URL Web static
//----------------------------
Function getSousDossierPersonnes()->$result : Text
$result:="personnes/"
Function getSousDossierPatronymes()->$result : Text
$result:=This.getSousDossierPersonnes()+"_patronymes/"
Function getURLpersonnes()->$result : Text
$result:=wwwRacineRessources+This.getSousDossierPersonnes()
Function getURLpatronyme()->$result : Text
$result:=wwwRacineRessources+This.getSousDossierPatronymes()
Function getSousDossierEtatCivil()->$result : Text
$result:="etatscivils/"
Function getSousDossierCommunes()->$result : Text
$result:=This.getSousDossierEtatCivil()+"_communes/"
Function getURLetatcivil()->$result : Text
$result:=wwwRacineRessources+This.getSousDossierEtatCivil()
Function getURLnom()->$result : Text
$result:=wwwRacineRessources+This.getSousDossierCommunes()
Function CalculerNiveauRelatifPOSIX($texte : Text)->$result : Text
$result:="../"*Split string($texte; "/"; sk ignore empty strings).length
⇧
[class]$maintenance - 04/11/2025 14:14:06
property nomTache : Text:="MaintenanceWEB"
property Taches : Collection
Class extends $composant
Class constructor()
Super()
Function FixerListeTâches()
// lister les tâches à exécuter
var $data : Object
This.Taches:=New collection
$data:=New object
$data.functionID:="CréerMediaWEB"
// prochaine nuit, 4h
$data.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?04:00:00?)
// puis tous les 13 jours
$data.période:=New object("jour"; 13; "seconde"; 0)
$data.initialiser:=(Storage.Host.Session_Etat ?? 6) // vrai = lancer de suite, pour test en particulier
This.Taches.push(OB Copy($data))
This.trace.EnvoyerMessages([msgk_event]; "Maintenance"; Current method name; "Tâche 'CréerMediaWEB' programmée (voir détails dans Logs)")
This.trace.EnvoyerMessages([msgk_log]; "Maintenance CréerMediaWEB"; Current method name; JSON Stringify($data))
$data:=New object
$data.functionID:="CréerSiteWEB"
// démarrage dans 6 mois
$data.dateTache:=String(Add to date(Current date; 0; 0; 180); ISO date GMT; ?01:00:00?)
// tous les 6 mois
$data.période:=New object("jour"; 180; "seconde"; 0)
$data.initialiser:=(Storage.Host.Session_Etat ?? 6) // vrai = lancer de suite, pour test en particulier
This.Taches.push(OB Copy($data))
This.trace.EnvoyerMessages([msgk_event]; "Maintenance"; Current method name; "Tâche 'CréerSiteWEB' programmée (voir détails dans Logs)")
This.trace.EnvoyerMessages([msgk_log]; "Maintenance CréerSiteWEB"; Current method name; JSON Stringify($data))
$data:=New object
$data.functionID:="InstallerAlbums"
// prochaine nuit à 5:00
$data.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?05:00:00?)
// tous les jours
$data.période:=New object("jour"; 1; "seconde"; 0)
$data.initialiser:=True
This.Taches.push(OB Copy($data))
This.trace.EnvoyerMessages([msgk_event]; "Maintenance"; Current method name; "tâche 'InstallerAlbums' programmée (voir détails dans Logs)")
This.trace.EnvoyerMessages([msgk_log]; "Maintenance InstallerAlbums"; Current method name; JSON Stringify($data))
// ----------------------
// MARK:Maintenance
// ----------------------
Function Démarrer()
// exécuter dans un process externe
var $data : Object
var $numProc : Integer
Case of
: ((Storage.System.typeApplication#4D Serveur APP) & (Not(Storage.Host.Session_Etat ?? 6)))
// serveur ALV seul uniquement, ou mode debug
Else
$data:=New object
$data.functionID:="SuperviserLesTaches"
$data.nomTache:=This.nomTache
$data.numProcessAppelant:=-1
$numProc:=Exécuter Function Préemptive(cs.$maintenance; $data)
// rappel : l'objet $data.tache a été créé
End case
Function SuperviserLesTaches($data : Object)
// gérer les tâches de la maintenance des serveurs Web
var $tâche : Object
var $jours : Integer
var $heure : Integer
// attendre la fin du démarrage de l'hôte, mises à jour ...
//Waiting(5*60*60)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "Maintenance"; Current method name; "Démarrage du monitoring")
This.FixerListeTâches()
// lancer le monitoring des tâches
Repeat
For each ($tâche; This.Taches)
Case of
: (Not(OB Is defined($tâche; "functionID")))
: (Not(OB Is defined($tâche; "dateTache")))
: (Not(OB Is defined($tâche; "initialiser")))
: (Not(($tâche.initialiser) | (String(Current date; ISO date GMT; Current time)>$tâche.dateTache)))
// attendre
Else
// ok, on a tout pour cette tâche, la lancer
This[$tâche.functionID]($data)
// date du prochain lancement de cette tâche
// nombre de jours
// on peut avoir rater des périodes ; combien?
$jours:=Current date-Date($tâche.dateTache)
// ajouter la période
$jours:=$jours+$tâche.période.jour+((Time($tâche.dateTache)+$tâche.période.seconde)\(24*3600))
// nouvelle heure
$heure:=Mod(Time($tâche.dateTache)+$tâche.période.seconde; 24*3600)
// nouvelle date (au cas où, on se resynchronise aussi sur l'heure)
$tâche.dateTache:=String(Add to date(Date($tâche.dateTache); 0; 0; $jours); ISO date GMT; Time(Current time+$tâche.période.seconde))
$tâche.initialiser:=False
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "La tâche '"+$tâche.functionID+"' sera relancée le '"+$tâche.dateTache+"'")
End case
End for each
// *** attendre un peu
Waiting(60*10)
Until ($data.tache.partage.Tuer.signaled)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Fin du monitoring")
Function Arrêter()
If ((Storage.System.typeApplication=ALV Serveur APP) | (Storage.Host.Session_Etat ?? 6))
cs.xSDK.RegistreTaches.new().Tuer(This.nomTache)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Arrêt du monitoring")
End if
// ----------------------
// MARK:Tâches
// ----------------------
Function CréerMediaWEB($data : Object)
// créer / mettre à jour les fichiers medias du serveur Web
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Démarrage du traitement")
// mise à jour des medias web
cs.$maintenanceMedias.new().MettreAjourFichiersWeb($data)
Function CréerSiteWEB($data : Object)
// créer les fichiers des pages statiques
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Démarrage du traitement")
// * initialisations
cs.$maintenanceSite.new().Créer($data)
Function InstallerAlbums()
var $DossierDestination : 4D.Folder
// ici le rootFolder est fixé : demander l'installation des albums
$DossierDestination:=This.document.getRacineHTMLFolder()
CALL WORKER("WK_Composant_WEB"; Formula(cs.xALB._maintenance.new().InstallerAlbums($DossierDestination)))
⇧
[class]_WEB_DataStore - 06/06/2026 12:30:01
property dataClass : Object
property serveur : cs.xSDK.ServicesFTP
property selection; collection; entreesRolodex; selectionRecherche : Collection
property length; Quoi : Integer
property _tagUrl : Text:="/4DCGI/"
// attributs de classe
property DataClassNom : Text
property ID : Integer
property IDunique : Text
Class extends $composant
Class constructor($DataClassNom : Text; $data : Variant)
Super()
This.dataClass:=cs.xSQL[$DataClassNom].new($data)
// récupérer les attributs scalaires dans this : .DataClassNom, .collection et .length
cs.xSDK.Outils.me.CopierAttributs(This.dataClass; This)
// serveur FTP
This.serveur:=cs.xSDK.ServicesFTP.new()
// ----------------------
//MARK:Entité Wrappers
// ----------------------
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté de this suivant les options $formats
$libellé:=This.dataClass.Libellé($formats)
Function Le($DataClassNom : Text)->$result : Object
// renvoie l'entité [$DataClassNom] de ce composant (la classe doit exister !)
var $entité : Object
$entité:=This.dataClass.Le($DataClassNom)
// ajouter les attributs / functions WEB
$result:=cs[$DataClassNom].new($entité.ID)
Function IDcodé()->$result : Integer
$result:=This.dataClass.IDcodé()
// ----------------------
//MARK:Sélections
// ----------------------
Function Créer()
// créer une collection d'entités ; resultat dans .selection
This.setEntités()
Function FiltrerSurID($nomFiltre : Text)
// les ID .selection doivent être dans le filtre $nomFiltre
// une sélection doit exister
var $c : Collection
Case of
: (This.selection=Null)
: (This.selection.length=0)
Else
$c:=New collection
This.RestaurerHTTP_collection($nomFiltre; ->$c)
This.selection:=This.selection.query("ID IN :1"; $c)
This.length:=This.selection.length
// mettre les .collection de this et .dataClass en conformité avec la nouvelle sélection
This.collection:=This.selection.extract("ID")
This.dataClass.collection:=This.collection
End case
Function setEntités()
// créer la sélection (collection d'entités de this)
var $ID : Integer
This.selection:=New collection
Case of
: (This.DataClassNom="")
: (Not(OB Is defined(This; "collection")))
: (This.collection.length=0)
Else
For each ($ID; This.collection)
This.selection.push(cs[This.DataClassNom].new($ID))
End for each
This.length:=This.selection.length
End case
Function getRelatedEntity($chemin : Text)->$entité : Object
var $c : Collection
var $dataTexte; $lien : Text
// remonter le chemin $chemin de this
$dataTexte:=$chemin
If ($dataTexte="@_@")
$c:=Split string($dataTexte; "_")
// nom de l'attribut de l'end entité
$dataTexte:=$c.pop()
$entité:=This
For each ($lien; $c)
$entité:=$entité[$lien]
End for each
Else
$entité:=This
End if
// ----------------------
//MARK:HTML
// ----------------------
Function EcrireListeNoms($params : Object)->$result : Text
// renvoyer la liste des noms de la sélection this.collection
// on peut venir :
// d'une sélection de personne option 0 = 0
// d'une entité ayant ce nom,
var $texte : Text
var $c : Collection
$result:=""
$texte:=""
If (($params.Options ?? 0) | (This.selection.length>1))
$c:=This.selection.orderBy(ck ascending)
$texte:=$c.join(", ")
If ($params.Options ?? 1)
$texte:="("+$texte+")"
End if
// baliser
$result:="<"+$params.balise+">"+$texte+"</"+$params.balise+">"
End if
Function getEntréesRolodex($attribut : Text)
// créer les entités (classes 'SQL', sans les functions locales, plus rapide)
// lister les initiales non doublonnées des entités
//%W-533.1
This.selection:=This.dataClass.Créer().selection
This.entreesRolodex:=This.selection.extract($attribut).flatMap(Formula($1.value[[1]])).distinct().orderBy(ck ascending)
//%W+533.1
Function EcrireRolodex($nomRolodex : Text; $path : Text)->$result : Text
var $lettre; $urlLien : Text
$result:=""
For each ($lettre; This.entreesRolodex)
$urlLien:=This._tagUrl+$path+"?"+$lettre
If (Session.info.type="standalone")
$urlLien:=This.document["getURL"+$nomRolodex]()+Lowercase($lettre; *)+".html"
End if
$result:=$result+"<a href="+Char(Double quote)+$urlLien+Char(Double quote)+">"+$lettre+" </a>"
End for each
$result:=Char(1)+$result
Function CréerListeDeSélection()
// créer la collection des libellés de la sélection
var $entité; $formats : Object
This.selectionRecherche:=New collection
$formats:=New object("Options"; Num(vs4D="@private"); "params"; 1)
$formats:=New object("Options"; 3; "params"; 1)
If (This.selection.length>0)
For each ($entité; This.selection)
// ajouter le libellé / IDcodé de l'entité
This.selectionRecherche.push(New object("itemNom"; $entité.Libellé($formats); "IDcodé"; $entité.IDcodé()))
End for each
End if
Function CréerTableauHTML()->$result : Text
// renvoie la collection dans un tableau HTML
var $objet : Object
var $texte; $texteRef; $attribut : Text
If (This.selectionRecherche.length>0)
// créer le tableau
$result:=""
For each ($objet; This.selectionRecherche)
// ajouter un trait sous le texte
$texte:="<td><p style='margin:0px; padding:5px 10px 5px 5px; border-width:0px 0px 1px 0px; border-color:white; border-style:dashed'>"+$objet.itemNom+"</p></td>"
// ajouter le bouton de sélection
$texteRef:=String($objet.IDcodé)
$attribut:="id="+Char(Double quote)+$texteRef+Char(Double quote)
// paramètres de 'selectionnerPersonne' : elementHTML contenant les btn; IDcodé de l'objetBDD associé. Remarque : son parent contient tout élément HTML ayant une liste de btn (pour la RAZ)
$attribut:=$attribut+" onclick="+Char(Double quote)+"selectionnerPersonne(event.toElement.parentElement.parentElement.parentElement.parentElement.parentElement,'"+$texteRef+"')"+Char(Double quote)
$texte:=$texte+"<td><a class='btnSelect' style='padding:5px' "+$attribut+">"+"✓"+"</a></td>"
$result:=$result+"<tr>"+$texte+"</tr>"
End for each
Else
$result:="<tr><td>"+This.document.LireLocatedSTR(5001)+"</td></tr>"
End if
$result:="<table><tbody>"+$result+"</tbody></table>"
Function LibelléLié($url : Text; $formats : Object)->$result : Text
// écrire le btn
$result:="<a href="+Char(Double quote)+$url+Char(Double quote)+">"+This.Libellé($formats)+"</a>"
Function tagUrl()->$result : Text
// ----------------------
//MARK:Saisie
// -----------------------
Function addAttribut($attribut : Text; $valeur : Text; $type : Integer)->$result : Boolean
var $valeurEL : Integer
$result:=True
Case of
: ($type=Is text)
This[$attribut]:=$valeur
: ($type=Is boolean)
// les booléens des FORM sont codés 0 / 1, ici convertis en chaine
This[$attribut]:=($valeur="1")
: ($type=Is longint)
$valeurEL:=Num($valeur) // typé entier long
This[$attribut]:=$valeurEL
Else
// type non traité
$result:=False
End case
Function estEntitéVide()->$result : Boolean
// this est vide si aucune de ses données a été saisie
// this est vide si data ne contient que DataClassNom et ID (et type pour les events)
var $entité : Object
var $i : Integer
$entité:=OB Copy(This)
// supprimer l'entête (cf constructeur)
OB REMOVE($entité; "DataClassNom")
OB REMOVE($entité; "ID")
OB REMOVE($entité; "IDunique")
OB REMOVE($entité; "numTable")
// supprimer les données non saisissables
OB REMOVE($entité; "aQuiDataClassNom")
OB REMOVE($entité; "aQuiIDunique")
OB REMOVE($entité; "type")
OB REMOVE($entité; "dateNum")
OB REMOVE($entité; "heure")
// supprimer les valeurs saisissables nulles
ARRAY TEXT($tabNoms; 0)
OB GET PROPERTY NAMES($entité; $tabNoms)
For ($i; 1; Size of array($tabNoms))
Case of
: (OB Get type($entité; $tabNoms{$i})#Is text)
: ($entité[$tabNoms{$i}]#"")
Else
OB REMOVE($entité; $tabNoms{$i})
End case
Case of
: (OB Get type($entité; $tabNoms{$i})#Is real)
: ($entité[$tabNoms{$i}]#0)
Else
// pas saisi
OB REMOVE($entité; $tabNoms{$i})
End case
// remarque : le type booléen est saisissable mais ne peut être nul !
// supprimer les liens de structure, et attributs internes
Case of
: (OB Get type($entité; $tabNoms{$i})=Is collection)
OB REMOVE($entité; $tabNoms{$i})
: (OB Get type($entité; $tabNoms{$i})=Is object)
OB REMOVE($entité; $tabNoms{$i})
: ($tabNoms{$i}="_@")
OB REMOVE($entité; $tabNoms{$i})
End case
End for
// finalement
$result:=OB Is empty($entité)
Function FiltrerDonnéesSaisies($entitéBDD : Object)
// supprimer dans this.saisie les données saisies qui sont identiques aux données de $entitéBDD (BDD mère)
// la méthode est destructrice !
var $i : Integer
var $dataTexte; $texte : Text
var $entité : Object
var $c; $nonSaisi : Collection
$nonSaisi:=New collection("DataClassNom"; "ID"; "IDunique")
OB GET PROPERTY NAMES(This; $tabNoms)
For ($i; 1; Size of array($tabNoms))
$dataTexte:=$tabNoms{$i}
// au cas ou, résoudre les relations de classe
$entité:=$entitéBDD.getRelatedEntity($dataTexte)
$c:=Split string($dataTexte; "_")
// supprimer l'attribut du chemin
$texte:=$c.pop()
// ici on n'a plus que des chemins
// comparer this et $entité
// ici les attributs sont $dataTexte pour this (data saisie, c'est un chemin) et $texte pour $entitéBDD (objet du chemin $dataTexte dans $3->)
Case of
: ($nonSaisi.indexOf($dataTexte)>-1)
// virer ce qui n'est pas saisi
OB REMOVE(This; $dataTexte)
: (Not(OB Is defined($entité; $texte)))
// attribut inconnu dans la BDD, on le vire
OB REMOVE(This; $dataTexte)
: (This.AttributInchangé($dataTexte; $entité; $texte))
// attribut de la BDD non modifié, on le vire
OB REMOVE(This; $dataTexte)
Else
// on garde !
End case
// ici ne reste que des attributs modifiés par saisie (DataClassNom, ID, type sont partis)
End for
Function AttributInchangé($attribut : Text; $entitéBDD : Object; $attributBDD : Text)->$result : Boolean
// renvoie vrai si this[$attribut] = $entitéBDD[$attributBDD]
var $texte; $texteBDD : Text
$result:=True
Case of
: (Not(OB Is defined(This; $attribut)))
: (Not(OB Is defined($entitéBDD; $attributBDD)))
: (Value type(This[$attribut])=Is text)
$texte:=OB Get(This; $attribut; Is text)
// tester : des caractères \r et \n peuvent être ajoutés dans les champs saisie $attributBDD, ce qui fausse la comparaison des valeurs
$texte:=Replace string($texte; Char(Carriage return); "")
$texte:=Replace string($texte; Char(Line feed); "")
$texteBDD:=OB Get($entitéBDD; $attributBDD; Is text)
// tester : des caractères \r et \n peuvent être ajoutés dans les champs saisie $attributBDD, ce qui fausse la comparaison des valeurs
$texteBDD:=Replace string($texteBDD; Char(Carriage return); "")
$texteBDD:=Replace string($texteBDD; Char(Line feed); "")
$result:=($texte=$texteBDD)
: ((Value type(This[$attribut])=Is longint) | (Value type(This[$attribut])=Is real))
$result:=(OB Get(This; $attribut; Is longint)=OB Get($entitéBDD; $attributBDD; Is longint))
: (Value type(This[$attribut])=Is boolean)
$result:=(OB Get(This; $attribut; Is boolean)=OB Get($entitéBDD; $attributBDD; Is boolean))
End case
Function FixerQuoiAjout()->$result : Integer
// fixer le Quoi pour un éventuel ajout à la BDD
$result:=Choose(OB Is defined(This; "Quoi"); This.Quoi; -1)
Function Ajouter($quoi : Integer; $params : Object)->$result : Object
// ajouter $quoi à this
var $data; $entité : Object
$data:=This
$data.Quoi:=$quoi
// définir l'entité aQui
$data.aQuiDataClassNom:=This.DataClassNom
$data.aQuiIDunique:=This.IDunique
// définir l'entité Qui
$data.Qui:=Null
// faire l'ajout en BDD
$result:=This.AjouterDansDataStore($data)
// modifier ses attributs et ses liens
If ($result.success)
$entité:=$result.entitéAjoutée
$result:=$entité.Modifier($params)
$result.entitéAjoutée:=$entité
End if
// ----------------------
//MARK:Accès DataStore hôte
// -----------------------
Function AjouterDansDataStore($entité : Object)->$result : Object
// ajouter $entité à la BDD mère
var $params; $data : Object
var $Error : Integer
$result:=This.InitResult()
// à partir de $entité, fixer les données de l'ajout : quoi, aQui, Qui, $params
$params:=New object
// renseigner l'utilisateur courant
$params.UserID:=OB Copy(Session.storage.WebUser)
// autoriser le partage
$params.PartageALV:=201
// le contexte
$params.Contexte:=ALV Serveur HTTP
// il faut savoir à qui créer le $2
$params.aQui:=Null
$Error:=-15068
Case of
: ($result.Error#0)
: (Not(OB Is defined($entité; "aQuiDataClassNom")))
$result.ErrorDescription:="$entité.aQuiDataClassNom n'est pas défini"
: (Not(OB Is defined($entité; "aQuiIDunique")))
$result.ErrorDescription:="$entité.aQuiIDunique n'est pas défini"
Else
// c'est ok
$Error:=0
$params.aQui:=New object("DataClassNom"; $entité.aQuiDataClassNom; "IDunique"; $entité.aQuiIDunique)
// il faut savoir quoi ajouter
// $2 est une classe
$params.Quoi:=$entité.FixerQuoiAjout()
End case
$result.Error:=$Error
// il y a peut être un Qui ajouté
$params.Qui:=Null
Case of
: (Not(OB Is defined($entité; "QuiDataClassNom")))
// peut être normal
: (Not(OB Is defined($entité; "QuiIDunique")))
$result.Error:=-15068
$result.ErrorDescription:="$entité.QuiIDunique n'est pas défini"
Else
// c'est ok
$params.Qui:=New object("DataClassNom"; $entité.QuiDataClassNom; "IDunique"; $entité.QuiIDunique)
End case
// les paramètres
$params.Data:=OB Copy($entité)
$params.functionID:=EXT Ajouter A BDD
If ($result.Error=0)
$result:=Storage.Host.$dataStore.call().Modifier($params)
// passer en entité
$data:=$result.entitéAjoutée
If ($result.success)
If ($data=Null)
// cas où le Qui existe en BDD
Else
// nouvelle entité ajoutée
$result.entitéAjoutée:=cs[$data.DataClassNom].new($data.IDunique)
// ajouter l'entité aux données webables
cs.$filtrageDonnees.new().Ajouter($result.entitéAjoutée)
End if
End if
End if
This.trace.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event])
Function ModifierDansDataStore($entité : Object; $objet : Object)->$result : Object
// modification de l'entité en BDD $entité avec l'entité $objet
// $entité = Null : saisie de données, mais l'entité n'existe pas en BDD, la créer
// sinon, il y a eu modification(s) d'une entité de la BDD
// l'entité modifiée est retournée dans $result.entité
var $params; $data : Object
var $i : Integer
var $attribut : Text
$params:=New object
// renseigner l'utilisateur courant
$params.UserID:=OB Copy(Session.storage.WebUser)
// autoriser le partage
$params.PartageALV:=201
// le contexte
$params.Contexte:=ALV Serveur HTTP
$result:=This.InitResult()
// au cas où entité non modifiée
$result.entité:=OB Copy($entité)
// trouver les attributs saisis
$data:=OB Copy($objet)
Case of
: ($entité=Null)
// on n'a pas d'entité en BDD, ou erreur
: ($data.FiltrerDonnéesSaisies($entité))
: (OB Is empty($data))
: ($data=Null)
// pas d'attributs saisis (ça peut être normal)
Else
TRACE
// * modifier les attributs, il y a de la saisie
$params.functionID:=EXT Modifier BDD
// réduire $entité au strict minimum
$params.aQui:=New object("DataClassNom"; $entité.DataClassNom; "IDunique"; $entité.IDunique)
For ($i; 1; OB Keys($data).length)
$attribut:=OB Keys($data)[$i-1]
$params.SaisieData:=New object("attribut"; $attribut; "valeurAttribut"; $objet[$attribut]; "typeValeur"; Value type($objet[$attribut]))
$result:=Storage.Host.$dataStore.call().Modifier($params)
End for
// on a reçu aQui qui a été modifié : repasser en entité locale
If ($result.success)
$result.entité:=cs[$params.aQui.DataClassNom].new($params.aQui.IDunique)
End if
End case
This.trace.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event])
Function LierDansDataStore($data : Object)->$result : Object
var $params : Object
// tout est dans $data
$params:=OB Copy($data)
$params.functionID:=EXT Lier dans BDD
// renseigner l'utilisateur courant
$params.UserID:=OB Copy(Session.storage.WebUser)
// autoriser le partage
$params.PartageALV:=201
// le contexte
$params.Contexte:=ALV Serveur HTTP
$result:=Storage.Host.$dataStore.call(Null).Modifier($params)
⇧
[class]Communes - 06/06/2026 15:31:07
property leDepartement : cs.Departements
// attributs de la classe
property nom : Text
property blason : Picture
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Communes"; $IDentité)
// ----------------------
//MARK:HTML
// ----------------------
Function LibelléLié($formats : Object)->$result : Text
var $url : Text
$url:=""
$result:=Super.LibelléLié($url; $formats)
Function LibelléLiéSurNom($formats : Object)->$result : Text
var $url : Text
$url:=This.URLlienSurNom($formats)
$result:="<p>"
$result:=$result+Super.LibelléLié($url; New object("Options"; 0x0000))
// ajouter le libellé du département
$result:=$result+"<span> "+This.Le("Departements").Libellé($formats)+"</span>"
$result:=$result+"</p>"
Function LibelléLiéSurEvent($formats : Object)->$result : Text
var $url : Text
$url:=This.URLlienSurNom($formats)
$result:=Super.LibelléLié($url; $formats)
Function URLlienSurNom($formats : Object)->$result : Text
If (Session.info.type="standalone")
// cas STATIC
$result:=This.Libellé($formats)
$result:=This.document.getURLetatcivil()+Lowercase($result[[1]]; *)+"/"+This.hrefHTML()+".html"
Else
$result:=This._tagUrl+"WebLISTE/AfficherLaCommune?"+This.hrefHTML()
End if
Function hrefHTML()->$result : Text
// ID de this dans un lien HTML
$result:=This.IDunique
// ----------------------
//MARK:Wappers
// ----------------------
Function LesEvents()->$result : cs.EventsSelect
// créer la sélection des events liés à la commune
var $c : Collection
$c:=This.dataClass.LesEvents()
$result:=cs.EventsSelect.new($c)
$result.Créer()
// filtrer les events webables
$result.FiltrerSurID("HTTP_Events")
Function LesMedias()->$result : cs.MediasSelect
// chercher les medias de la commune :
var $c : Collection
$c:=This.dataClass.LesMedias()
$result:=cs.MediasSelect.new($c)
$result.Créer()
// filtrer les medias webables
$result.FiltrerSurID("HTTP_Medias")
// filtrer les medias privés
$result.FiltrerLesPrivés()
Function LieuParDefaut()->$result : cs.Lieux
var $ID : Integer
$result:=Null
$ID:=This.dataClass.LieuParDefaut()
If ($ID>0)
$result:=cs.Lieux.new($ID)
End if
// ----------------------
//MARK:PageHTML
// ----------------------
Function Informations()->$result : Text
var $sessionStorage : Object
var $path : Text
var $sélection : Collection
$sessionStorage:=This.getStorage()
// titre : nom de this
$result:="<h1>"+This.nom+" "+This.Le("Departements").Libellé(New object("Options"; 0x00C90000))+"</h1>"
// le tableau des vignettes medias de this
$result:=$result+$sessionStorage.UserParams.MediasSelect.EcrireTableauVignettes()
// données de la commune
$result:=$result+"<table><tbody><tr>"
// * ajouter le blason
// URL du blason
$path:=This.document.getHostMediaPath("URLIcons"; This; New object("attribute"; ""))
// ajouter l'image
$result:=$result+"<td>"+"<img src="+Char(Double quote)+$path+Char(Double quote)+" alt="+Char(Double quote)+"blason_"+String(This.ID)+Char(Double quote)+"/>"+"</td>"
// ajouter les nombres d'events
$sélection:=$sessionStorage.UserParams.EventsSelect.selection
$result:=$result+"<td>"
$result:=$result+This.EcrireNombreEvents(New object("nombre"; $sélection.query("type = :1"; 22000).length; "libellé"; "naissance<plur> connue<plur>"))
$result:=$result+This.EcrireNombreEvents(New object("nombre"; $sélection.query("type = :1"; 22100).length; "libellé"; "décès connu<plur>"))
$result:=$result+This.EcrireNombreEvents(New object("nombre"; $sélection.query("type >= :1 and type <= :2"; 33600; 33699).length; "libellé"; "mariage<plur> connu<plur>"))
// ajouter les patronymes trouvés
$result:=$result+This.EcrirePatronymes()
// c'est fini
$result:=$result+"</td>"
$result:=$result+"</tr></tbody></table>"
Function EcrireNombreEvents($params : Object)->$result : Text
var $texte : Text
$texte:=Replace string($params.libellé; "<plur>"; Choose($params.nombre>1; "s"; ""); *)
$result:="<p><span>"
If ($params.nombre=0)
$result:=$result+"Pas de "+$texte
Else
$result:=$result+String($params.nombre)+" "+$texte
End if
$result:=$result+"</span></p>"
Function EcrirePatronymes()->$result : Text
var $patronymes : cs.DicoDesNomsSelect
var $sessionStorage : Object
$sessionStorage:=This.getStorage()
$patronymes:=$sessionStorage.UserParams.EventsSelect.LesProtagonistes().LesPatronymes()
$result:=$patronymes.Ecrire()
// ----------------------
//MARK:Saisie
// -----------------------
Function Modifier($params : Object)->$result : Object
// ici, voir si la commune n'a pas été modifiée
var $data : Object
$result:=This.InitResult()
// nouveaux attributs?
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_nom")))
: (This.nom=$params.leLieu_leSite_laCommune_nom)
Else
$data:=OB Copy(This)
$data.nom:=$params.leLieu_leSite_laCommune_nom
$result:=This.ModifierDansDataStore(This; $data)
End case
// si nouveau département, le créer
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_numero")))
// saisie incomplète (valeur nulle, en principe virée précédemment)
$result:=This.InitResult(-16402; "le numero n'est pas saisi"; False)
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_IDnumero")))
// pas trop normal
$result.Error:=-15068
$result.ErrorDescription:="$params.leLieu_leSite_laCommune_leDepartement_IDnumero n'est pas défini"
: ($params.leLieu_leSite_laCommune_leDepartement_numero=$params.leLieu_leSite_laCommune_leDepartement_IDnumero)
// la commune est accrochée au bon endroit
Else
// créer le département
// les données de la commune sont dans l'entité saisie $params
$result:=This.Ajouter(WEB Ajouter Département; $params)
End case
$result.success:=($result.Error=0)
// ----------------------
//MARK:Maintenance
// ----------------------
Function CréerVersionWebable($params : Object)->$pict : Picture
var $data : Object
$pict:=This.blason
If (Picture size($pict)=0)
READ PICTURE FILE(Folder(Get 4D folder(Current resources folder); fk platform path).folder("Images").folder("HTML").file("16306.png").platformPath; $pict)
End if
// * créer son imagette Webinée
$data:=New object
$data.largeur:=Num(Web Icon largeur) // largeur max de l'imag
$data.hauteur:=Num(Web Icon hauteur) // hauteur max de l'image
cs.Medias.new().RetaillerImage(->$pict; $data)
⇧
[class]$formulaire - 31/05/2025 17:08:09
property params : Object
property userMessageText : Text
property userMessageTime : Integer
property grandEcran; mémoTaille : Boolean
Class extends $composant
Class constructor($data : Object)
var $i; $entierLong : Integer
var $texte : Text
var $bool : Boolean
Super()
This.params:=New object // peut servir
// gestion d'un user message, à disposition d'un Form
// (réellement affiché si un objet FORM a pour variable Form.userMessageText)
This.userMessageText:=""
This.userMessageTime:=0
// données standard pour tout formulaire
This.grandEcran:=False
This.mémoTaille:=True
// paramètres reçus, peuvent écraser les init standard
Case of
: (Count parameters=0)
: ($data=Null)
Else
// recopier les données reçues
// recopier les attributs de $data
ARRAY TEXT($tabNoms; 0)
ARRAY LONGINT($tabTypes; 0)
OB GET PROPERTY NAMES($data; $tabNoms; $tabTypes)
For ($i; 1; Size of array($tabNoms))
// garder le typage des données
Case of
: ($tabTypes{$i}=Is boolean)
$bool:=$data[$tabNoms{$i}]
This[$tabNoms{$i}]:=$bool
: ($tabTypes{$i}=Is real)
$entierLong:=$data[$tabNoms{$i}]
This[$tabNoms{$i}]:=$entierLong
: ($tabTypes{$i}=Is text)
$texte:=$data[$tabNoms{$i}]
This[$tabNoms{$i}]:=$texte
: ($tabTypes{$i}=Is object)
This[$tabNoms{$i}]:=$data[$tabNoms{$i}]
: ($tabTypes{$i}=Is collection)
This[$tabNoms{$i}]:=$data[$tabNoms{$i}]
: ($tabTypes{$i}=Is null)
This[$tabNoms{$i}]:=Null
End case
End for
End case
Function AfficherMessageUtilisateur($params : Object)
// le paramètre est optionnel
var $durée : Integer
// time-out du message = dans 15 secondes
$durée:=(15*60)+Tickcount
Case of
// afficher un message
: (OB Is defined($params; "ID"))
This.userMessageText:=This.document.LireLocatedSTR($1.ID)
This.userMessageTime:=$durée
: (OB Is defined($params; "libelle"))
This.userMessageText:=$params.libelle
This.userMessageTime:=$durée
End case
Function EffacerMessageUtilisateur()
This.userMessageText:=""
This.userMessageTime:=0
Function surEvenementFormulaire()
var $cadence : Integer:=0
Case of
: (Form event code=On Load)
// active l'évènement formulaire "sur Minuteur" (effectif si coché dans le formulaire)
// appel une seule fois dans le process, ou quand la wnd revient au premier plan
This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/RefreshTime"; Is longint; ->$cadence)
SET TIMER($cadence)
: (Form event code=On Timer)
This.AfficherMessageUtilisateur()
: (Form event code=On Unload)
SET TIMER(0)
End case
// ----------------------
//MARK:Demande actions
// -----------------------
Function MettreAjourPage($params : Object)
Case of
: ($params.ActionID="AfficherMessageUtilisateur")
This.AfficherMessageUtilisateur($params)
: ($params.ActionID="EffacerMessageUtilisateur")
This.EffacerMessageUtilisateur()
End case
⇧
[class]$pageWebSAISIE - 29/05/2025 19:13:43
property Personne : cs.Personnes
property Event : cs.Events
property Union : cs.Unions
property EntitésDuFormulaire : Collection
property texte_bidon : Text:=""
Class extends $pageWeb
Class constructor()
Super()
//----------------------------------
// MARK:Element HTML
//----------------------------------
Function EcrirePersonne()
// initialiser les variables / données des nom et prénom de this
// "name" est le nom de la variable qui reçoit la valeur de la variable lors du submit
var $Xpath; $ElémentXML; $pathSaisie : Text
This.InitStructureXML("saisiePersonne")
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
// *** écrire le UUID de personne (caché)
$pathSaisie:="Personnes?"+String(This.Personne.ID)+"?IDunique"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; This.Personne.IDunique)
$pathSaisie:="Personnes?"+String(This.Personne.ID)+"?nom"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p/label"; "class"; "saisiePreposition"; "for"; $pathSaisie)
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(Num("0"))+This.document.LireLocatedSTR(6))
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"input"; "class"; "saisieNom"; "value"; This.Personne.nom; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "placeholder"; "Dup@"; "size"; "30")
$pathSaisie:="Personnes?"+String(This.Personne.ID)+"?prenom"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p[2]/label"; "class"; "saisiePreposition"; "for"; $pathSaisie)
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(3))
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"input[2]"; "class"; "saisieNom"; "value"; This.Personne.prenom; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "placeholder"; "Je@"; "size"; "30")
This.result.resultat:=Char(1)+This.ExporterStructureXML()
Function EcrireSexe()
// initialiser les variables / données du sexe de this
var $ElémentXML; $EnfantXML; $Xpath; $pathSaisie : Text
This.InitStructureXML("saisie_20003")
// créer la sélection de sexe
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$pathSaisie:="Personnes?"+String(This.Personne.ID)+"?sexe"+"?"+String(Is boolean)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"label"; "class"; "saisiePreposition"; "for"; $pathSaisie)
DOM SET XML ELEMENT VALUE($ElémentXML; "sexe")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"select"; "id"; $pathSaisie+"list"; "name"; $pathSaisie)
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; "0")
// homme
If (This.Personne.sexe=False)
DOM SET XML ATTRIBUTE($EnfantXML; "selected"; "selected")
End if
DOM SET XML ELEMENT VALUE($EnfantXML; This.document.LireLocatedSTR(8))
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; "1")
// femme
If (This.Personne.sexe=True)
DOM SET XML ATTRIBUTE($EnfantXML; "selected"; "selected")
End if
DOM SET XML ELEMENT VALUE($EnfantXML; This.document.LireLocatedSTR(9))
This.result.resultat:=Char(1)+This.ExporterStructureXML()
Function EcrireEventPersonnel()
This.InitStructureXML("SaisieEvenement")
// lire l'event demandé
This.getEvent()
// créer l"élement HTML
This.EcrireEvent()
This.result.resultat:=Char(1)+This.ExporterStructureXML()
Function EcrireEventFamilial()
var $Personne : cs.Personnes
var $UnionsSelect : cs.UnionsSelect
var $Union : cs.Unions
var $texte : Text
$Personne:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
$UnionsSelect:=$Personne.LesUnions()
$texte:=""
If ($UnionsSelect.selection.length>0)
For each ($Union; $UnionsSelect.selection)
// chercher date / lieu du mariage, rappel : il n'y en a qu'un (civil ou religieux, selon)
If (Not($Union.leEvent=Null))
// écrire le mariage de l'union $entité
This.InitStructureXML("SaisieEvenement")
This.Event:=$Union.leEvent
This.EcrireEvent()
$texte:=$texte+This.ExporterStructureXML()
End if
// écrire le conjoint associé à l'union $entité
This.InitStructureXML("SaisieConjoint")
This.Union:=$Union
This.EcrireConjoint($Personne)
//$texte:=$texte+$entité.champsConjoint($params)
$texte:=$texte+This.ExporterStructureXML()
End for each
End if
This.result.resultat:=Char(1)+$texte
Function EcrireEvent()
// initialiser les NomClass? et wwwFormData? de [events]
// rang = 1 (date), rang = 4 (UUIDcommune), rang = 5 (commentaire)
var $RacineXML; $ElémentXML; $Xpath; $pathSaisie; $path; $EnfantXML : Text
var $comment; $texte; $soustexte : Text
var $classeNom; $classeUUID; $classePath : Collection
var $sélection; $entité : Object
// commentaire BDD de l'event (cumul dynamique d'informations)
$comment:=""
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$RacineXML:=DOM Create XML element(This.RacineXML; $Xpath+"div"; "class"; "saisieEvent")
$Xpath:="div/"
// *** écrire le UUID de event (caché)
$pathSaisie:="Events?"+String(This.Event.ID)+"?IDunique"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; This.Event.IDunique)
// *** écrire le type d'event (caché)
$pathSaisie:="Events?"+String(This.Event.ID)+"?type"+"?"+String(Is longint)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; String(This.Event.type))
// *** écrire le aQui (caché)
$pathSaisie:="Events?"+String(This.Event.ID)+"?aQuiDataClassNom"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; This.Personne.DataClassNom)
$pathSaisie:="Events?"+String(This.Event.ID)+"?aQuiIDunique"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; String(This.Personne.IDunique))
// *** écrire le champ date event
// le libellé
$pathSaisie:="Events?"+String(This.Event.ID)+"?dateChaine"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"label"; "class"; "saisieLabel"; "for"; $pathSaisie)
// le libellé peut être genré
DOM SET XML ELEMENT VALUE($ElémentXML; This.Event.Libellé(New object("Options"; 0x3000))+This.document.LireLocatedSTR(32))
// date de l'event
$texte:=""
$texte:=This.Event.dateChaine
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "class"; "saisieDate"; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; $texte; "placeholder"; "date, heure...")
// *** écrire le lieu de l'event
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$RacineXML:=DOM Create XML element(This.RacineXML; $Xpath+"div[2]"; "class"; "saisieEvent")
$Xpath:="div/"
// name des éléments = nom classe / IDunique / chemin de l'attribut / type attribut
// remarque : le "." comme séparateur d'attributs (de classées liées) est trompeur
// exemple : x = "leLieu.LeSite.nom" et this[x]
// x est considéré comme un nom d'attribut de this ; on ne remonte pas à la classe site
// pour éviter les confusions, on met un séparateur non ambigû
$classeNom:=New collection
$classeNom.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom"+"?"+String(Is text))
$classeNom.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_numero"+"?"+String(Is longint))
$classeNom.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_nom"+"?"+String(Is text))
$classeUUID:=New collection
$classeUUID.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDunique"+"?"+String(Is text))
$classeUUID.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_IDunique"+"?"+String(Is text))
$classeUUID.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_IDunique"+"?"+String(Is text))
$classePath:=New collection
$classePath.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDnom"+"?"+String(Is text))
$classePath.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_leDepartement_IDnumero"+"?"+String(Is longint))
$classePath.push("Events?"+String(This.Event.ID)+"?leLieu_leSite_laCommune_IDnom"+"?"+String(Is text))
//
// ** zone pour sélection pays :
//
$path:=String(This.Event.type+6)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"label"; "class"; "saisieLabelEvent"; "for"; "wwwFormData_"+$path+"list")
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(173))
// * sélection nom pays
$texte:=This.Event.leLieu.leSite.laCommune.leDepartement.laRegion.lePays.nom
// écrire la liste de valeurs associées
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"select"; "class"; "selectPays"; "id"; "wwwFormData_"+$path+"list"; "onchange"; "combo(this, '"+$classeNom[0]+"', '"+$classeUUID[0]+"', '"+$classePath[0]+"');listerDepartementsDuPays(this, wwwFormData_"+String(This.Event.type+2)+"list);comboRAZ('wwwFormData_"+String(This.Event.type+3)+"list', '"+$classeNom[0]+"', '"+$classeUUID[0]+"', '"+$classePath[0]+"')")
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; "-3") // pas de sélection par défaut
DOM SET XML ELEMENT VALUE($EnfantXML; " ")
// lister tous les pays
$sélection:=cs.PaysSelect.new()
$sélection.CréerTousLesPays()
// écrire la liste
For each ($entité; $sélection.selection)
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; $entité.ID; "id"; $entité.IDunique)
If ($entité.nom=$texte)
DOM SET XML ATTRIBUTE($EnfantXML; "selected"; "selected")
End if
DOM SET XML ELEMENT VALUE($EnfantXML; $entité.nom)
End for each
// ** zone pour saisie pays :
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"label[2]"; "class"; "saisiePreposition"; "for"; $classeNom[0])
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(55))
// * saisie du nom du pays
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "class"; "saisiePays"; "id"; $classeNom[0]; "name"; $classeNom[0]; "value"; $texte; "placeholder"; "Pays"; "onfocus"; "comboRAZ('wwwFormData_"+String(This.Event.type+6)+"list');listerDepartementsDuPays(this,"+"wwwFormData_"+String(This.Event.type+2)+"list);comboRAZ('wwwFormData_"+String(This.Event.type+3)+"list')")
// *** écrire le IDunique du pays (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classeUUID[0]; "name"; $classeUUID[0]; "value"; This.Event.leLieu.leSite.laCommune.leDepartement.laRegion.lePays.IDunique)
// *** écrire le IDnom du pays (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classePath[0]; "name"; $classePath[0]; "value"; This.Event.leLieu.leSite.laCommune.leDepartement.laRegion.lePays.nom)
//
// ** zone pour sélection département / commune :
//
$path:=String(This.Event.type+2)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"label[3]"; "class"; "saisieLabelEvent"; "for"; "wwwFormData_"+$path+"list")
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(33))
// * sélection ID département
// écrire la liste de valeurs associées
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"select"; "class"; "selectDepartement"; "id"; "wwwFormData_"+$path+"list"; "onchange"; "combo(this, '"+$classeNom[1]+"', '"+$classeUUID[1]+"', '"+$classePath[1]+"');listerCommunesDuDepartement(this, wwwFormData_"+String(This.Event.type+3)+"list);comboRAZ('wwwFormData_"+String(This.Event.type+3)+"list')")
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; "-3") // pas de sélection par défaut
DOM SET XML ELEMENT VALUE($EnfantXML; " ")
// chercher les départements du pays
$sélection:=cs.Pays.new(This.Event.leLieu.leSite.laCommune.leDepartement.laRegion.lePays.ID).LesDepartements()
// écrire la liste
For each ($entité; $sélection.selection)
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; $entité.ID; "id"; $entité.IDunique)
If ($entité.ID=This.Event.leLieu.leSite.laCommune.leDepartement.ID)
DOM SET XML ATTRIBUTE($EnfantXML; "selected"; "selected")
End if
DOM SET XML ELEMENT VALUE($EnfantXML; String($entité.numero))
End for each
// * sélection nom commune
$path:=String(This.Event.type+3)
$texte:=""
$texte:=This.Event.leLieu.leSite.laCommune.IDunique
// écrire la liste de valeurs associées
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"select"; "class"; "selectCommune"; "id"; "wwwFormData_"+$path+"list"; "onchange"; "combo(this, '"+$classeNom[2]+"', '"+$classeUUID[2]+"', '"+$classePath[2]+"')")
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; "-3") // pas de sélection par défaut
DOM SET XML ELEMENT VALUE($EnfantXML; " ")
// lister les communes du départements
$sélection:=cs.Departements.new(This.Event.leLieu.leSite.laCommune.leDepartement.ID).LesCommunes()
// écrire la liste
For each ($entité; $sélection.selection)
$EnfantXML:=DOM Create XML element($ElémentXML; "option"; "value"; $entité.ID; "id"; $entité.IDunique)
If ($entité.IDunique=$texte)
DOM SET XML ATTRIBUTE($EnfantXML; "selected"; "selected")
End if
DOM SET XML ELEMENT VALUE($EnfantXML; $entité.nom)
End for each
// ** zone pour saisie commune :
$path:=String(This.Event.type+2)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"label[4]"; "class"; "saisiePreposition"; "for"; "wwwFormData_"+$path)
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(55))
// * saisie du numéro du département
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "class"; "saisieDepartement"; "type"; "number"; "id"; $classeNom[1]; "name"; $classeNom[1]; "value"; This.Event.leLieu.leSite.laCommune.leDepartement.numero; "placeholder"; "n° dép."; "onfocus"; "comboRAZ('wwwFormData_"+String(This.Event.type+2)+"list');listerCommunesDuDepartement(this,"+"wwwFormData_"+String(This.Event.type+3)+"list)")
// *** écrire le IDunique du département (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classeUUID[1]; "name"; $classeUUID[1]; "value"; This.Event.leLieu.leSite.laCommune.leDepartement.IDunique)
// *** écrire le IDnumero du département (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classePath[1]; "name"; $classePath[1]; "value"; This.Event.leLieu.leSite.laCommune.leDepartement.numero)
// * saisie du nom de la commune
$path:=String(This.Event.type+3)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "class"; "saisieCommune"; "type"; "text"; "id"; $classeNom[2]; "name"; $classeNom[2]; "value"; This.Event.leLieu.leSite.laCommune.nom; "placeholder"; "nom commune"; "onfocus"; "comboRAZ('wwwFormData_"+$path+"list')")
// *** écrire le IDunique de la commune (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classeUUID[2]; "name"; $classeUUID[2]; "value"; This.Event.leLieu.leSite.laCommune.IDunique)
// *** écrire le IDnom de la commune (caché)
$EnfantXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "type"; "hidden"; "id"; $classePath[2]; "name"; $classePath[2]; "value"; This.Event.leLieu.leSite.laCommune.nom)
// *** écrire les champs commentaire
$texte:=This.Event.commentaire
$soustexte:=This.Event.source
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$RacineXML:=DOM Create XML element(This.RacineXML; $Xpath+"div[3]"; "class"; "saisieEvent")
$Xpath:="div/"
$path:=String(This.Event.type+7)
$pathSaisie:="Events?"+String(This.Event.ID)+"?source"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"input"; "class"; "saisieComment"; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; $soustexte; "placeholder"; "Sources information...")
$path:=String(This.Event.type+5)
$pathSaisie:="Events?"+String(This.Event.ID)+"?commentaire"+"?"+String(Is text)
$ElémentXML:=DOM Create XML element($RacineXML; $Xpath+"textarea"; "class"; "saisieComment"; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "value"; $texte; "placeholder"; "Témoins, parrainage, sources...")
If ($texte="")
// pb quand $comment est vide : la balise textarea ne se ferme pas. Dans ce cas mettre un texte bidon et le supprimer après récupération du texte brut
// début verrue
DOM SET XML ELEMENT VALUE($ElémentXML; "texte_bidon")
Else
DOM SET XML ELEMENT VALUE($ElémentXML; $texte)
End if
Function getEvent()
// fixe l'évènement personnel de type This.paramsUrl[0]
var $c : Collection
var $type : Integer
Case of
: (This.paramsUrl.length=0)
: (This.Personne=Null)
// pas normal
Else
$type:=Num(This.paramsUrl[0])
End case
// est ce que l'event existe?
$c:=This.Personne.lesEvents.selection.query("type = :1"; $type)
If ($c.length>0)
This.Event:=$c[0]
Else
// event inexistant ; en crée un vierge (pour gérer l'affichage de la page)
This.Event:=cs.xSQL.Events.new(-1)
This.Event.type:=$type
This.Event.genre:=This.Personne.sexe
End if
Function EcrireConjoint($Personne : cs.Personnes)
// renoyer le conjoint de $IDpersonne
var $entité : Object
var $Xpath; $ElémentXML : Text
$entité:=This.Union.getLeConjoint($Personne.ID)
If (Not($entité=Null))
//l'entité personnes $2
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p")
// sait pas faire autrement ; début verrue
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR(1013)+" texte_bidon") // bof !!!
This.texte_bidon:="<span>"+$entité.Libellé(New object("Options"; 0x0007))+"</span>"
End if
Function EcrireCommentaire()
var $ElémentXML; $Xpath; $path; $pathSaisie : Text
This.InitStructureXML("saisie_20005")
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$path:="wwwFormData_20005"
$pathSaisie:="Commentaires+?"+String(-Random)+"+?comment"+"+?"+String(Is text)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"div/p/label"; "class"; "saisieLabel"; "for"; $path)
DOM SET XML ELEMENT VALUE($ElémentXML; "Autres informations :")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"div/textarea"; "class"; "saisieComment"; "id"; $pathSaisie; "name"; $pathSaisie; "placeholder"; "Commentaires sur la saisie…")
// pb la balise textarea ne se ferme pas avec un texte nul. Dans ce cas mettre un texte bidon et le supprimer après récupération du texte brut
DOM SET XML ELEMENT VALUE($ElémentXML; "texte_bidon")
This.texte_bidon:=""
This.result.resultat:=Char(1)+This.ExporterStructureXML()
//----------------------------------
// MARK:Submit
//----------------------------------
Function SoumettreFormulaire()
// gère tous les submit de la saisie
// récupérer les données du formulaire
This.LireHTTPvars()
// exécuter le submit
Case of
: (Session.storage.HTTPvars=Null)
: (Session.storage.HTTPvars.length=0)
: (OB Is defined(Session.storage.HTTPvars; "wwwBtnSubmit"))
Case of
: (Session.storage.HTTPvars.wwwBtnSubmit="Annuler")
This.AnnulerSaisie()
: (Session.storage.HTTPvars.wwwBtnSubmit="Valider")
This.ValiderSaisie()
End case
End case
Function AnnulerSaisie()
// on a cliqué sur le btn annuler de formulaire Saisie
var $entité : Object
// retour à la personne saisie
$entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
This.Rediriger($entité.UrlDuLien("Web/AfficherArbre"))
Function ValiderSaisie()
// on a cliqué sur le btn ok de formulaire Saisie
var $entité : Object
This.Modifier()
// retour à la personne saisie
$entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
This.Rediriger($entité.UrlDuLien("Web/AfficherArbre"))
Function Modifier()
var $entité; $entitéBDD; $objet; $result : Object
// on a modifié une personne, éventuellement les events, éventuellement ajout d'évents
// *** rechercher les entités du formulaire saisie -> This.EntitésDuFormulaire
This.ConstruireEntitésDuFormulaire()
// *** lancer les modifications dans la BDD mère
// entité courante
$entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
For each ($objet; This.EntitésDuFormulaire)
// $objet = données saisies de this
Case of
: (OB Is empty($objet))
: ($objet.estEntitéVide())
Else
// chercher l'entité dans la BDD qui correspond à l'entité du formulaire $objet
$entitéBDD:=$entité.getEntité($objet)
// remarque : si elle n'existe pas, la créer
// astuce : utiliser $entité comme porte d'entrée de _WEB_DataStore
If ($entitéBDD=Null)
$result:=$entité.AjouterDansDataStore($objet)
$entitéBDD:=$result.entitéAjoutée
End if
// modifier $entitéBDD avec les données saisies $objet
// * nouveaux attributs?
$result:=$entité.ModifierDansDataStore($entitéBDD; $objet)
// * des liens modifiés?
$result:=$entitéBDD.Modifier($objet)
End case
End for each
Function ConstruireEntitésDuFormulaire()
// balayer toutes les HTTPvar et créer la collection des entités saisies (pseudo classes personne et events)
var $i : Integer
var $entité : Object
This.EntitésDuFormulaire:=New collection
ARRAY TEXT($tableauDeNoms; 0)
ARRAY TEXT($tableauDeValeurs; 0)
// les variables récupérées correspondent à des objets de formulaire Web ayant un attribut "name"
WEB GET VARIABLES($tableauDeNoms; $tableauDeValeurs)
For ($i; 1; Size of array($tableauDeNoms))
// filtrer les valeurs non saisie (vides)
If ($tableauDeValeurs{$i}#"")
// une donnée existe ; quelle est son entité?
This.Descripteur:=Split string($tableauDeNoms{$i}; "?")
$entité:=This.CréerEntitéSurDescripteur()
// lui ajouter l'attribut (typé !)
// rappel : this.Descripteur est du type [ DataClassNom ; IDentité ; nomAttribut ; typeValeurAttribut ]
Case of
: ($entité=Null)
: ($entité.addAttribut(This.Descripteur[2]; $tableauDeValeurs{$i}; Num(This.Descripteur[3])))
// ok
Else
// pas reconnu !
// en particulier les submit
End case
End if
End for
Function CréerEntitéSurDescripteur()->$result : Object
// rechercher dans la collection d'entités saisie (This.EntitésModifiées) celle décrite par this.Descripteur
// si non trouvée, créer l'entité saisie et l'ajouter à la collection
// renvoyer l'entité trouvée (peut être NULL)
var $c : Collection
var $sélection : Collection
$result:=Null
$c:=This.Descripteur
// rappel : this.Descripteur est du type [ DataClassNom ; IDentité ; nomAttribut ; typeValeurAttribut ]
Case of
: ($c.length<2)
// descripteur incomplet
$sélection:=New collection
Else
$sélection:=This.EntitésDuFormulaire.query("DataClassNom = :1 and ID = :2"; $c[0]; Num($c[1]))
// ici on a une classe cs
End case
Case of
: ($c.length=0)
: ($sélection.length=0)
// créer la classe
Case of
: ($c[0]="Personnes")
$result:=cs[$c[0]].new(Num($c[1]))
// ici new() renvoie un ID négatif, mettre le nôtre
$result.ID:=Num($c[1])
// optimisation
$result.lesEvents:=$result.LesEvents()
: ($c[0]="Events")
$result:=cs.Events.new(Num($c[1]))
// ici new() renvoie un ID négatif, mettre le nôtre
$result.ID:=Num($c[1])
End case
// ajouter à la collection
This.EntitésDuFormulaire.push($result)
Else
// renvoyer la classe déjà créée
$result:=$sélection[0]
End case
// ----------------------
//MARK:Utilitaires XML
// -----------------------
Function InitStructureXML($nomClass : Text)
This.RacineXML:=DOM Create XML Ref("article")
DOM SET XML ATTRIBUTE(This.RacineXML; "class"; $nomClass)
// récupérer l'entité courante de 'Personnes'
This.Personne:=Session.storage.UserParams.Personnes
Function ExporterStructureXML()->$result : Text
var $datatexte : Text
DOM EXPORT TO VAR(This.RacineXML; $datatexte)
DOM CLOSE XML(This.RacineXML)
// terminer la verrue
$datatexte:=Replace string($datatexte; "texte_bidon"; This.texte_bidon)
$result:=This.Nettoyer($datatexte)
Function Nettoyer($texte : Text)->$result : Text
$result:=Substring($texte; Position("<"; $texte; 2; *))
$result:=Replace string($result; "\r\r"; "")
⇧
[class]$pageWebITEM - 06/06/2026 15:32:20
property URL : Text
Class extends $pageWeb
Class constructor()
Super()
Function LireSTR()
var texte2 : Text:=""
This.result.resultat:="#err LireSTR"
If (This.paramsUrl.length>0)
// le nom de l'apps peut être utilisé dans les chaines
This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->texte2)
// il faut toujours au moins 2 éléments ; au cas où un seul élément, ajouter des options vides
This.paramsUrl.push("")
This.result.resultat:=This.document.LireLocatedSTR(Num(This.paramsUrl[0]); New object("genre"; Position("féminin"; This.paramsUrl[1]; *)>0; "plur"; Position("pluriel"; This.paramsUrl[1]; *)>0))
End if
This.result.resultat:=Char(1)+This.result.resultat
Function UserNomComplet()
var $options : Integer
$options:=0x000B
This.result.resultat:=Char(1)+This.UserID($options)
Function UserPrenom()
var $options : Integer
$options:=0x0002
This.result.resultat:=Char(1)+This.UserID($options)
Function UserID($options : Integer)->$result : Text
var $entité; $formats : Object
$result:=""
If (Not(Session.isGuest()))
$entité:=cs.UtilisateursALV.new(Session.userName)
$formats:=OB Copy(Session.storage.WebUserPrefs.Apparence)
$formats.Options:=$options
$result:=$entité.Libellé($formats)
End if
Function URLprofil()
var $texte : Text
$texte:="<a href="+Char(Double quote)+"/4DGCI/Web/Connecter#openUserProfil"+Char(Double quote)+"><span>"+This.document.LireLocatedSTR(71)+"</span></a>"
This.result.resultat:=Char(1)+$texte
Function AppDate()
var $path; $dateChaine : Text
var $texte : Text:=""
var $dataTexte : Text:=""
var $date : Date:=!00-00-00!
This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$texte)
Case of
: (Session.info.type="standalone")
// cas STATIC ici il faut lire directement la date du fichier de données
This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$dataTexte)
$path:=Get 4D folder(Data folder; *)+$dataTexte+".4DD"
$date:=File($path; fk platform path).modificationDate
$dateChaine:=String($date; Internal date long)
: (Not(This.rsc.SetVariable(Est Ressource APP; "Versionnage/Data/date"; Is date; ->$date)))
$dateChaine:=String(Year of($date))+" - "+String(Year of(Current date))
Else
// date par défaut
$dateChaine:=String(Current date; Internal date long)
End case
This.result.resultat:=Char(1)+$texte+" "+$dateChaine
Function urlServeurWeb()
var $texte : Text:=""
This.rsc.SetVariable(Est Ressource APP; "Serveurs_ALV/IP_Serveur"; Is text; ->$texte)
This.result.resultat:=Char(1)+$texte
Function eMailAdress()
var $texte : Text:=""
var $dataTexte : Text:=""
This.rsc.SetVariable(Est ressource MAIL; "mail/contactServeur"; Is text; ->$texte)
This.rsc.SetVariable(Est ressource MAIL; "mail/adresseMail"; Is text; ->$dataTexte)
$texte:=$texte+"@"+$dataTexte
This.result.resultat:=Char(1)+$texte
Function CheminInstallateurALV()
// hypothèse : un seul fichier téléchargeable (dernière version)
// le CheminInstallateurALV est donc unique, cablé EN DUR
var $texte : Text:=""
var $path : Text:=""
var $c : Collection
// lister les téléchargements possibles
// récupérer le chemin des téléchargements
If (This.rsc.SetVariable(Est Ressource HOST; "Chemins/Installateurs/Path"; Is text; ->$path))
// lister les fichiers disponibles
$c:=New collection
Case of
: (This.serveur.ListerLesDocuments($path; ->$c).Error#0)
Else
// tout est ok
// supprimer de la collection les fichiers dont le nom ne contient pas le type demandé $Elements{1}
$c:=$c.query("nom = :1"; This.paramsUrl[0]+"@")
$texte:="#1" // lien inactif
// chemin du dossier du téléchargement
If ($c.length>0)
// prendre la version la plus récente
$c:=$c.orderBy("nom desc")
// transformer en URL si la commande vient d'une page sHTML (second paramètre = URL)
If (This.paramsUrl[1]="URL")
// lire l'adresse URL du dossier
If (This.rsc.SetVariable(Est Ressource HOST; "Chemins/Installateurs/URL"; Is text; ->$path))
// créer l'URL relative à la racine HTML
$path:=$path+$c[0].nom
// créer l'URL absolue
$texte:=This.document.getHostURL($path)
End if
End if
End if
End case
End if
This.result.resultat:=Char(1)+$texte
Function CheminMobileALV()
// hypothèse : un seul fichier téléchargeable (dernière version)
// le CheminInstallateurALV est donc unique, cablé EN DUR
var $texte : Text:=""
var $path : Text:=""
var $c : Collection
// lister les téléchargements possibles
// récupérer le chemin des téléchargements
If (This.rsc.SetVariable(Est Ressource HOST; "Chemins/InstallateursMobile/"+This.paramsUrl[0]+"/Path"; Is text; ->$path))
// lister les fichiers disponibles
$c:=New collection
Case of
: (This.serveur.ListerLesDocuments($path; ->$c).Error#0)
Else
// tout est ok
// supprimer de la collection les fichiers dont le nom ne contient pas le type demandé $Elements{1}
$c:=$c.query("nom = :1"; This.paramsUrl[1]+"@")
$texte:="#1" // lien inactif
// chemin du dossier du téléchargement
If ($c.length>0)
// prendre la version la plus récente
$c:=$c.orderBy("nom desc")
// créer l'URL
// lire l'adresse URL du dossier
If (This.rsc.SetVariable(Est Ressource HOST; "Chemins/InstallateursMobile/"+This.paramsUrl[0]+"/URL"; Is text; ->$path))
// créer l'URL relative à la racine HTML
$path:=$path+$c[0].nom
// créer l'URL absolue
$texte:=This.document.getHostURL($path)
End if
End if
End case
End if
This.result.resultat:=Char(1)+$texte
Function ListerElementsPartages()
// lister les téléchargements possibles
var $URL : Text:=""
var $path : Text:=""
var $texte; $soustexte : Text
var $c : Collection
var $entité : Object
$texte:=""
$URL:=""
$path:=""
$c:=New collection
Case of
: (Not(This.rsc.SetVariable(Est Ressource HOST; "Chemins/Partage/URL"; Is text; ->$URL)))
: (Not(This.rsc.SetVariable(Est Ressource HOST; "Chemins/Partage/Path"; Is text; ->$path)))
: (This.serveur.ListerLesDocuments($path; ->$c).Error#0)
Else
$URL:=$URL+"/"
$texte:="<h2><ul>"
If ($c.length>0)
For each ($entité; $c)
This.URL:=$URL+$entité.nom+"/"
Case of
: ($entité.nom=".")
: ($entité.nom="..")
Else
$soustexte:="<a href="+Char(Double quote)+Char(Double quote)+">"+$entité.nom+"</a>"
$soustexte:=$soustexte+This.ListerFichiersPartages($path+$entité.nom+"/")
$texte:=$texte+"<li>"+$soustexte+"</li>"
End case
End for each
End if
$texte:=$texte+"</ul></h2>"
End case
This.result.resultat:=Char(1)+$texte
Function ListerFichiersPartages($path : Text)->$texte : Text
var $c : Collection
var $entité : Object
$texte:=""
$c:=New collection
Case of
: (This.serveur.ListerLesDocuments($path; ->$c).Error#0)
Else
$texte:="<h4><ul>"
If ($c.length>0)
For each ($entité; $c)
Case of
: ($entité.nom=".")
: ($entité.nom="..")
Else
$texte:=$texte+"<li>"
$texte:=$texte+"<a href="+Char(Double quote)+This.URL+$entité.nom+Char(Double quote)+">"+$entité.nom+"</a>"
$texte:=$texte+"</li>"
End case
End for each
End if
$texte:=$texte+"</ul></h4>"
End case
Function TitrePersonnes()
var $sessionStorage; $entité : Object
$sessionStorage:=This.getStorage()
$entité:=cs.DicoDesNoms.new($sessionStorage.UserParams.UUIDpatronyme)
This.result.resultat:=Char(1)+$entité.patronyme
Function InformationsPersonne()
var $entité : cs.Personnes
var $texte : Text
// restaurer le contexte
$entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
$texte:=$entité.Informations()
This.result.resultat:=Char(1)+$texte
Function InformationsCommune()
var $sessionStorage : Object
var $entité : cs.Communes
var $texte : Text
$sessionStorage:=This.getStorage()
// restaurer le contexte
$entité:=cs.Communes.new($sessionStorage.UserParams.UUIDcommune)
$texte:=$entité.Informations()
This.result.resultat:=Char(1)+$texte
Function NavigateurDiaporama()
var $sessionStorage : Object
var $texte : Text
$sessionStorage:=This.getStorage()
// créer le tableau des icones des media
$texte:=$sessionStorage.UserParams.MediasSelect.EcrireMenusVignette()
This.result.resultat:=Char(1)+$texte
⇧
[class]$pageWebRECHERCHE - 29/08/2025 15:09:06
Class extends $pageWeb
Class constructor()
Super()
Function UrlAfficher()->$result : Text
$result:="/4DCGI/WebRECHERCHE/Afficher"
Function Afficher()
var $prefs; $data : Object
var $attribut : Text
// init de la page avec les données de la dernière requête de la session courante
$prefs:=Session.storage.WebUserPrefs.Recherche
$data:=Session.storage.HTTPvars
If (Not(OB Is empty($data)))
Use ($data)
For each ($attribut; $prefs)
$data["www"+$attribut]:=$prefs[$attribut]
End for each
End use
End if
// la recherche est faite au chargement de la page
// envoyer la page
This.Envoyer("recherche.shtml"; Session.storage.WebUserPrefs.Recherche.EtatNavigation)
// ----------------------
//MARK:Rechercher
// ----------------------
Function DesPersonnes()
// créer la sélection de personnes en fonction des critères
var $prefs; $data; $formats : Object
var $c; $collectionEntités : Collection
var $entité : cs.Personnes
var $ID : Integer
var $texte : Text
$prefs:=Session.storage.WebUserPrefs.Recherche
// * les critères saisis
$data:=New object
$data.Nom:=$prefs.Nom
$data.Prenom:=$prefs.Prenom
$data.Events:=New object
$data.Events.Naissances:=New object("date"; New object("Start"; $prefs.NaissanceStart; "Stop"; $prefs.NaissanceStop); "lieu"; New object("Nom"; $prefs.NaissanceLieu))
$data.Events.Mariages:=New object("date"; New object("Start"; $prefs.MariageStart; "Stop"; $prefs.MariageStop); "lieu"; New object("Nom"; $prefs.MariageLieu))
$data.Events.Deces:=New object("date"; New object("Start"; $prefs.DecesStart; "Stop"; $prefs.DecesStop); "lieu"; New object("Nom"; $prefs.DecesLieu))
// * les filtrages imposés
$data.FiltrePersonnes:=Session.storage["HTTP_Personnes"].copy()
$data.FiltreEvents:=Session.storage["HTTP_Events"].copy()
$data.FiltreCommunes:=Session.storage["HTTP_Communes"].copy()
// on y va
$c:=cs.$recherche.new().RechercherPersonnes($data)
// afficher la sélection
$texte:=""
Case of
: ($c.length=0)
Else
// créer les entités personnes
$collectionEntités:=New collection
For each ($ID; $c)
$entité:=cs.Personnes.new($ID)
$collectionEntités.push($entité)
End for each
// trier par nom, prénom
$collectionEntités:=$collectionEntités.orderBy("nom asc, prenom asc")
// créer la liste WEB
$formats:=New object("Options"; 0x0007)
For each ($entité; $collectionEntités)
$texte:=$texte+$entité.Biographie($formats)
End for each
End case
$texte:=$texte+(("<span>"+This.document.LireLocatedSTR(1094)+"</span>")*Num(Length($texte)=0))
This.result.resultat:=Char(1)+$texte
Function DesCommunes()
// créer la sélection de communes en fonction des critères
var $data; $formats : Object
var $c; $collectionEntités : Collection
var $entité : cs.Communes
var $ID : Integer
var $texte : Text
// * les critères saisis
$data:=New object
$data.nom:=Session.storage.WebUserPrefs.Recherche.Lieu
// * les filtrages imposés
$data.FiltreCommunes:=Session.storage["HTTP_Communes"].copy()
// on y va
$c:=cs.$recherche.new().RechercherCommunes($data)
// afficher la sélection
$texte:=""
Case of
: ($c.length=0)
Else
// créer les entités communes
$collectionEntités:=New collection
For each ($ID; $c)
$entité:=cs.Communes.new($ID)
$collectionEntités.push($entité)
End for each
// trier par nom
$collectionEntités:=$collectionEntités.orderBy("nom asc")
// créer la liste
$formats:=New object("Options"; 0x00C90000)
For each ($entité; $collectionEntités)
$texte:=$texte+"<p>"+$entité.LibelléLié($formats)+"</p>"
End for each
End case
$texte:=$texte+(("<span>"+This.document.LireLocatedSTR(1094)+"</span>")*Num(Length($texte)=0))
This.result.resultat:=Char(1)+$texte
// ----------------------
//MARK:Actions
// ----------------------
Function SoumettreFormulaire()
// gère tous les submit de la saisie
// récupérer les données du formulaire
This.LireHTTPvars()
// exécuter le submit
Case of
: (Session.storage.HTTPvars=Null)
: (Session.storage.HTTPvars.length=0)
: (OB Is defined(Session.storage.HTTPvars; "wwwBtnSubmit"))
// cas où on a déjà submit la recherche
Case of
: (Session.storage.HTTPvars.wwwBtnSubmit="Valider")
This.ValiderRecherche()
// dans cette version, autres cas non prévus
End case
: (Not(OB Is defined(Session.storage.HTTPvars; "wwwEtatNavigation")))
: (Session.storage.HTTPvars.wwwEtatNavigation="")
// on ne sait pas quoi faire
Else
// cas ou on n'a pas encore submit une recherche ; a priori on change de domaine
This.ValiderRecherche()
End case
Function ValiderRecherche()
var $saisie; $prefs : Object
var $attribut; $attributPrefs : Text
// récupérer les données de recherche saisies
$saisie:=Session.storage.HTTPvars
// les recopier dans les userPrefs
$prefs:=Session.storage.WebUserPrefs.Recherche
Use ($prefs)
For each ($attribut; Session.storage.HTTPvars)
If ($attribut="www@")
$attributPrefs:=Replace string($attribut; "www"; "")
$prefs[$attributPrefs]:=Session.storage.HTTPvars[$attribut]
End if
End for each
End use
// la recherche est faite au chargement de la page
// re-afficher la page
This.Rediriger(This.UrlAfficher())
⇧
[class]_SF_ExporterSiteWeb - 06/06/2026 17:35:52
Class extends _SousFormulaire
singleton Class constructor()
Super()
This.nomOBJ:=""
// ----------------------
//MARK:Formulaire
// ----------------------
Function _fct_Formulaire()
var $cadence : Integer:=0
Case of
: (Form event code=On Load)
// initialiser le status de la progression du process
// il peut y avoir plusieurs sources d'initialisation
If (Not(OB Is defined(Form; "ProcInProgress")))
Form.ProcInProgress:=New object
Form.ProcInProgress.numProcess:=-1
End if
cs.xSDK.ResourceALV.me.SetVariable(Est Ressource APP; "Ressources_Communes/RefreshTime"; Is longint; ->$cadence)
SET TIMER($cadence)
// charger les objets
This._onEndLoad()
: (Form event code=On Timer)
// MaJ dans le composant l'état de la tâche
If (Not(cs.xSDK.RegistreTaches.me.existeTache(Form.nomTache)))
Form.ProcInProgress.numProcess:=-1
// éteindre le btn
Form.ExporterWEBstatique:=False
End if
End case
Function _onEndLoad()
var $c : Collection
var $functionID : Text
// en DUR pour l'instant
$c:=["dossierWEBstatique"; "ChoixDateLimite"; "ExporterWEBstatique"]
For each ($functionID; $c)
This.nomOBJ:=$functionID
This["_fct_"+$functionID]()
End for each
// ----------------------
//MARK:Formulaire SF_ExporterSiteWeb
// ----------------------
Function _fct_dossierWEBstatique()
// la ressource n'est pas une ressource composant
// "Editer Ressource Composant" non utilisable, méthode dédiée
var $racine : Text:=""
var $texte : Text:=""
Case of
: (Form event code=On Load)
This.rsc.SetVariable(Est Ressource HOST; "Chemins/siteWEBstatique/URL"; Is text; ->$texte)
Form[This.nomOBJ]:=$texte
: (Form event code=On Data Change)
$texte:=Form[This.nomOBJ]
This.rsc.SetResourceALV(Est Ressource HOST; "Chemins/siteWEBstatique/URL"; ->$texte)
// le chemin est relatif au chemin de la racine Web (pas connu de l'utilisateur)
// créer le chemin complet (ajout du chemin de dossier racine HTML)
Case of
: (Not(This.rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHOST"; Is text; ->$racine)))
: (Not(This.rsc.SetVariable(Est Ressource HOST; "Chemins/RacineHTML"; Is text; ->$texte)))
Else
$texte:=$racine+$texte+Form[This.nomOBJ]
$texte:=Replace string($texte; "//"; "/") // au cas où saisie incorrecte
This.rsc.SetResourceALV(Est Ressource HOST; "Chemins/siteWEBstatique/Path"; ->$texte)
End case
End case
// le chemin est relatif au chemin de la racine Web (pas connu de l'utilisateur)
// créer le chemin complet (ajout du chemin de dossier racine HTML)
This.rsc.SetVariable(Est Ressource HOST; "Chemins/siteWEBstatique/Path"; Is text; ->$texte)
This.nomOBJ:=This.nomOBJ+"Path"
Form[This.nomOBJ]:=$texte
Function _fct_ChoixDateLimite()
var $i : Integer
var $année : Integer:=0
var $objet : Object
Case of
: (Form event code=On Load)
// créer la liste des années possibles de début de publication des données privées
Form[This.nomOBJ]:=New object
$objet:=Form[This.nomOBJ]
$objet.values:=New collection
$objet.values.push(Year of(Current date)-100)
For ($i; 1; 100)
$objet.values.push($objet.values.last()+1)
End for
This.rsc.SetVariable(Est Ressource WEB; "Site_Web/Annee_pivot"; Is longint; ->$année)
$i:=$objet.values.indexOf($année)
If ($i=-1)
$objet.index:=0 //forcer à la date légale
$année:=$objet.values[$objet.index]
$objet.currentValue:=$année
This.rsc.SetResourceALV(Est Ressource WEB; "Site_Web/Annee_pivot"; ->$année)
Else
$objet.index:=$i
End if
: (Form event code=On Clicked)
$année:=Form[This.nomOBJ].currentValue
This.rsc.SetResourceALV(Est Ressource WEB; "Site_Web/Annee_pivot"; ->$année)
End case
Function _fct_ExporterWEBstatique()
var $data : Object
Case of
: (Form event code=On Load)
Form[This.nomOBJ]:=False
: (Form event code=On Clicked)
// après le clic, Form[$nomOBJ] passe à vrai
// on ne lance qu'un process à la fois
If (Form.ProcInProgress.numProcess=-1)
// on y va
$data:=Form // Créer objet
$data.functionID:="Créer"
$data.nomTache:=cs.$maintenanceSite.new().nomTache
$data.numProcessAppelant:=-1 // exécuter dans un process externe
Form.ProcInProgress.numProcess:=Exécuter Function Préemptive(cs.$maintenanceSite; $data)
Form.ProcInProgress.nomProcess:=Process activity(Processes only)["processes"].query("number = :1"; Form.ProcInProgress.numProcess)[0].name
End if
// Form[$nomOBJ] ne peut passer à faux que via le minuteur (pas accessible ici)
End case
⇧
[class]_Trace - 20/04/2025 12:59:36
property cible : cs.xSDK.Traces
property success : Boolean
singleton Class constructor()
This.cible:=cs.xSDK.Traces.new()
This.success:=False
// ----------------------
//MARK:Wrappers
// ----------------------
Function set Error($numError : Integer)
This.cible.Error:=$numError
Function get Error()->$result : Integer
$result:=This.cible.Error
Function set ErrorDescription($description : Text)
This.cible.ErrorDescription:=$description
Function get ErrorDescription()->$result : Text
$result:=This.cible.ErrorDescription
Function Intercepter()
var ErrorNum : Integer
ErrorNum:=This.cible.Intercepter("WEB"; Error; Error method; Error line; Error formula)
Function Initialiser($nomMethode : Text)->$result : Object
This.cible.CréerErreur("WEB"; 0; $nomMethode; "")
$result:=This
Function Créer($Error : Integer; $nomMethode : Text; $ErrorDescription : Text)->$result : Object
This.cible.CréerErreur("WEB"; $Error; $nomMethode; $ErrorDescription)
$result:=This
Function FixerSuccess()
This.cible.FixerSuccess()
This.success:=This.cible.success
Function LeverException($options : Collection)
// renseigner le label de l'erreur
This.cible.ErrorLabel:=Localized string(String(This.cible.Error))
// lancer le traitement de l'erreur
This.cible.LeverException($options)
Function EnvoyerMessages($options : Collection; $libellé : Text; $source : Text; $description : Text)
This.cible.EnvoyerMessages($options; "WEB"; $libellé; $source; $description)
Function DebugerMethode($libellé : Text; $source : Text; $description : Text)->$result : Boolean
// mettre à jour l'état (activation / désactivation des ASSERT)
cs.$composant.new().InstallerDonnéesHote()
$result:=This.cible.DebugerMethode(Storage.Host; "WEB"; $libellé; $source; $description)
Function DebugerVariables($libellé : Text; $source : Text; $data : Object)->$result : Boolean
// toujours appelé par un ASSERT (Storage.Host ne peut être réactualisé)
$result:=This.cible.DebugerVariables(Storage.Host; "WEB"; $libellé; $source; $data)
// ----------------------
//MARK:Session
// ----------------------
Function Session($nomMethode : Text; $url : Text)
var $data : Object
var $c : Collection
var $attribut : Text
$data:=New object
$data.methode:=$nomMethode
$data.url:=$url
$data.numProc:=Current process
$data.nomProc:=Current process name
$data.storage:=Null
Case of
: (Not(Get assert enabled))
: (Session=Null)
$data.id:="pas de session ouverte"
Else
$data.id:=Session.id
$data.userName:=Session.userName
$data.isGuest:=Session.isGuest()
$data.idleTimeout:=Session.idleTimeout
$data.expirationDate:=Session.expirationDate
$data.HTTPvars:=Null
If (OB Is defined(Session.storage; "HTTPvars"))
$data.HTTPvars:=OB Copy(Session.storage.HTTPvars)
End if
// les variables process courantes
$c:=OB Keys(Session.storage.HTTPvars)
$data.HTTPvarsCourantes:=New object
For each ($attribut; $c)
$data.HTTPvarsCourantes[$attribut]:=Get pointer($attribut)->
End for each
$data.WebUserPrefs:=Null
If (OB Is defined(Session.storage; "WebUserPrefs"))
$data.WebUserPrefs:=OB Copy(Session.storage.WebUserPrefs)
End if
$data.UserParams:=Null
If (OB Is defined(Session.storage; "UserParams"))
$data.UserParams:=OB Copy(Session.storage.UserParams)
End if
$data.WebUser:=Null
If (OB Is defined(Session.storage; "WebUser"))
$data.WebUser:=OB Copy(Session.storage.WebUser)
End if
// pour finir
//$data.storage:=OB Copier(Session.storage)
End case
ASSERT(cs._Trace.me.DebugerVariables(String(Milliseconds)+"_SessionStorage"; Current method name; $data)) // "Options"; 0x0080
⇧
[class]Unions - 29/05/2025 18:21:36
property leEvent : cs.Events
property lesMembres : Object
// attributs de la classe
property SansEnfant : Boolean
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDunique de la BDD
var $c : Collection
Super("Unions"; $IDentité)
// pour trier les unions, mettre l'event ici
// attention il peut ne pas y en avoir
This.leEvent:=Null
$c:=This.dataClass.LesEvents()
// prendre le premier
If ($c.length>0)
This.leEvent:=cs.Events.new($c[0])
End if
Function Libellé($formats : Object)->$result : Text
// renvoie le nom formaté des protagonistes suivant les options $formats
// $formats
// l'union (parentale par exemple) peut être nulle
var $sélection : cs.PersonnesSelect
var $entité : cs.Personnes
var $lien : Text
If (This.ID#0)
// sélectionner les membres de l'union
$sélection:=This.LesProtagonistes()
// coder leur noms
$result:=""
$lien:=" & "
For each ($entité; $sélection.selection)
$result:=$result+$lien+$entité.Libellé($formats)
End for each
// nettoyer
$result:=Replace string($result; $lien; ""; 1)
End if
// ----------------------
//MARK:Selection
// ----------------------
Function LesProtagonistes()->$result : cs.PersonnesSelect
// créer la sélection de personnes
var $c : Collection
$result:=cs.PersonnesSelect.new(This.dataClass.LesProtagonistes())
// ordonner les protagonistes : membre1 = homme, membre2 = femme
$result.Créer()
$c:=$result.selection // le personnes
This.lesMembres:=New object
// rappel : homme sexe = faux, femme sexe = vrai
// plusieurs cas
Case of
: ($c.length=0)
This.lesMembres:=Null
: ($c.length=1)
This.lesMembres.membre1:=Null
This.lesMembres.membre2:=Null
If ($c[0].sexe)
This.lesMembres.membre2:=$c[0]
Else
This.lesMembres.membre1:=$c[0]
End if
Else
$c:=$c.orderBy("sexe asc")
This.lesMembres.membre1:=$c[0]
This.lesMembres.membre2:=$c[1]
End case
Function LesEnfants()->$result : cs.PersonnesSelect
// envoie la sélection d'entités [Personnes] enfants de l'union
// peut ne pas exister
var $c : Collection
$result:=Null
$c:=This.dataClass.LesEnfants()
If ($c.length>0)
$result:=cs.PersonnesSelect.new($c)
$result.Créer()
End if
// ----------------------
//MARK:Selection
// ----------------------
Function getMembres()->$result : Object
$result:=This.lesMembres
Function getLeConjoint($ID : Integer)->$result : Object
// trouver les membres de l'union
This.LesProtagonistes()
// chercher dans les membres celui dont l'ID n'est pas $ID
If (This.lesMembres.membre1.ID=$ID)
$result:=This.lesMembres.membre2
Else
$result:=This.lesMembres.membre1
End if
Function getEntité($data : Object)->$result : Object
// renvoie l'entité de this correspondant à l'objet saisie ($data)
$result:=This.InitResult(0; ""; False)
Case of
: (This.DataClassNom=$data.DataClassNom)
// c'est l'entité unions
$result.entité:=This
$result.success:=True
: (This.leEvent=Null)
Else
// essayer les events fam (un seul)
$result:=This.leEvent.getEntité($data)
End case
⇧
[class]$serveur - 26/02/2026 14:38:24
// pour optimiser les appels, cette classe n'étend pas $composant
property trace : cs._Trace
property fct : cs.xSDK.Outils
property rsc : cs.xSDK.ResourceALV
property balisesUrl; paramsUrl : Collection
Class constructor()
This.trace:=cs._Trace.me
This.fct:=cs.xSDK.Outils.me
This.rsc:=cs.xSDK.ResourceALV.me
// ----------------------
//MARK:Serveur
// ----------------------
Function Demarrer()
var $data; $params; $result : Object
var $c : Collection
var $webServer : 4D.WebServer
$c:=WEB Server list.query("name = :1"; Storage.ServeurHTTP.nom)
Case of
: ($c.length=0)
// pas de serveur ; le créer (test du composant)
$webServer:=WEB Server(Web server database)
: ($c[0].isRunning)
// déjà démarré ; abandonner
$webServer:=Null
Else
// récupérer le serveur
$webServer:=$c[0]
End case
If ($webServer=Null)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Serveur Web"; Current method name; "Le serveur Web est déjà démarré")
Else
// fixer les paramètres généraux du serveur Web
$data:=New object
This.FixerParametres($data)
// par défaut, pas de certificat => pas https
// Enable HTTP on your 4D Web server (no certificates)
$data.HTTPEnabled:=True
// Disable HTTPS on your 4D Web server
$data.HTTPSEnabled:=False
$data.HSTSEnabled:=False
// état du certificat SSL
$params:=cs.$document.new().CertInformations()
Case of
: (Not($params.Production.exists))
// on n'a pas de certificat SSL
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Paramétrage Serveur Web : Cert"; Current method name; "certificat SSL en production non trouvé")
: ($params.Production.Invalide)
// on n'a pas de certificat SSL valide
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Paramétrage Serveur Web : Cert"; Current method name; "certificat SSL trouvé en production non valide, doit être renouvelé")
Else
// options HTTPS
// age maximal d'activation du HSTS pour une session
$data.HSTSMaxAge:=7776000 // 7 776 000 = 3 * 30 * 24 * 3600, soit 3 mois. 31 536 000 = 365 * 86400 s = 365 days
// Enable HSTS on the 4D Web server
// rappel : HSTS activé permet au serveur web 4D de déclarer que les navigateurs ne doivent interagir avec lui que par des connexions HTTPS sécurisées
// important : ici HTTP est aussi activé : le navigateur peut toujours basculer entre HTTPS et HTTP (par exemple, dans la zone URL du navigateur, l'utilisateur peut remplacer "https" par "http")
// on pourra déactiver HTTP
$data.HSTSEnabled:=True
// Enable HTTP on your 4D Web server
$data.HTTPEnabled:=True
// Enable HTTPS on your 4D Web server
$data.HTTPSEnabled:=True
End case
// fixer le point d'entrée du site
This.InstallerURLdémarrage("serveur")
// c'est ok, on démarre
This.trace.EnvoyerMessages([msgk_log]; "Serveur Web"; Current method name; "$data "+JSON Stringify($data))
$result:=$webServer.start($data)
// message ALV
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "dossier racine Web"; Current method name; "<"+$data.rootFolder.platformPath+">")
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; Current method name; "Le serveur Web "+Choose($webServer.HTTPSEnabled; "[HTTPS]"; "[HTTP]")+" est démarré "+Choose($webServer.isRunning; "[OK]"; "[KO]")+", HSTS "+Choose($webServer.HSTSEnabled; "[OK]"; "[KO]"))
End if
Function Arreter()
var $vb_stopped : Boolean
If (WEB Server(Web server database).isRunning)
ASSERT(This.trace.DebugerMethode("Stop"; Current method name; "stopping web server..."))
WEB Server(Web server database).stop()
End if
$vb_stopped:=Not(WEB Server(Web server database).isRunning)
ASSERT($vb_stopped; "web server failed to stop")
ASSERT(This.trace.DebugerMethode("Stop"; Current method name; "web server stopped. "+Choose($vb_stopped; "[OK]"; "[KO]")))
// message ALV
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Serveur Web"; Current method name; "Le serveur Web est arrêté "+Choose($vb_stopped; "[OK]"; "[KO]"))
Function FixerParametres($params : Object)
// fixer les paramètres du serveur Web de ce composant
var $dataEntier : Integer:=0
var $adresseIP : Text
var $dossier : 4D.Folder
// l'adresse IP du serveur Web 4D
$adresseIP:=cs.xSDK.EnvironnementALV.new().infosSystème().IPadresse
This.rsc.SetResourceALV(Est Ressource WEB; "Serveur_web/Web_Adresse_IP_ecoute"; ->$adresseIP)
$params.IPAddressToListen:=$adresseIP
// fixer les options APP
// surcharge les valeurs définies dans les propriétés de la base
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTP_sousDomaine"; Is longint; ->$dataEntier)
$params.HTTPPort:=$dataEntier
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is longint; ->$dataEntier)
$params.HTTPSPort:=$dataEntier
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/Web_Timeout_process"; Is longint; ->$dataEntier)
$params.inactiveProcessTimeout:=$dataEntier
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/Web_Timeout_session"; Is longint; ->$dataEntier)
$params.inactiveSessionTimeout:=$dataEntier
$params.scalableSession:=True
//$params.sessionCookieName:="ALVSID" // "" rétablit la valeur par défaut (4DSID)
// fixer le dossier des certificats
$dossier:=cs.$document.new().getCertificatSSLFolder()
If ($dossier.exists)
$params.certificateFolder:=$dossier
End if
// fixer le dossier racine
$dossier:=cs.$document.new().getRacineHTMLFolder()
If ($dossier.exists)
$params.rootFolder:=$dossier
End if
Function InstallerURLdémarrage($nomPage : Text)
var $fichier; $fileFTP : 4D.File
var $result : cs.xSDK.Traces
var $texteOUT : Text
var $texteIN:=""
var $data : Object
$data:=New object
// fixer l'url du point d'entrée du serveur ; 2 cas : opérationnel et test local
This.rsc.SetObjet(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is longint; $data; "port")
If (Storage.System.typeApplication=ALV Serveur APP)
// url du serveur WEB opérationnel
This.rsc.SetObjet(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; $data; "adresse")
$data.nomPage:=$nomPage+".html"
Else
// pour test
This.rsc.SetObjet(Est Ressource WEB; "Serveur_web/Web_Adresse_IP_ecoute"; Is text; $data; "adresse")
$data.nomPage:=$nomPage+"test.html"
End if
$data.url:="https://"+$data.adresse+":"+String($data.port)+"/index.shtml"
$fileFTP:=cs.xSDK.Traces.new().GetGarbageDossier().folder("_WEBdebug").file($data.nomPage)
$fichier:=Folder(fk resources folder).folder("TemplatesWeb").file($nomPage+"Proto.html")
If ($fichier.exists)
$texteIN:=$fichier.getText()
PROCESS 4D TAGS($texteIN; $texteOUT; $data)
$fileFTP.setText($texteOUT)
// transfert sur l'hébergeur
This.rsc.SetObjet(Est Ressource HOST; "Chemins/siteWEBstatique/Path"; Is text; $data; "url")
$result:=cs.xSDK.ServicesFTP.new().EnvoyerFichier($fileFTP.platformPath; $data.url)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Intégration "+Choose($result.success; "[OK]"; "[KO]"); Current method name; "URL racine Web installée sur hébergeur : '"+$data.url+"'")
End if
Function LireInformationsServeur()->$result : Object
// informations du serveur Web
var $dataTexte : Text:=""
var $i : Integer:=0
var $texte : Text
// en principe : ALV Serveur APP est interrogé par ALV Client APP, et ALV Serveur HTTP par 4D mode distant
$result:=New object
// *** les paramètres
$result.params:=New object
// dossier racine
$result.params.DossierRacineHTML:=Get 4D folder(HTML Root folder; *) //Lire Ressource ALV(Est Ressource WEB; "Chemins/Serveur_web/Dossier_racine_web"; Est un texte)->
$result.params.estDémarré:=WEB Is server running
// paramètres
WEB GET OPTION(Web port ID; $i)
$result.params.webPortID:=$i
WEB GET OPTION(Web HTTPS port ID; $i)
$result.params.webHTTPSPortID:=$i
WEB GET OPTION(Web HTTPS enabled; $i)
$result.params.HTTPSEnabled:=($i=1)
WEB GET OPTION(Web HSTS enabled; $i)
$result.params.HSTSEnabled:=($i=1)
// URL serveur
This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$dataTexte)
$texte:="://"+$dataTexte
If ($result.params.HTTPSEnabled)
$texte:="https"+$texte
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is longint; ->$i)
$texte:=$texte+":"+String($i)
Else
$texte:="http"+$texte
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTP_sousDomaine"; Is longint; ->$i)
$texte:=$texte+":"+String($i)
End if
$result.params.URLserveurWEB:=$texte
// *** info serveur composant
$result.serveurWeb:=WEB Server(Web server database)
// au cas ou, passer en objet pur
$dataTexte:=JSON Stringify($result)
$result:=JSON Parse($dataTexte)
// ----------------------
//MARK:Connexions
// ----------------------
Function surAuthentificationWeb($url : Text; $entete : Text; $IPnavigateur : Text; $IPserveur : Text; $LogIn : Text; $motDePasse : Text)->$result : Boolean
// Appelée à la réception d'une 4Daction (4DSCRIPT...), d'une url 4DCGI (pas seulement?)
// retourne faux si l'identification (DIGEST) est incorrecte ; rappel : dans ce cas la requete est rejetée (pas d'appel à "sur Connexion Web")
// retourne vrai sinon ; l'action est validée
// fixe un .WebUser pour la suite des opérations (vide = pas d'utilisateur identifié)
var $data; $objet : Object
var $pageWeb : cs.$pageWeb
var $vb_allowed : Boolean
// pour les erreurs
initProcess
$data:=New object
$data.Commande:=$url
$data.IPnavigateur:=$IPnavigateur
$data.utilisateur:=$LogIn
ASSERT(This.trace.DebugerVariables($url; Current method name; $data)) //; "Options"; 0x0002
$pageWeb:=cs.$pageWeb.new()
// quelqu'un doit répondre vrai
$vb_allowed:=False // réception de la réponse des composants
// essayer une url ALV
Case of
: ($url="/4DCGI/Web/Authentifier")
// seule commande pour s'identifier
// ici on vient de cliquer sur "espace privé"
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.wwwEtatNavigation:="authentification"
End use
// lire ce qui a été saisi
$objet:=cs.$pageWebPROFIL.new().LireSaisie(New object("LogIn"; ""; "Password"; ""))
$vb_allowed:=This.Authentifier($objet)
If ($vb_allowed)
// c'est ok, changer de user
This.InitSession($objet.LogIn)
Else
// Ici : annulation de l'authentification par user
$pageWeb.Envoyer("accueil.shtml"; "accueil")
End if
: (cs.xALB.$serveurWeb.new().AuthentificationWeb($url; $entete; $IPnavigateur; $IPserveur; $LogIn; $motDePasse))
// rappel : ici .WebUser n'est peut-être pas encore initialisé
$vb_allowed:=True
// est concerné ; sa réponse
: ($url="/4DHTTP/@")
// requete externe seule commande pour s'authentifier
$vb_allowed:=This.Authentifier(New object("LogIn"; $LogIn; "Password"; $motDePasse))
$vb_allowed:=True // bof
// les autres 4Durl et 4Dxxx sont libres d'accès
: (Not(OB Is defined(Session.storage; "WebUser")))
// ouverture par invité Web ; ses données
This.InitWebUserData(1000)
// ici session.userName vaut "", Session.isGuest()=vrai
This.InitDataSession()
$vb_allowed:=True
Else
// utilisateur déjà authentifié
$vb_allowed:=True
End case
// finalement
$result:=$vb_allowed
// mettre à jour le contexte
$pageWeb.InitContexte($url)
// initialiser les variables process
// dont vs4D : prévenir le navigateur que le serveur est présent (à faire tout de suite)
$pageWeb.RestaurerHTTPvars("HTTPvars")
// attention : ici, v7.4.5, un ASSERT(DEBUG ALV (Storage.System;"REQUEST:TRACE_VARIABLE"... empêche celui de "sur connexion Web"
//TracerSession(Créer objet("méthode"; Nom méthode courante; "url"; $url; "$0"; Chaîne($0)))
Function Authentifier($objet : Object)->$result : Boolean
// authentification d'accès à une session WEB du site WEB
// trouver l'entité utilisateur de LogIn $1 et valider le MdP saisi
var $entité : cs.UtilisateursALV
// remarque : si url # de "/4DCGI/BDD...", $utilisateur vide peut ne pas être filtré
$result:=False
// renseigner l'utilisateur
Case of
// Pour des raisons de sécurité, refuser les noms nul ou qui contiennent @
: ($objet.LogIn="")
// Ici : annulation de l'authentification par user
// ou possible sur des url non gérées directement par ALV ; pas de message
: (This.fct.ContientJoker($objet.LogIn))
Else
// identifiant et MdP saisis : reconnaître l'utilisateur
$entité:=cs.UtilisateursALV.new($objet.LogIn)
Case of
: ($entité.ID<0)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Echec d'authentification"; Current method name; "de "+$objet.LogIn)
// utilisateur non connu
: ($objet.Password#$entité.Password)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Validation du mot de passe [KO]"; Current method name; "de "+$objet.LogIn)
// erreur saisie mot de passe
Else
// c'est ok
$result:=True
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Validation du mot de passe [OK]"; Current method name; "de "+$objet.LogIn)
End case
End case
Function surConnexionWeb($url : Text; $entete : Text; $adresseIPnavigateur : Text; $adresseIPserveur : Text; $LogIn : Text; $motDePasse : Text)
// init du process Web (le process de la session peut avoir changé)
initProcess
// essayer une url ALV
// Compiler_Web n’a pas été appelé, toutes les variables et sélections existent
Case of
// essayer de traiter toutes les url envoyées par le client HTTP
: (This.TraiterURL($url).success)
// commande traitée
// essayer les commandes APP
: (This.TraiterActionAPP($url))
// commande traitée
// // essayer les commandes des composants :
// essayer les commandes des albums
: (cs.xALB.$serveurWeb.new().ConnexionWeb($url; $entete; $adresseIPnavigateur; $adresseIPserveur; $LogIn; $motDePasse))
// commande traitée
// // essayer les commandes du Journal Web
//: ((wwwJWebTraiterAction(->$url))->)
// // commande traitée
// filtrer certaines erreurs
: ($url="/ressources@")
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Serveur Web"; Current method name; "L'url '"+$url+"' n'est pas traitée")
: (Session=Null)
// on n'est pas sur le serveur Web
Else
// commande inconnue, retour à la case départ
cs._Trace.me.DebugerMethode($url; Current method name; $url+" : commande 4DCGI inconnue")
// retour au site Web
WEB SEND HTTP REDIRECT(Session.storage.UserWebRequete.URLdomaine)
End case
cs._Trace.me.Session(Current method name; $url)
// ----------------------
//MARK:Sessions
// ----------------------
Function InitSession($LogIn : Text)
// c'est ok, changer de user
var $data : Object
// données du user
This.InitWebUserData($LogIn)
// initialiser les privilèges et roles
$data:=New object
$data.userName:=Session.storage.WebUser.LogIn
$data.privileges:=Session.storage.WebUser.privileges
Session.setPrivileges($data)
// ici Session.isGuest()=faux
This.InitDataSession()
Function InitWebUserData($userID : Variant)
var $entité : Object
$entité:=cs.UtilisateursALV.new($userID)
Use (Session.storage)
Session.storage.WebUser:=New shared object
End use
sharedObject($entité; Session.storage.WebUser)
Function InitDataSession()
var $dossier : Text:=""
var $data : Object
// ouverture de session
// initialiser les variables session
This.InitUserParams()
This.InitHTTPvars()
// raz des données de requêtes
// depuis v6.2.9 URL du site dans les Préférences (hors code)
This.rsc.SetVariable(Est Ressource WEB; "FAI/URL_Domaine"; Is text; ->$dossier)
Use (Session.storage)
Session.storage.UserWebRequete:=New shared object
Use (Session.storage.UserWebRequete)
Session.storage.UserWebRequete.URLdomaine:=$dossier
End use
End use
// créer le dossier des fichiers temporaires de la session
$data:=cs.$document.new().getSessionFolder()
$data.create()
Function InitUserParams()
var $data : Object
// variables utilisées dans les sélections courantes
// au gré de la navigation de l'utilisateur
Use (Session.storage)
Session.storage.UserParams:=New shared object
End use
$data:=Session.storage.UserParams
Use ($data)
$data.UUIDpatronyme:=""
$data.UUIDpersonne:=""
$data.UUIDcommune:=""
$data.OrientationEcran:=""
End use
Function InitHTTPvars()
var $data : Object
// .HTTPvars contient
// - des variables, de nom wwwXXX, utilisées dans les pages Web de recherche ou de saisie pour recupérer les données utilisateur
// RAPPEL : cette liste sert à initialiser TOUTES les variables process ; toutes ces variables doivent être dans cette liste
// - des variables autres, de nom YYY, utilisées dans les templates de page Web pour la construction des pages
Use (Session.storage)
Session.storage.HTTPvars:=New shared object
End use
$data:=Session.storage.HTTPvars
Use ($data)
// saisie et recherche utilisateur
$data.wwwNom:=""
$data.wwwPrenom:=""
$data.wwwSexe:=""
// recherche
$data.wwwNaissanceStart:=""
$data.wwwNaissanceStop:=""
$data.wwwNaissanceLieu:=""
$data.wwwDecesStart:=""
$data.wwwDecesStop:=""
$data.wwwDecesLieu:=""
$data.wwwMariageStart:=""
$data.wwwMariageStop:=""
$data.wwwMariageLieu:=""
$data.wwwLieu:=""
// depuis v5.2 les 4DURL sont de la forme /4Dxxx/xxx/yyy
$data.wwwRacineRessources:="../../"
// fixer le contexte pour le composant CARTO
$data.wwwContexteWeb:="ServeurWeb"
End use
// ----------------------
// MARK:Traitement des url
// ----------------------
Function TraiterURL($url : Text)->$result : Object
// traiter toutes les url envoyées par le client HTTP ou par un formulaire en construction
// remarque : dans les 2 cas, les url ont le m$eme format
// transmettre l'url à la bonne classe $page pour traitement
$result:=This.InitResult()
$result.nomMethode:=Current method name
$result.resultat:=""
// analyser l'url
This.LireParametresUrl($url)
Case of
: (This.balisesUrl=Null)
$result.Error:=-15068
$result.ErrorDescription:="url incomplète - pas de balise à traiter"
: (This.balisesUrl.length<2)
$result.Error:=-15068
$result.ErrorDescription:="url incomplète - le contexte de $page, balisesUrl[2], est absent"
: (Not(OB Is defined(cs; "$page"+This.balisesUrl[1])))
// url non traitée ici
$result.Error:=-15068
$result.ErrorDescription:="url incomplète - la classe $page"+This.balisesUrl[1]+" est inconnue"
Else
// créer la classe et traiter l'url
// le résultat, s'il y a, est dans $result.resultat
// en cas d'erreur elle peut renseigner $result
$result:=cs["$page"+This.balisesUrl[1]].new().TraiterURL($url)
End case
$result.success:=($result.Error=0)
Function LireParametresUrl($url : Text)
// $url est de la forme /4Dxxx/yyy/nomFunction {?param1 {+?param2...}}, avec xxx = CGI ou ACTION ou SCRIPT, yyy le contexte WEB, APP ...
// lire les balises
This.balisesUrl:=Split string($url; "/"; sk ignore empty strings)
// analyser la function
This.paramsUrl:=Split string(This.balisesUrl[This.balisesUrl.length-1]; "?")
// virer function+params
This.balisesUrl:=This.balisesUrl.slice(0; This.balisesUrl.length-1)
// ajouter la function seule
This.balisesUrl.push(This.paramsUrl[0])
// lister les paramètres
This.paramsUrl.shift()
// nettoyer les paramètres
Case of
: (This.paramsUrl.length<2)
// rien à faire
: (This.paramsUrl[0]="@+")
// nettoyer les '+'
This.paramsUrl:=Split string(This.paramsUrl.join(""); "+")
: (This.paramsUrl[0]="@&")
// l'url vient de javascript, le séparateur de params est '&' ('+' ne passe pas)
This.paramsUrl:=Split string(This.paramsUrl.join(""); "&")
End case
Function TraiterActionAPP($url)->$result : Boolean
// commencer par les URL 4DHTTP : elles gèrent les données de la session web APP
// rappel : ici, les URL en /4DHTTP/@ sont authentifiées, mais pas les URL /4DCGI/@
var $data : Object
var $réception : Blob
$result:=True
Case of
: ($url="/4DHTTP/APP/WebServerState@")
// test du serveur
// renvoyer les infos du serveur; rappel on peut recevoir des paramètres
OB SET($data; "EstActif"; True)
VARIABLE TO BLOB($data; $réception)
WEB SEND RAW DATA($réception)
Else
$result:=False
End case
Function redirectUnsecure($vp_authenticatedPtr : Pointer)->$result : Boolean
// This function will trap non https connections
// and send a 301 redirect response
// NOTE : if HSTS is activated, it seems that 4D will do this automatically
// but we need to disable HSTS when we have to respond to Let's Encrypt HSTS challenge
// request will arrive on http / port 80, not https / port 443
// author : Bruno LEGAY - A&C Consulting - 06/03/2020
var $vt_host; $vt_urlEscaped; $vt_url : Text
var $vl_headerIndex; $vl_headerCount : Integer
ASSERT(Count parameters>0; "requires 1 parameter")
ASSERT(Type($vp_authenticatedPtr->)=Is boolean; "$1 should be a boolean pointer")
$result:=False
If (Not(WEB Is secured connection))
// la connexion n'est pas https
// lire les paramètres de connexion et recreer une requete https
ARRAY TEXT($tt_headerKeys; 0)
ARRAY TEXT($tt_headerValues; 0)
WEB GET HTTP HEADER($tt_headerKeys; $tt_headerValues)
$vt_host:=""
$vt_urlEscaped:=""
$vl_headerCount:=Size of array($tt_headerKeys)
For ($vl_headerIndex; 1; $vl_headerCount)
Case of
: ($tt_headerKeys{$vl_headerIndex}="X-METHOD") // "GET"
//$vt_method:=$tt_headerValues{$vl_headerIndex}
: ($tt_headerKeys{$vl_headerIndex}="X-URL") // "/page.html"
// $vt_url/$1 "/uploads?paramName=hello world" (url is unescaped)
// "X-URL" => "/uploads?paramName=hello%20world" (original url with escaped characters)
$vt_urlEscaped:=$tt_headerValues{$vl_headerIndex} // "/uploads?paramName=hello%20world"
: ($tt_headerKeys{$vl_headerIndex}="X-VERSION") // "HTTP/1.1"
//$vt_version:=$tt_headerValues{$vl_headerIndex}
: ($tt_headerKeys{$vl_headerIndex}="host") // "www-4d-summit-2020.ac-consulting.fr"
// rebuild the redirection url with "https://" protocol
$vt_host:=$tt_headerValues{$vl_headerIndex} // "www-4d-summit-2020.ac-consulting.fr"
End case
End for
// HTTP/1.1 301 Moved Permanently
// Connection: close
// Date: Fri, 21 Feb 2020 20:33:06 GMT
// Location: https://www-4d-summit-2020.ac-consulting.fr/
// Server: 4D/18.0.0
// Set-Cookie: 4DSID=01DD630D4621460A874BF67A487857F0; Path=/; Max-Age=28800; HttpOnly; Version=1
// WWW-Authenticate: Digest realm="acme_test", qop="auth", nonce="212449033986735:84cd652e14718e7062d52286a2c7c150", algorithm=MD5, domain="/", opaque="1675DC5B19854F6E992AF2570EAD8425"
$vt_url:="https://"+$vt_host+$vt_urlEscaped
// will return STATUS 301
ARRAY TEXT($tt_headerKeys; 0)
ARRAY TEXT($tt_headerValues; 0)
//AJOUTER À TABLEAU($tt_headerKeys; "X-STATUS")
//AJOUTER À TABLEAU($tt_headerValues; "301")
WEB SET HTTP HEADER($tt_headerKeys; $tt_headerValues)
WEB SEND HTTP REDIRECT($vt_url; *)
$vp_authenticatedPtr->:=False // if we redirect, we consider the http request unauthenticated
$result:=True
End if
//----------------------------------
// MARK:Utilitaires
//----------------------------------
Function InitResult($Error : Integer; $ErrorDescription : Text; $success : Boolean)->$result : Object
If (Count parameters=0)
$Error:=0
$ErrorDescription:=""
$success:=True
End if
$result:=New object("Error"; $Error; "ErrorDescription"; $ErrorDescription; "success"; $success)
$result.nomMethode:=Current method name
⇧
[class]DicoDesNomsSelect - 17/01/2025 11:47:15
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("DicoDesNomsSelect"; $requête)
This.selection:=Null
This.length:=0
Function CréerRolodex()->$result : Text
// des patronymes webables
This.getEntréesRolodex("patronyme")
$result:=Super.EcrireRolodex("patronyme"; "Web/SelectionnerPatronymes")
// ----------------------
//MARK:Sélection
// ----------------------
Function Créer()->$result : Object
// créer une collection d'entités
This.setEntités()
// filtrer les redondances
This.FiltrerSurPatronyme()
// pour une suite éventuelle
$result:=This
Function FiltrerSurID()
// filtrer les entités de .selection
Super.FiltrerSurID("HTTP_Patronymes")
Function FiltrerSurPatronyme()
// supprimer de .selection les entités de même patronyme
// une sélection doit exister
var $sélection; $patronymes : Collection
var $entité : Object
Case of
: (This.selection=Null)
: (This.selection.length=0)
Else
// sélection filtrée
$sélection:=New collection
// noms différents
$patronymes:=New collection
For each ($entité; This.selection)
If ($patronymes.indexOf($entité.patronyme)=-1)
$patronymes.push($entité.patronyme)
$sélection.push($entité)
End if
End for each
This.selection:=$sélection
This.length:=This.selection.length
End case
// ----------------------
//MARK:HTML
// ----------------------
Function ListerPatronymes()->$result : Text
// renvoyer la liste des patronymes de this.selection, avec lien
var $entité : Object
// les trier
This.selection:=This.selection.orderBy("patronyme asc")
$result:=""
For each ($entité; This.selection)
$result:=$result+$entité.LibelléLiéSurPersonnes()
End for each
Function Ecrire()->$result : Text
// renseigner les informations de la sélection
var $texte : Text
var $entité : cs.DicoDesNoms
var $c : Collection
// créer la sélection
This.Créer()
$result:="<p>"
// ajouter le nombre
$texte:=String(This.length)+" patronyme<plur> rencontré<plur> : "
$texte:=Replace string($texte; "<plur>"; Choose(This.length>1; "s"; ""); *)
$result:=$result+"<span>"+$texte+"</span>"
$c:=New collection
For each ($entité; This.selection)
$c.push($entité.LibelléLiéSurEvents())
End for each
// séparer une une virgule
$result:=$result+$c.join("<span>, </span>")
// fermer
$result:=$result+"</p>"
⇧
[class]$composant - 06/06/2026 12:28:49
property environnement : cs.xSDK.EnvironnementALV
property document : cs.$document
property trace : cs._Trace
property fct : cs.xSDK.Outils
property rsc : cs.xSDK.ResourceALV
Class constructor()
// environnement
This.environnement:=cs.xSDK.EnvironnementALV.new()
This.document:=cs.$document.new()
This.trace:=cs._Trace.me
This.fct:=cs.xSDK.Outils.me
This.rsc:=cs.xSDK.ResourceALV.me
//---------------------
// MARK: Installation
//---------------------
Function InitVariablesWEB()
var $data : Object
Use (Storage)
Storage["System"]:=New shared object
Storage["STR"]:=New shared object
Storage["Host"]:=New shared object
Storage["Application"]:=New shared object
Storage["Processes"]:=New shared object
Storage["ServeurHTTP"]:=New shared object
End use
Use (Storage.System)
// sert, en particulier, pour les process de type monitoring
Storage.System.ArrêtAPP:=False
Storage.System.estExécutéDansHôte:=False
Storage.System.estExécutéDansAPP:=False
// tout le monde n'est pas initialisé ; on ne sait pas si on est serveur Web
Storage.System.estServeurWeb:=False
Storage.System.typeApplication:=This.environnement.typeApplication()
Storage.System.estServeur:=This.environnement.estServeur()
Storage.System.estClient:=This.environnement.estClient()
End use
Use (Storage.Host)
Storage.Host.Session_Etat:=0
End use
Use (Storage.ServeurHTTP)
// fixer le nom du serveur Web
Storage.ServeurHTTP.nom:=File(Structure file; fk platform path).name
End use
// rappel : les constantes sont partagées (=> définies dans SDK)
// partager des ressources
$data:=New object
// fichier de ressources
$data.chemin:=Get 4D folder(Current resources folder)+"DataServeur.xml"
This.rsc.Inscrire(Est Ressource WEB; $data)
Function Installer()
var $path : Text
// installer les ressources du composant
Partager Ressources("Installer Ressources Composant"; New object("dossier"; Get 4D folder(Current resources folder); "IDnom"; "WEB"))
This.InstallerDonnéesHote()
This.IntegerDansHote()
Case of
: (Storage.System.estServeur)
// on est sur un serveur HTTP
This.InstallerServeur()
// lancer le serveur Web
cs.$serveur.new().Demarrer()
// lancer la maintenance
cs.$maintenance.new().Démarrer()
Else
// BDDmère ou APP ou client
End case
Function InstallerDonnéesHote()
// lire les données d'installation
var $data : Object
var $attribut : Text
Case of
: (Not(Storage.System.estExécutéDansHôte))
: (Storage.System.typeApplication=ALV Client APP)
: (Storage.System.typeApplication=4D Remote mode)
// filtrer
Else
$data:=New object
EXECUTE METHOD(Lire Données Hôte Partagées; $data)
// recopier les données reçues
Use (Storage.Host)
For each ($attribut; OB Keys($data))
Storage.Host[$attribut]:=$data[$attribut]
End for each
End use
End case
// utile pour les réactiver en mode compilé
SET ASSERT ENABLED(Storage.Host.Session_Etat ?? 6)
SET ASSERT ENABLED(Storage.Host.Session_Etat ?? 8)
Function InstallerServeur()
// placer les pages HTML et ressources du serveur dans le dossier du site
// rappel : ne concerne pas l'APP autonome (composant non présent)
var $dossierDestination : Object
var $path : Text
This.FixerDatePivot()
// dossier d'installation
$DossierDestination:=cs.$document.new().getRacineHTMLFolder()
If ($dossierDestination=Null)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; Current method name; "InstallerSurServeur [KO], pas de serveur Web actif")
Else
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; Current method name; "InstallerSurServeur [OK] dans "+$dossierDestination.platformPath)
This.InstallerPagesDynamiques($dossierDestination)
This.InstallerRessources($dossierDestination)
This.InstallerRessourcesCARTO($dossierDestination)
This.InstallerRessourcesSSL($dossierDestination)
// installer les ressources Web albums
cs.xALB.$albums.new().InstallerRessourcesSurServeur($dossierDestination)
// fixer le dossier des clés privées
$path:=Get 4D folder(Current resources folder)
This.rsc.SetResourceALV(Est Ressource WEB; "Chemins/Dossier_private_keys"; ->$path)
End if
Function FixerDatePivot()
// rappel : la ressource du composant a une date pivot par défaut pour test (non opérationnelle)
// fixer ici la date à utiliser par le serveur HTTP
var $année : Integer
$année:=Year of(Current date)-100
This.rsc.SetResourceALV(Est Ressource WEB; "Site_Web/Annee_pivot"; ->$année)
Function InstallerPagesDynamiques($dossierDestination : Object)
// Ajouter les pages dynamiques
Dupliquer ContenuDeDossier(Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesPagesWeb"); $dossierDestination)
Function InstallerRessources($dossierDestination : Object)
var $dossier : Object
$dossier:=$dossierDestination.folder("ressources")
$dossier.create()
// Ajouter les feuilles de style
COPY DOCUMENT(Folder(Get 4D folder(Current resources folder); fk platform path).folder("css").platformPath; $dossier.platformPath; *)
// Ajouter les ressources images
COPY DOCUMENT(Folder(Get 4D folder(Current resources folder); fk platform path).folder("images").folder("HTML").platformPath; $dossier.platformPath; "images"; *)
// Ajouter les fichiers Java
COPY DOCUMENT(Folder(Get 4D folder(Current resources folder); fk platform path).folder("javascripts").folder("AinsiLaVie").platformPath; $dossier.platformPath; "js"; *)
Function InstallerRessourcesCARTO($dossierDestination : Object)
If (Storage.System.estExécutéDansHôte)
// ressources OL-IGN
// mêmes ressources que la BDD mère
cs.xCarto.$carte.new().InstallerRessources($DossierDestination.platformPath)
End if
Function InstallerRessourcesSSL($dossierDestination : Object)
// recopier les certificats pour le serveur Web de
var $DossierSource : Object
var $dataTexte : Text:=""
If (Storage.System.estExécutéDansHôte)
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/nomDossierSSL"; Is text; ->$dataTexte)
// rappel : $dataTexte dit quel est le certificat (certifié ou autosigné) à utiliser
// situé dans les ressources hote
$DossierSource:=Folder(Get 4D folder(Current resources folder; *); fk platform path)
$DossierSource:=$DossierSource.folder("SSL").folder($dataTexte)
// dans
$DossierDestination:=cs.$document.new().getCertificatSSLFolder()
// copier les certificats
COPY DOCUMENT($DossierSource.platformPath; $DossierDestination.parent.platformPath; $DossierDestination.name; *)
End if
Function IntegerDansHote()
// BDDmère ou APP ou client
// intégrer le composant dans la base hôte, pour les interfaces :
If (Storage.System.estExécutéDansHôte)
// dans cette version rien à faire
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Intégration"; Current method name; "Intégrer dans base hôte ; application ALV "+String(Storage.System.typeApplication))
End if
Function getStorage()->$result : Object
If (Session.info.type="standalone")
// webStatic ou test local par exemple
$result:=Storage.sessionLocale
Else
// en opération
$result:=Session.storage
End if
//----------------------------------
// MARK:Variables process session
//----------------------------------
// à partir de v9.4.8, les sessions Web sont extensibles
// une même session peut utiliser plusieurs process : les variables d'une même session sont stockées dans Session.storage
// toutes les variables (anciennes variables process) sont stockées dans Session.storage
// les variables process de création des pages Web dynamiques (.shtml) sont restaurées avant chaque envoi d'une page
Function InitSession($portée : Text)
// paramètres communs à tous les contextes
Case of
: (Session=Null)
// en test par exemple
: (Not(OB Is defined(Session; "storage")))
// pourquoi ?
Else
If (Not(OB Is defined(Session.storage; $portée+"_HTTPvars")))
Use (Session.storage)
// tous les attributs de $portée_HTTPvars sont des noms de variables process
Session.storage[$portée+"_HTTPvars"]:=New shared object
// les autres données
Session.storage[$portée+"_Data"]:=New shared object
End use
End if
End case
Function SessionStorageAjouter($classeObjet : 4D.Class; $nomAttribut : Text)
var $sessionStorage; $new_obj : Object
var $classNom : Text
$sessionStorage:=This.getStorage()
Use ($sessionStorage)
$new_obj:=$sessionStorage[$nomAttribut]
If ($new_obj=Null)
$sessionStorage[$nomAttribut]:=New shared object
End if
End use
$classNom:=OB Class($classeObjet).name
Use ($sessionStorage[$nomAttribut])
$new_obj:=$sessionStorage[$nomAttribut][$classNom]
If ($new_obj=Null)
$sessionStorage[$nomAttribut][$classNom]:=New shared object
End if
$sessionStorage[$nomAttribut][$classNom]:=OB Copy($classeObjet; ck shared; $sessionStorage[$nomAttribut][$classNom])
End use
Function RestaurerHTTP_collection($nomCol : Text; $ptr : Pointer)
var $sessionStorage : Object
var $c : Collection
$sessionStorage:=This.getStorage()
$c:=$sessionStorage[$nomCol]
If ($c#Null)
$ptr->:=New collection
$ptr->:=$c.copy()
End if
//----------------------------------
//MARK:Variables contexte
//----------------------------------
Function InitContexte($url : Text)
var $vs4D : Text
$vs4D:="4D4D"
Case of
: ($url="@WebStatic@")
$vs4D:="WEBstatic"
: ($url="@albums@")
$vs4D:="4D4Dalbum"
End case
If (Not(Session.isGuest()))
// cas du serveur Web avec un user connu
$vs4D:="4D4Dprivate"
End if
If (Not(OB Is defined(Session.storage; "HTTPvars")))
Use (Session.storage)
Session.storage.HTTPvars:=New shared object
End use
End if
// stocker
Use (Session.storage.HTTPvars)
Session.storage.HTTPvars.vs4D:=$vs4D
End use
//----------------------------------
//MARK:Données des UserWeb
//----------------------------------
Function InitUserPréférences()->$data : Object
// créer la structure
$data:=New object
// n° de version majeure et 2 n° de sous version à 1 chiffre
This.rsc.SetObjet(Est Ressource WEB; "UserPrefs/Version"; Is longint; $data; "Version")
$data.rolodexPatronyme:="A"
$data.rolodexCommune:="A"
$data.patronyme:=""
$data.Recherche:=New object
$data.Recherche.EtatNavigation:="RechercherPersonnes" // nom page recherche et nom de la function activée
$data.Recherche.Nom:=""
$data.Recherche.Prenom:=""
$data.Recherche.NaissanceStart:=""
$data.Recherche.NaissanceStop:=""
$data.Recherche.NaissanceLieu:=""
$data.Recherche.MariageStart:=""
$data.Recherche.MariageStop:=""
$data.Recherche.MariageLieu:=""
$data.Recherche.DecesStart:=""
$data.Recherche.DecesStop:=""
$data.Recherche.DecesLieu:=""
$data.Recherche.Lieu:=""
$data.Apparence:=New object
$data.Apparence.CodeLangue:="fr"
$data.Apparence.SymbolConjoints:=" & "
$data.Apparence.SymbolDateLieu:=" - "
$data.Apparence.FormatDate:=5
$data.Apparence.FormatHeure:=2
$data.Apparence.FormatLieu:=1
$data.Apparence.FormatGeoLoc:=1
Function LireUserPréférences()
var $data; $userPrefs : Object
var $dossier; $dataTexte : Text
var $version : Integer:=0
Use (Session.storage)
Session.storage.WebUserPrefs:=New shared object
End use
// créer la structure
$data:=This.InitUserPréférences()
// préférences par défaut
Use (Session.storage)
Session.storage.WebUserPrefs:=OB Copy($data; ck shared)
End use
If (Session.isGuest())
// invité WEB, informer l'APP
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Session (guest) "+Session.userName; Current method name; "UserPrefs, aucune")
Else
// user enregistré
// lire les préférences du user
$dataTexte:=This.document.LireLocatedSTR(69)
$dossier:=This.document.getUsersPreferencesFolderPath()+$dataTexte+".json"
If (Test path name($dossier)=Is a document)
// des prefs existent; les lire
$dataTexte:=Document to text($dossier; "UTF-8")
$userPrefs:=JSON Parse($dataTexte; Is object)
This.rsc.SetVariable(Est Ressource WEB; "UserPrefs/Version"; Is longint; ->$version)
Case of
: (Not(OB Is defined($userPrefs; "Version")))
// les prefs doivent être réinitialisées
$userPrefs:=Null
: ($userPrefs.Version<$version)
// les prefs doivent être réinitialisées
$userPrefs:=Null
Else
// format correct; prendre ces données
// attention : si la version a évolué, ce fichier n'est peut être plus au bon format ; récupérer ce qui est compatible !
cs.xSDK.Outils.me.CopierAttributs($userPrefs; $data; False)
End case
Else
// (ré-)initialisation des prefs
$userPrefs:=Null
End if
If ($userPrefs=Null)
// les prefs d'un user ont été réinitilisées, les personnaliser
//%W-533.1
$data.rolodexPatronyme:=Session.storage.WebUser.Name[[1]] // page des patronymes
$data.rolodexCommune:=Session.storage.WebUser.Name[[1]] // page des communes
//%W+533.1
End if
// mémoriser ce qu'on a trouvé
Use (Session.storage)
Session.storage.WebUserPrefs:=OB Copy($data; ck shared)
End use
// Ouvrir le journal
$data:=New object("functionID"; EXT Ouvrir Journal; "Description_Action"; "Ouverture du Journal"; "PartageALV"; 201; "Contexte"; Storage.System.typeApplication)
$data.UserID:=New object("ID"; Session.storage.WebUser.ID; "LogIn"; Session.storage.WebUser.LogIn)
Storage.Host.$dataStore.call(Null).Modifier($data)
// informer l'APP
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Session "+Session.userName; Current method name; "UserPrefs lues dans "+$dossier)
End if
// sélectionner les éléments WEBables en fonction de l'utilisateur
cs.$filtrageDonnees.new().CréerLesFiltres(Session.isGuest())
Function EcrireUserPréférences()
var $dataTexte; $dossier : Text
var $data : Object
Case of
: (Session.isGuest())
: (Session.storage.WebUserPrefs=Null)
: (OB Is empty(Session.storage.WebUserPrefs))
Else
// écrire les données dans le fichier :
$dataTexte:=This.document.LireLocatedSTR(69)
$dossier:=This.document.getUsersPreferencesFolderPath()+$dataTexte+".json"
$dataTexte:=JSON Stringify(Session.storage.WebUserPrefs)
TEXT TO DOCUMENT($dossier; $dataTexte; "UTF-8")
End case
// fermer le journal
$data:=New object("functionID"; EXT Fermer Journal; "Description_Action"; "Fermeture du Journal"; "PartageALV"; 201; "Contexte"; Storage.System.typeApplication)
$data.UserID:=New object("ID"; Session.storage.WebUser.ID; "LogIn"; Session.storage.WebUser.LogIn)
Storage.Host.$dataStore.call(Null).Modifier($data)
Function FermerSession()
// fermeture d'une session Web après le Web_timeout_session ou par le user
var $dossier : Object
ASSERT(This.trace.DebugerVariables("$cs.composant"; Current method name; New object("SessionUserName"; Session.userName))) //"Options"; 0x0002
// mémoriser les données de l'utilisateur courant
This.EcrireUserPréférences()
// purger le contexte
$dossier:=This.document.getSessionFolder()
$dossier.delete(Delete with contents)
//----------------------------------
// MARK:Utilitaires
//----------------------------------
Function InitResult($Error : Integer; $ErrorDescription : Text; $success : Boolean)->$result : Object
If (Count parameters=0)
$Error:=0
$ErrorDescription:=""
$success:=True
End if
$result:=New object("Error"; $Error; "ErrorDescription"; $ErrorDescription; "success"; $success)
$result.nomMethode:=Current method name
⇧
[class]UtilisateursALV - 29/05/2025 19:19:09
// attributs de la classe
property Password : Text
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("UtilisateursALV"; $IDentité)
⇧
[class]$filtrageDonnees - 18/02/2026 10:50:09
Class constructor()
Function CréerLesFiltres($isGuest : Boolean)
var HTTP_Patronymes; HTTP_Personnes; HTTP_Communes; HTTP_Events; HTTP_Lieux; HTTP_Medias : Collection
// filtre Events
If ($isGuest)
This.CréerFiltreEventsInvité()
Else
This.CréerFiltreEventsALVuser()
End if
// autres filtres
This.CréerFiltrePersonnes()
This.CréerFiltrePatronymes()
This.CréerFiltreCommunes()
This.CréerFiltreMedias()
This.EnregistrerLesFiltres()
Function CréerFiltreEventsInvité()
// pour les invités
var $année : Integer:=0
var $dateMin; $dateMax : Date
// Les events antérieurs à l'année pivot
cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Site_Web/Annee_pivot"; Is longint; ->$année)
$dateMin:=Date("01/01/1000")
$dateMax:=Date("01/01/"+String($année))
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Events WHERE Events.dateNum > :$dateMin AND Events.dateNum < :$dateMax INTO :$tabID;
End SQL
HTTP_Events:=New collection
ARRAY TO COLLECTION(HTTP_Events; $tabID)
Function CréerFiltreEventsALVuser()
// pour les utilisateurs reconnus
// * Les events : pas de limite calendaire
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Events INTO :$tabID;
End SQL
HTTP_Events:=New collection
ARRAY TO COLLECTION(HTTP_Events; $tabID)
Function CréerFiltrePersonnes()
// * Les personnes des events
var $c : Collection
// chercher les personnes des événements familiaux
// puis ajouter les personnes des événements perso
ARRAY LONGINT(tabID; 0)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT Relations.membre
FROM EventsFam
LEFT OUTER JOIN (Unions LEFT OUTER JOIN Relations ON Unions.couple = Relations.groupe)
ON EventsFam.famille = Unions.ID
WHERE {fn EstDansCollection('HTTP_Events',EventsFam.evenement) AS NUMERIC} > -1
INTO :tabID;
SELECT DISTINCT personne
FROM EventsPerso
WHERE {fn EstDansCollection('HTTP_Events',EventsPerso.evenement) AS NUMERIC} > -1
INTO :$tabID;
End SQL
// on merge
HTTP_Personnes:=New collection
ARRAY TO COLLECTION(HTTP_Personnes; tabID)
$c:=New collection
ARRAY TO COLLECTION($c; $tabID)
HTTP_Personnes:=HTTP_Personnes.concat($c).distinct()
Function CréerFiltrePatronymes()
// * patronymes des personnes
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT DicoDesNoms.ID
FROM DicoDesNoms
INNER JOIN Personnes ON DicoDesNoms.nom = Personnes.nom
WHERE {fn EstDansCollection('HTTP_Personnes',Personnes.ID) AS NUMERIC} > -1
INTO :$tabID;
End SQL
HTTP_Patronymes:=New collection
ARRAY TO COLLECTION(HTTP_Patronymes; $tabID)
Function CréerFiltreCommunes()
// * communes
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT Sites.commune
FROM Sites
INNER JOIN Lieux ON Lieux.site = Sites.ID
WHERE Lieux.ID IN
(SELECT DISTINCT Lieux.ID
FROM Lieux
INNER JOIN Events ON Events.lieu = Lieux.ID
WHERE {fn EstDansCollection('HTTP_Events',Events.ID) AS NUMERIC} > -1)
INTO :$tabID;
End SQL
HTTP_Communes:=New collection
ARRAY TO COLLECTION(HTTP_Communes; $tabID)
// * les lieux localisés
ARRAY LONGINT(tabID; 0)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT Lieux.ID
FROM Lieux
INNER JOIN Sites ON Lieux.site = Sites.ID
WHERE Sites.ID IN
(SELECT DISTINCT Sites.ID
FROM Sites
INNER JOIN Communes ON Sites.commune = Communes.ID
WHERE {fn EstDansCollection('HTTP_Communes',Communes.ID) AS NUMERIC} > -1)
INTO :tabID;
SELECT DISTINCT Lieux.ID
FROM Lieux
WHERE {fn EstDansTableauNumeric('tabID',Lieux.ID) AS NUMERIC} > -1 AND Lieux.latitude <> 0 AND Lieux.longitude <> 0
INTO :$tabID;
End SQL
HTTP_Lieux:=New collection
ARRAY TO COLLECTION(HTTP_Lieux; $tabID)
Function CréerFiltreMedias()
// * medias des events webables
var $dateMin; $dateMax : Date
var $c : Collection
// remarque : cette sélection contient les documents PDF ET les photos associées aux évents
$dateMin:=Date("01/01/1000")
$dateMax:=Date("01/01/"+String(Year of(Current date)+1-30))
ARRAY LONGINT(tabID; 0)
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT DISTINCT Zones.media
FROM Events
LEFT OUTER JOIN (Instantanes LEFT OUTER JOIN Zones ON Instantanes.zone = Zones.ID)
ON Events.ID = Instantanes.event
WHERE {fn EstDansCollection('HTTP_Events',Events.ID) AS NUMERIC} > -1
INTO :tabID;
SELECT DISTINCT Medias.ID
FROM Medias
WHERE {fn EstDansTableauNumeric('tabID',Medias.ID) AS NUMERIC} > -1 AND Medias.dateNum > :$dateMin AND Medias.dateNum < :$dateMax AND private = 0
INTO :$tabID;
End SQL
HTTP_Medias:=New collection
ARRAY TO COLLECTION(HTTP_Medias; $tabID)
// * medias des lieux webables, non privés
Begin SQL
SELECT DISTINCT Zones.media
FROM Lieux
LEFT OUTER JOIN (Paysages LEFT OUTER JOIN Zones ON Paysages.zone = Zones.ID)
ON Lieux.ID = Paysages.lieu
WHERE {fn EstDansCollection('HTTP_Lieux',Lieux.ID) AS NUMERIC} > -1
INTO :tabID;
SELECT DISTINCT Medias.ID
FROM Medias
WHERE {fn EstDansTableauNumeric('tabID',Medias.ID) AS NUMERIC} > -1 AND private = 0
INTO :$tabID;
End SQL
// on merge
$c:=New collection
ARRAY TO COLLECTION($c; $tabID)
HTTP_Medias:=HTTP_Medias.concat($c).distinct()
Function EnregistrerLesFiltres()
// stocker dans le storage (dépend du contexte)
var $storage : Object
$storage:=cs.$composant.new().getStorage()
Use ($storage)
$storage.HTTP_Events:=New shared collection
$storage.HTTP_Personnes:=New shared collection
$storage.HTTP_Patronymes:=New shared collection
$storage.HTTP_Communes:=New shared collection
$storage.HTTP_Lieux:=New shared collection
$storage.HTTP_Medias:=New shared collection
End use
sharedCollection(HTTP_Events; $storage.HTTP_Events)
sharedCollection(HTTP_Personnes; $storage.HTTP_Personnes)
sharedCollection(HTTP_Patronymes; $storage.HTTP_Patronymes)
sharedCollection(HTTP_Communes; $storage.HTTP_Communes)
sharedCollection(HTTP_Lieux; $storage.HTTP_Lieux)
sharedCollection(HTTP_Medias; $storage.HTTP_Medias)
Function Ajouter($entité : Object)
// ajouter le ID de $entité au bon tableau
var $texte : Text
var $filtre : Collection
var vlVar1; vlVar2 : Integer
// trouver ID et sa collection
$texte:=""
$filtre:=Null
Case of
: (Not(OB Is defined($entité; "DataClassNom")))
: (Not(OB Is defined($entité; "IDunique")))
Else
$texte:="SELECT ID FROM "+$entité.DataClassNom+" WHERE IDunique = '"+$entité.IDunique+"' INTO :vlVar1;"
// la collection
$filtre:=Session.storage["HTTP_"+$entité.DataClassNom]
End case
vlVar1:=-1
Begin SQL
EXECUTE IMMEDIATE :$texte;
End SQL
Case of
: ($filtre=Null)
: (vlVar1=-1)
: ($filtre.indexOf(vlVar1)>-1)
// l'entité existe déjà dans le tableau
Else
Use ($filtre)
$filtre.push(vlVar1)
End use
End case
⇧
[class]$pageWebCARTO - 08/04/2025 10:41:17
property carto : cs.xCarto.$carte
Class extends $pageWeb
Class constructor()
Super()
This.carto:=cs.xCarto.$carte.new()
Function Cartographier()
This.InitSession("CARTO")
This.FixerParamsCarte()
// créer les data de la carte
This.CréerRessourcesCarte()
// envoyer la page
This.Envoyer("cartographieWeb.shtml"; "cartographie"; "CARTO_HTTPvars")
Function FixerParamsCarte()
Use (Session.storage.CARTO_HTTPvars)
// transmettre à .getCarteData()
Session.storage.CARTO_HTTPvars.wwwRacineRessources:="../../"
Session.storage.CARTO_HTTPvars.wwwContexteWeb:="ALVserveur"
// initialiser les variables process contenus dans la carte
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Opacity_OSM"; Is text; Session.storage.CARTO_HTTPvars; "wwwCarto_Opacity_OSM")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Install_GP"; Is text; Session.storage.CARTO_HTTPvars; "wwwCarto_Install_GP")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Opacity_GP"; Is text; Session.storage.CARTO_HTTPvars; "wwwCarto_Opacity_GP")
Session.storage.CARTO_HTTPvars.wwwCarto_Opacity_Cible:="0.0"
// zoom
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_ZoomMin_OL"; Is text; Session.storage.CARTO_HTTPvars; "wwwZoneWeb_ZoomMin")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_ZoomMax_OL"; Is text; Session.storage.CARTO_HTTPvars; "wwwZoneWeb_ZoomMax")
End use
Function CréerRessourcesCarte()
// créer les données de la carte
var $params : Object
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Création"; Current method name; "Carte de "+Séparateur webURLparams+This.paramsUrl[0]+Séparateur webURLparams+This.paramsUrl[1])
$params:=New object
// init de la sélection de lieux et des paramètres associés de la zone à afficher (la zone)
Case of
: (This.paramsUrl.length<2)
$params.sélection:=Null
: (Num(This.paramsUrl[1])<1)
// tous les lieux
$params.sélection:=New collection(New object("DataClassNom"; "Lieux"; "IDs"; Session.storage.HTTP_Lieux))
Else
// l'entité à cartographier (entité réduite , ici pas de DataStore)
// le composant CARTO travaille sur des ID d'entités, ici on est sur des UUID
$params.sélection:=New collection(New object("DataClassNom"; This.paramsUrl[0]; "IDs"; New collection(cs[This.paramsUrl[0]].new(This.paramsUrl[1]).ID)))
End case
If ($params.sélection#Null)
// récepteur des variables process
$params.HTTPvars:=OB Copy(Session.storage.CARTO_HTTPvars)
// dossier où mettre les données
$params.cheminRacineHTML:=This.document.getRacineHTMLFolder().platformPath
// dossier de sessions
$params.cheminSessionFolder:=This.document.getSessionFolder().platformPath
$params.sousDossierImages:="images"
// pour la page Web, icones d'instance vues au niveau de la session
$params.dossierCartoURL:=$params.HTTPvars.wwwRacineRessources+This.document.LireLocatedSTR(129)+"/"+Session.id
// urls sur le serveur Web
$params.nomFichierMarkers:="dataGP_"+This.paramsUrl[1]+".js"
// formats pour serveur Web
$params.Apparence:=New object("CodeLangue"; "fr"; "SymbolConjoints"; " & "; "SymbolDateLieu"; " - "; "FormatDate"; 5; "FormatHeure"; 2; "FormatLieu"; 1; "FormatGeoLoc"; 1)
$params.PopUpOptions:=New object("Lieux"; 0x00040000; "Communes"; 0x00C80000; "Departements"; 0x00C80000; "Regions"; 0x00880000; "Pays"; 0x0000)
$params.PopUpLiens:=True
// demander la carte et générer ses données de session
This.carto.getCarteData($params)
// installer les ressources carto
This.carto.InstallerRessources($params.cheminRacineHTML)
// créer les fichiers
This.carto.InstallerDonnées($params)
// récupérer les MarkersData
Use (Session.storage.CARTO_Data)
Session.storage.CARTO_Data.MarkersData:=$params.data.MarkersData
End use
// récupérer les variables process
sharedObject($params.data.HTTPvars; Session.storage.CARTO_HTTPvars)
End if
⇧
[class]Pays - 29/05/2025 19:00:43
// attributs de la classe
property nom : Text
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Pays"; $IDentité)
Function Libellé($formats : Object)->$libellé : Text
// renvoie le nom formaté suivant les options $1
// .Options
// aucune
$libellé:=This.nom
// ----------------------
//MARK:Sélections
// -----------------------
Function LesDepartements()->$result : cs.DepartementsSelect
var $c : Collection
$c:=This.dataClass.LesDepartements()
$result:=cs.DepartementsSelect.new($c)
$result.Créer()
// trier les départements par numéro
$result.selection:=$result.selection.orderBy("numero asc")
// ----------------------
//MARK:Modification
// -----------------------
Function Modifier($params : Object)->$result : Object
// voir si le pays a été modifié
var $data : Object
$result:=This.InitResult()
// nouveaux attributs?
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom")))
: (This.nom=$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom)
Else
$data:=OB Copy(This)
$data.nom:=$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom
$result:=This.ModifierDansDataStore(This; $data)
End case
⇧
[class]MediasSelect - 29/05/2025 17:43:21
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("MediasSelect"; $requête)
This.selection:=Null
This.length:=0
// ----------------------
//MARK:Sélection
// ----------------------
Function FiltrerSurID($filtre : Text)
// filtrer les entités de .selection
Super.FiltrerSurID($filtre)
Function FiltrerLesPrivés()
This.selection:=This.selection.query("private = :1 OR private = :2"; 0; Session.storage.WebUser.leGroupe.IDfamille)
// ----------------------
//MARK:Diaporama
// ----------------------
Function EcrireTableauVignettes()->$result : Text
// créer le tableau des vignettes des media
var $entité : Object
var $path : Text
$result:=""
Case of
: (This.selection=Null)
: (This.selection.length=0)
Else
// liste des medias à tabloter
$result:="<article id="+Char(Quote)+"menuVignettes"+Char(Quote)+" class="+Char(Quote)+"contener_mediacentre"+Char(Quote)+" style="+Char(Quote)+"visibility:"+Choose(This.selection.length>0; "visible"; "hidden")+Char(Quote)+">"
$result:=$result+"<table><tbody><tr>"
For each ($entité; This.selection)
$result:=$result+"<td id="+Char(Double quote)+"diapo_"+String($entité.ID)+Char(Double quote)+">"
Case of
: ($entité.type=1)
// URL de la vignette de l'image
$path:=This.document.getHostMediaPath("URLMedia"; $entité; New object("attribute"; "icône"))
$result:=$result+"<a onclick="+Char(Double quote)+"Visualiser('#openDiaporama','IndexMedia','"+String(This.selection.indexOf($entité))+"')"+Char(Double quote)+">"
$result:=$result+"<img alt="+Char(Double quote)+"media_"+String($entité.ID)+Char(Double quote)+" title="+Char(Double quote)+$entité.titre+Char(Double quote)+" src="+Char(Double quote)+$path+Char(Double quote)
: ($entité.type=2)
// fixer l'URL absolue de l'entité [Medias] sur l'hébergeur
$path:=This.document.getHostMediaPath("URLMedia"; $entité; New object("attribute"; "ID"))
// ajouter le lien : il doit ouvrir le PDF dans une page Web
$result:=$result+"<a href="+Char(Double quote)+$path+Char(Double quote)+"title="+Char(Double quote)+$entité.titre+Char(Double quote)+">"
// ajouter la vignette
// URL de la vignette du PDF
$path:=This.document.getHostMediaPath("URLMedia"; $entité; New object("attribute"; "icône"))
$result:=$result+"<img alt="+Char(Double quote)+"media_"+String($entité.ID)+Char(Double quote)+" src="+Char(Double quote)+$path+Char(Double quote)
End case
// terminer la balise (pour le format flex)
Case of
: ($entité.largeur>=$entité.hauteur)
$result:=$result+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: ($entité.largeur<$entité.hauteur)
$result:=$result+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$result:=$result+"</a>"
$result:=$result+"</td>"
End for each
$result:=$result+"</tr></tbody></table>"
End case
$result:=$result+"</article>"
Function EcrireMenusVignette()->$result : Text
var $entité : cs.Medias
var $path : Text
$result:=""
Case of
: (This.selection=Null)
: (This.selection.length=0)
Else
$result:="<table><tbody><tr>"
// créer un élément du tableau avec la sélection d'entités this
For each ($entité; This.selection)
// URL de l'image
$path:=This.document.getHostMediaPath("URLMedia"; $entité; New object("attribute"; "icône"))
$result:=$result+"<td><a onClick="+Char(Double quote)+"GotoMedia("+String(This.selection.indexOf($entité))+")"+Char(Double quote)+">"
$result:=$result+"<img alt="+Char(Double quote)+"media_"+String($entité.ID)+Char(Double quote)+" title="+Char(Double quote)+$entité.titre+Char(Double quote)+" src="+Char(Double quote)+$path+Char(Double quote)
// terminer la balise (pour le format flex)
Case of
: ($entité.largeur>=$entité.hauteur)
$result:=$result+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: ($entité.largeur<$entité.hauteur)
$result:=$result+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$result:=$result+"</a>"
$result:=$result+"</td>"
End for each
$result:=$result+"</tr></tbody></table>"
End case
// ----------------------
//MARK:Maintenance
// ----------------------
Function CréerMediasWebables($data : Object; $params : Object)
// créer les medias affichables sur le serveur
var $entité : cs.Medias
For each ($entité; This.selection) While (Not($data.tache.partage.Tuer.signaled))
$entité.CréerVersionWebable($params)
End for each
⇧
[class]_SousFormulaire - 31/05/2025 16:51:17
property nomOBJ : Text:=""
property functionID : Text
Class extends $composant
Class constructor()
Super()
// ----------------------
//MARK:Traitement
// ----------------------
Function TraiterFORMevent()
If (OB Is defined(FORM Event; "objectName"))
// event d'un objet formulaire
This.functionID:="_fct_"+FORM Event.objectName
This.nomOBJ:=FORM Event.objectName
Else
// event du formulaire
This.functionID:="_fct_Formulaire"
This.nomOBJ:=""
End if
If (OB Is defined(This; This.functionID))
This[This.functionID]()
End if
Function EditerRessource($ressourceID : Integer; $pathXML : Text; $typeValeur : Integer)
// éditer la valeur de Form.This.nomOBJ par lecture / écriture d'une ressource application
// $pathXML = chemin dans une ressource de composant
// (par principe la donnée est éditée dans le Form d'un formulaire
var data9 : Integer
var data2 : Text
var $ptr : Pointer
This.trace.Initialiser(Current method name)
data9:=0
data2:=""
// la données est typée dans le fichier .xml : le type de This.nomOBJ n'est pas accessible
// en particulier au chargement du formulaire, la donnée n'existe pas
$ptr:=Get pointer("data"+String($typeValeur))
If (Type($ptr->)=Is undefined)
This.trace.Error:=-15086
This.trace.ErrorDescription:="Type variable "+String($typeValeur)+" non reconnu"
Else
This.trace.Error:=-16003*Num(Not(This.rsc.SetVariable($ressourceID; $pathXML; $typeValeur; $ptr)))
This.trace.ErrorDescription:="$ressourceID : "+String($ressourceID)+", Propriété : "+This.nomOBJ+", xPath : "+$pathXML
End if
Case of
: (This.trace.Error#0)
: (Form=Null)
This.trace.Error:=-15086
This.trace.ErrorDescription:="Form est nul"
: (Form event code=On Load)
Form[This.nomOBJ]:=$ptr->
: (Form event code=On Data Change)
$ptr->:=Form[This.nomOBJ]
This.trace.Error:=-16003*Num(Not(This.rsc.SetResourceALV($ressourceID; $pathXML; $ptr)))
End case
This.trace.FixerSuccess()
This.trace.LeverException([msgk_event; msgk_log])
⇧
[class]EventsSelect - 22/04/2025 15:10:46
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("EventsSelect"; $requête)
This.selection:=Null
Function LesProtagonistes()->$result : cs.PersonnesSelect
$result:=cs.PersonnesSelect.new(This.dataClass.LesProtagonistes())
Function FiltrerSurPatronyme()->$result : cs.EventsSelect
// ne retenir que les entités de this liées à une personne de patronyme Session.storage.UserParams.personne
var $texte : Text
var $sessionStorage; $entité : Object
var $ID; $i : Integer
$sessionStorage:=This.getStorage()
If ($sessionStorage.UserParams.UUIDpatronyme="")
$result:=This
Else
$result:=cs.EventsSelect.new()
$result.selection:=New collection
// récupérer toutes les personnes ayant ce patronyme
$texte:=Session.storage.UserParams.UUIDpatronyme
ARRAY LONGINT(tabID; 0)
Begin SQL
SELECT Personnes.ID FROM Personnes
INNER JOIN DicoDesNoms ON DicoDesNoms.nom = Personnes.nom
WHERE DicoDesNoms.IDunique = :$texte
INTO :tabID;
End SQL
// chercher les personnes des événements de cette commune
For each ($entité; This.selection)
$ID:=$entité.ID
ARRAY LONGINT($tabID; 0)
Case of
// essayer les personnes d'eventFam
: ($entité.type>33000)
Begin SQL
SELECT DISTINCT Relations.membre FROM EventsFam
LEFT OUTER JOIN (Unions LEFT OUTER JOIN Relations ON Unions.couple = Relations.groupe)
ON EventsFam.famille = Unions.ID
WHERE EventsFam.evenement = :$ID
INTO :$tabID;
End SQL
// essayer les personnes d'eventPerso
: ($entité.type<33000)
Begin SQL
SELECT DISTINCT Personnes.ID
FROM EventsPerso
INNER JOIN Personnes ON EventsPerso.personne = Personnes.ID
WHERE EventsPerso.evenement = :$ID
INTO :$tabID;
End SQL
End case
// on a des personnes
If (Size of array($tabID)>0)
// voir si au moins une a le bon patronyme
For ($i; Size of array($tabID); 1; -1)
If (Find in array(tabID; $tabID{$i})>-1)
// celle-là oui, on garde l'event
$result.selection:=$result.selection.push($entité)
$i:=0
End if
End for
End if
End for each
$result.length:=$result.selection.length
End if
Function FiltrerSurDecennie($data : Object)->$result : cs.EventsSelect
var $c : Collection
$c:=This.selection
// filtrer la décennie
$c:=$c.query("(dateNum >= :1 AND dateNum < :2) OR type = 22800 OR type = 33800"; $data.dateMin; $data.dateMax)
// acte religieux ou acte républicain selon la date pivot
$c:=$c.query("(dateNum < :1 AND (type = 22100 OR type = 22300 OR type = 33700)) OR (dateNum >= :1 AND (type = 22000 OR type = 22100 OR (type >= 33611 AND type <= 33613)))"; Date("06/10/1793"))
$result:=cs.EventsSelect.new()
$result.selection:=$c
$result.length:=$result.selection.length
// ----------------------
//MARK:PageHTML
// ----------------------
Function EcrireDecennie($data : Object)->$result : Text
var $event : cs.Events
$result:="<h2>"+String($data.index)+" - "+String($data.index+9)+"</h2>"
For each ($event; This.selection)
$result:=$result+$event.EtatCivil($data.formats)
End for each
Function Information($formats : Object)->$result : Text
var $event : cs.Events
$result:=""
For each ($event; This.selection)
$result:=$result+$event.BioData($formats)
End for each
⇧
[class]Departements - 30/05/2025 14:40:56
property laRegion : cs.Regions
// attributs de la classe
property numero : Integer
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Departements"; $IDentité)
// ----------------------
//MARK:Sélections
// -----------------------
Function LesCommunes()->$result : cs.CommunesSelect
var $c : Collection
$c:=This.dataClass.LesCommunes()
$result:=cs.CommunesSelect.new($c)
$result.Créer()
// trier les communes par nom
$result.selection:=$result.selection.orderBy("nom asc")
// ----------------------
//MARK:Saisie
// -----------------------
Function Modifier($params : Object)->$result : Object
// ici, voir si le département n'a pas été modifié
var $data : Object
$result:=This.InitResult()
// nouveaux attributs?
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_numero")))
: (This.numero=$params.leLieu_leSite_laCommune_leDepartement_numero)
Else
$data:=OB Copy(This)
$data.numero:=$params.leLieu_leSite_laCommune_leDepartement_numero
$result:=This.ModifierDansDataStore(This; $data)
End case
// si nouveau pays, le créer
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom")))
// pas trop normal
$result.Error:=-15068
$result.ErrorDescription:="$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom n'est pas défini"
: (This.Le("Pays").nom=$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom)
// le département est accroché au bon endroit
Else
// on est dans un nouveau pays
// créer une région au département
$result:=This.Ajouter(WEB Ajouter Région; $params)
End case
⇧
[class]Medias - 31/05/2025 16:42:03
// attributs de la classe
property largeur; hauteur; type; private : Integer
property titre; nomFichier; Credits; dateChaine : Text
property dateNumValid : Boolean
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Medias"; $IDentité)
// ----------------------
//MARK:Maintenance
// ----------------------
Function CréerVersionWebable($params : Object)
// créer dans le dossier de travail un media filigrané et de taille adaptée
var $data; $result; $mediaInformation : Object
var $dateModification : Date
var $heureModification : Time
$result:=This.estNonAjour($params)
If ($result.success)
// créer le Web media, en fonction du type, dans le dossier de travail
$data:=New object
// chemin sur host du dossier de l'entité
$data.urlDossier:=This.document.getHostFolderPath("BddMedia"; This)
// dossier où enregistrer le media ; on se met au format des dossiers sur le site (cf le téléversement)
$data.cheminDossier:=This.document.CréerDossier($params.dossierTravail.platformPath; New collection("folder_"+String($params.IDvolume))).platformPath
// récupérer le fichier sur l'hébergeur// ramener le fichier
$data.nomFichier:=String(This.ID; "00000")+(".alvprv"*Num(This.private#0))+".xfam.b64"
$result:=This.serveur.TelechargerFichier($data; $data.cheminDossier)
// si ok, le fichier est dans $result.fichier
Case of
: ($result.Error#0)
: (This.type=1)
// * créer l'image Webinée dans le dossier de travail
$data.cheminFichier:=$data.cheminDossier+$result.fichier.fullName
This.CréerImageWEB($data)
: (This.type=2)
// * créer le PDF WeBiné dans le dossier
$data.fichier:=Folder($data.cheminDossier; fk platform path).file($result.fichier.fullName)
$result:=This.CréerPDFWEB($data)
End case
If ($result.Error=0)
// créer l'imagette
This.CréerImagetteWEB($data)
DELETE DOCUMENT($data.cheminFichier)
// mettre à jour le catalogue Web (rappel : $mediaInformation est un lien à $cataloguesWeb, pas une copie)
// obtenir l'horodatage du fichier en BDD
$dateModification:=OB Get(OB Get(OB Get($params.cataloguesBDD; String($params.IDvolume); Is object); String(This.ID; "00000")+".xfam.b64"; Is object); "dateModification"; Is date)
$heureModification:=OB Get(OB Get(OB Get($params.cataloguesBDD; String($params.IDvolume); Is object); String(This.ID; "00000")+".xfam.b64"; Is object); "heureModification"; Is time)
$mediaInformation:=New object("dateModification"; $dateModification; "heureModification"; $heureModification)
$params.cataloguesWeb[String($params.IDvolume)][This.nomFichier]:=OB Copy($mediaInformation)
End if
This.trace.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_log])
// respirer un peu
Waiting(1)
End if
Function estNonAjour($params : Object)->$result : Object
var $data; $mediasInformation; $mediaInformation : Object
var $dateModification : Date
var $heureModification : Time
$result:=This.InitResult()
// quel est le ID catalogue (ID volume)?
$data:=New object
This.document.VolumeDeMedia(This; $data)
// obtenir l'horodatage du fichier en BDD
$dateModification:=OB Get(OB Get(OB Get($params.cataloguesBDD; String($data.ID); Is object); String(This.ID; "00000")+".xfam.b64"; Is object); "dateModification"; Is date)
$heureModification:=OB Get(OB Get(OB Get($params.cataloguesBDD; String($data.ID); Is object); String(This.ID; "00000")+".xfam.b64"; Is object); "heureModification"; Is time)
// lire l'horodatage sur l'hébergeur
// le fichier existe dans le catalogue?
$mediasInformation:=OB Get($params.cataloguesWeb; String($data.ID); Is object)
$result.success:=Not(OB Is defined($params.cataloguesWeb; String($data.ID)))
$result.success:=$result.success | (Not(OB Is defined($mediasInformation; This.nomFichier)))
If (Not(OB Is defined($mediasInformation; This.nomFichier)))
// le créer
// annuler l'horodatage (forcera la mise à jour)
OB SET($mediaInformation; "dateModification"; !00-00-00!)
OB SET($mediaInformation; "heureModification"; ?00:00:00?)
// ajouter au catalogue
OB SET($mediasInformation; This.nomFichier; $mediaInformation)
// créer le catalogue (au besoin)
If (Not(OB Is defined(OB Get($params.cataloguesWeb; String($data.ID); Is object))))
OB SET($params.cataloguesWeb; String($data.ID); $mediasInformation)
End if
End if
// faut-il mettre à jour?
$mediaInformation:=OB Get($mediasInformation; This.nomFichier; Is object)
$result.success:=(($dateModification>OB Get($mediaInformation; "dateModification"; Is date)) | (($dateModification=OB Get($mediaInformation; "dateModification"; Is date)) & ($heureModification>OB Get($mediaInformation; "heureModification"; Is time))))
// renvoyer IDvolume
$params.IDvolume:=$data.ID
Function CréerImageWEB($data : Object)
// utiliser l'image du fichier .cheminFichier pour créer dans le dossier .cheminDossier
// . une image recadrée pour diaporama Web
var $pict : Picture
var $fichier : Object
READ PICTURE FILE($data.cheminFichier; $pict)
// * créer son image Webinée
// la mettre à la bonne taille
$data.largeur:=Num(Web Image largeur maximale)
$data.hauteur:=Num(Web Image hauteur maximale)
This.RetaillerImage(->$pict; $data)
// ajouter le fichier image au dossier
$fichier:=Folder($data.cheminDossier; fk platform path).file(This.document.getNomFichierMedia(This; New object("attribute"; "ID")))
WRITE PICTURE FILE($fichier.platformPath; $pict; Web Image format) // remarque : le codec utilisé est choisi en fonction de l'extension du fichier
// filigraner
This.serveur.Filigraner(New object("fichier"; $fichier; "type"; This.type); This.Credits; 40; 20; 0; "blue")
Function CréerPDFWEB($data : Object)->$result : Object
// dans cette version le serveur sert le même fichier PDF que celui de la BDD (pas de retaillage)
$result:=This.InitResult()
$result.nomMethode:=Current method name
// filigraner tout le document
This.serveur.Filigraner(New object("fichier"; $data.fichier; "type"; This.type); This.Credits; 40; 20; 0; "blue")
// renommer
$data.fichier:=$data.fichier.rename(This.document.getNomFichierMedia(This; New object("attribute"; "ID")))
// créer le fichier pour son imagette Webinée
// lire la page 1 du document
$data.fichierTempo:=File(Temporary folder+"tempo.png"; fk platform path)
// le zoom n'a pas d'importance, on retaille après
$result.Error:=Storage.Host.$document.call(Null).ConvertirPageDansFichier($data.fichier.platformPath; 1; 1; $data.fichierTempo.platformPath)
$result.ErrorDescription:="le fichier de la page 1 du document PDF <"+$data.fichier.platformPath+"> n'est pas créé"
// renvoyer le chemin du fichier :
$data.cheminFichier:=$data.fichierTempo.platformPath
Function CréerImagetteWEB($data : Object)
// utiliser l'image du fichier .cheminFichier pour créer dans le dossier .cheminDossier
// . une icone Web
var $fichier : 4D.File
var $pict : Picture
READ PICTURE FILE($data.cheminFichier; $pict)
// la mettre à la bonne taille
$data.largeur:=Num(Web Imagette largeur)
$data.hauteur:=Num(Web Imagette hauteur)
This.RetaillerImage(->$pict; $data)
// ajouter le fichier image au dossier
$fichier:=Folder($data.cheminDossier; fk platform path).file(This.document.getNomFichierMedia(This; New object("attribute"; "icône")))
WRITE PICTURE FILE($fichier.platformPath; $pict; Web Imagette format)
Function RetaillerImage($pict : Pointer; $data : Object)
// formater l'image $2 (largeur max $3, hauteur max $4)
var $zoom : Real
var $width; $height; $gauche; $haut; $droite; $bas : Integer
$zoom:=-Scaled to fit prop centered // format d'affichage de l'image
$gauche:=0
$haut:=0
$droite:=$data.largeur
$bas:=$data.hauteur
PICTURE PROPERTIES($pict->; $width; $height)
This.fct.CalculerRectangleMedia(->$gauche; ->$haut; ->$droite; ->$bas; $width; $height; ->$zoom)
$pict->:=$pict->*$zoom
⇧
[class]PersonnesSelect - 22/04/2025 14:00:15
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("PersonnesSelect"; $requête)
This.selection:=Null
This.length:=0
// ----------------------
//MARK:Selection
// -----------------------
Function LesPatronymes()->$result : cs.DicoDesNomsSelect
$result:=cs.DicoDesNomsSelect.new(This.dataClass.LesPatronymes())
Function TrierSelectionRecherche()
// trier par nom / prenom
This.selectionRecherche:=This.selectionRecherche.orderBy("itemNom asc")
Function trierParDate($formats : Object)
// trier la sélection de personnes par la date de naissance
var $sensDuTri : Integer
$sensDuTri:=dk ascending
// $sensDuTri:=dk descending // pour test !
Case of
: (Count parameters=0)
: (OB Is defined($formats; "sensDuTri"))
$sensDuTri:=$formats.sensDuTri
End case
TRACE
//$result:=This.selection.orderBy("This.lesEvents.Naissance().dateNum"; $sensDuTri)
// ----------------------
//MARK:HTML
// -----------------------
Function ListerNomsPersonnes($params : Object)->$result : Text
// lister les personnes Webables
This.selection:=This.dataClass.CollecterNomsSurID()
$result:=This.EcrireListeNoms($params)
Function EcrireSelection()->$result : Text
var $sessionStorage; $formats; $entité : Object
var $texte : Text
$sessionStorage:=This.getStorage()
// fixer les formats affichage
$formats:=OB Copy($sessionStorage.WebUserPrefs.Apparence)
$formats.Options:=0x350F
$result:=""
For each ($entité; This.selection)
// créer la biographie de la personne
$texte:=$entité.Biographie($formats)
// $texte vide au cas où tous les events sont autres que naissance décès, mariage
If ($texte#"")
$texte:=Replace string($texte; ", "; " "; 1) // supprimer la première virgule
$result:=$result+"<p>"+$texte+"</p>"
End if
End for each
⇧
[class]$maintenanceSite - 06/06/2026 19:21:29
// par conception cette classe est indépendante des classes du serveur Web
// principe : pour chaque page du site, créer ses paramètres de construction et appeler le template du serveur Web
// => appel des classes $pageWebXXX du serveur Web
property destination; params; page; DataStoreSelect : Object
property nomTache : Text:="Création_siteWeb"
property tache : cs.xSDK.Tache
Class extends $pageWeb
Class constructor()
Super()
// créer un dossier de travail pour la génération des pages
This.destination:=New object("dossierRacine"; cs.$document.new().getDossierTravail().folder("WEB_TempoPagesWEB"))
This.destination.dossierRacine.delete(Delete with contents)
This.destination.dossierRacine.create()
// paramètres globaux
This.params:=New object
// ressources du composant !
This.params.ressourcesALV:=Folder(Get 4D folder(Current resources folder); fk platform path)
// paramètres globaux
This.page:=New object("name"; ""; "template"; "")
Function OuvrirSession()
var $data : Object
// fixer les variables d'une session Web
COMPILER_WEB
// fixer le contexte WEBstatic
vs4D:="WEBstatic"
// les classes utilisent des préférences de la session utilisateur
// ici pas de session ; les préférences sont dans Storage
// rappel : $composant.getStorage() choisit le storage en fonction du contexte
Use (Storage)
Storage.sessionLocale:=New shared object
Use (Storage.sessionLocale)
Storage.sessionLocale.WebUserPrefs:=New shared object
Storage.sessionLocale.UserParams:=New shared object
End use
End use
$data:=This.InitUserPréférences()
sharedObject($data; Storage.sessionLocale.WebUserPrefs)
Function FermerSession()
Use (Storage)
Storage.sessionLocale:=Null
End use
Function Créer($data : Object)
var $source; $result : Object
var $url : Text:=""
This.tache:=$data.tache
// v8.2.10 : les composants sont installés par des alias. Ce principe perburbe le fonctionnement de la balise 4DINCLUDE dans "TRAITER BALISES 4D" (alias non résolu?)
// copier temporairement les fichiers ressources dans la base hôte (fonctionne aussi si l'exécution est dans le composant)
$source:=Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesPagesWeb")
$source.copyTo(Folder(Get 4D folder(Current resources folder; *); fk platform path); "TemplatesPagesServeurWeb"; fk overwrite)
// créer une session utilisateur
This.OuvrirSession()
MESSAGES OFF
// init affichage avancement
This.AfficherAvancement(0; This.document.LireLocatedSTR(5202))
// vider le contenu du dossier de travail
This.destination.dossierRacine.delete(Delete with contents)
This.destination.dossierRacine.create()
// ajouter les ressources
This.AjouterRessources()
$source:=Folder(fk resources folder).folder("TemplatesPagesWeb").file("favicon.ico")
$source.copyTo(This.destination.dossierRacine)
//sélectionner les éléments WEBables
// * events limités au public
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; This.document.LireLocatedSTR(5202))
cs.$filtrageDonnees.new().CréerLesFiltres(True)
This.AfficherAvancement(500; This.document.LireLocatedSTR(5202))
// les ensembles d'enregistrements utilisables sont créés
// lancer la génération des pages
Waiting(10)
// * créer la page d'accueil
This.page.name:="index.html"
This.page.template:="accueil.shtml"
This.destination.sousDossierPages:=""
This.CréerPageHTML()
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; This.document.LireLocatedSTR(5118))
// lister les pages patronymes à créer
This.getEntréesRolodexPatronymes()
// créer les pages des listes patronymiques
This.CréerPagesRolodexPatronymes()
// créer les pages des listes de personnes
This.CréerPagesListePersonnes()
Waiting(10)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; This.document.LireLocatedSTR(5119))
// lister les pages commune à créer
This.getEntréesRolodexCommunes()
// créer les pages des listes patronymiques
This.CréerPagesRolodexCommunes()
// créer les pages des listes de personnes
This.CréerPagesEtatCivil()
Waiting(10)
// * créer les pages de cartographie
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; This.document.LireLocatedSTR(5120))
This.AfficherAvancement(8500; This.document.LireLocatedSTR(5120))
This.CréerPageCartographie()
MESSAGES ON
This.FermerSession()
// purger le dossier tempo
Folder(fk resources folder).folder("TemplatesPagesServeurWeb").delete(Delete with contents)
// * transférer sur l'hébergeur
This.AfficherAvancement(8700; "Téléversement")
This.rsc.SetVariable(Est Ressource HOST; "Chemins/siteWEBstatique/Path"; Is text; ->$url)
//$url:="/AinsiLaVie/siteWeb/test/" // pour test
// supprimer l'ancien répertoire
$result:=This.serveur.SupprimerRépertoire($url)
// envoyer
$source:=This.destination.dossierRacine
$result:=This.serveur.EnvoyerDossier($source; $url)
// c'est fini
This.AfficherAvancement(10000; "")
Waiting(60)
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; This.document.LireLocatedSTR(5203))
// purger
This.destination.dossierRacine.delete(Delete with contents)
Function AjouterRessources()
var $destination; $source : Object
// Ajouter les feuilles de style
$destination:=Folder(This.destination.dossierRacine.path+"/ressources/")
$destination.create()
$source:=This.params.ressourcesALV.folder("css")
$source.copyTo($destination; fk overwrite)
// Ajouter les ressources images
$source:=This.params.ressourcesALV.folder("Images/HTML")
$source.copyTo($destination; "images"; fk overwrite)
// Ajouter les fichiers Java
$destination:=Folder(This.destination.dossierRacine.path+"/ressources/")
$destination.create()
$source:=This.params.ressourcesALV.folder("javascripts/AinsiLaVie")
$source.copyTo($destination; "js"; fk overwrite)
// version IGN
$destination:=$destination.folder("js")
$source:=This.params.ressourcesALV.folder("javascripts/GeoPortail")
$source.copyTo($destination; fk overwrite)
//----------------------
//MARK:Rolodex
//----------------------
Function getEntréesRolodexPatronymes()
// renvoyer la collection de l'initiale de tous les patronymes
var $c : Collection
// lister les initiales non doublonnées des patronymes
$c:=New collection
This.RestaurerHTTP_collection("HTTP_Patronymes"; ->$c)
This.DataStoreSelect:=cs.DicoDesNomsSelect.new($c)
This.DataStoreSelect.getEntréesRolodex("patronyme")
Function CréerPagesRolodexPatronymes()
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Traitement de "+String(This.DataStoreSelect.entreesRolodex.length)+" entrées")
This.AfficherAvancement(500; This.document.LireLocatedSTR(5116))
// dossier de stockage
This.destination.sousDossierPages:=This.document.getSousDossierPatronymes()
Folder(This.destination.dossierRacine.path+This.destination.sousDossierPages).create()
// paramètres des templates de pages
wwwEtatNavigation:="liste_patronymes"
This.tache.FixerParamsAvancement(500; 1500) // fin 2000
This.CréerPagesRolodex("rolodexPatronyme")
Function getEntréesRolodexCommunes()
// renvoyer la collection de l'initiale de tous les patronymes
var $c : Collection
// lister les initiales non doublonnées des patronymes
$c:=New collection
This.RestaurerHTTP_collection("HTTP_Communes"; ->$c)
This.DataStoreSelect:=cs.CommunesSelect.new($c)
This.DataStoreSelect.getEntréesRolodex("nom")
// ici on a besoin des functions de cs.communes
// remplacer dans .selection les classes SQL par les locales
This.DataStoreSelect.Créer()
Function CréerPagesRolodexCommunes()
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Traitement de "+String(This.DataStoreSelect.entreesRolodex.length)+" entrées")
This.AfficherAvancement(4500; This.document.LireLocatedSTR(5117))
// dossier de stockage
This.destination.sousDossierPages:=This.document.getSousDossierCommunes()
Folder(This.destination.dossierRacine.path+This.destination.sousDossierPages).create()
// paramètres des templates de pages
wwwEtatNavigation:="liste_communes"
This.tache.FixerParamsAvancement(4500; 1500) // fin 6000
This.CréerPagesRolodex("rolodexCommune")
Function CréerPagesRolodex($nom : Text)
var $sessionStorage : Object
var $lettre : Text
$sessionStorage:=This.getStorage()
For each ($lettre; This.DataStoreSelect.entreesRolodex) While (Not(This.tache.Tuer.signaled))
// pour le template, renseigner le choix utilisateur
Use ($sessionStorage["WebUserPrefs"])
$sessionStorage["WebUserPrefs"][$nom]:=$lettre
End use
This.tache.FixerEtat(This.tache.Etat+" "+$lettre)
This.tache.FixerAvancement(This.DataStoreSelect.entreesRolodex.indexOf($lettre)/This.DataStoreSelect.entreesRolodex.length)
// Créer la page html de cette lettre
This.page.name:=Lowercase($lettre; *)+".html"
This.page.template:="liste.shtml"
This.CréerPageHTML()
//break// pas test
End for each
//----------------------
//MARK:Listes
//----------------------
Function CréerPagesListePersonnes()
var $lettre : Text
var $c : Collection
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Traitement de "+String(This.DataStoreSelect.selection.length)+" patronymes")
This.AfficherAvancement(2000; This.document.LireLocatedSTR(5118))
wwwEtatNavigation:="liste_personnes"
This.tache.FixerParamsAvancement(2000; 2500) // fin 4500
For each ($lettre; This.DataStoreSelect.entreesRolodex) While (Not(This.tache.Tuer.signaled))
// sélectionner les patronymes d'initiale $lettre
$c:=This.DataStoreSelect.selection.query("patronyme = :1"; $lettre+"@")
This.tache.FixerEtat(This.tache.Etat+" "+$lettre)
This.tache.FixerAvancement(This.DataStoreSelect.entreesRolodex.indexOf($lettre)/This.DataStoreSelect.entreesRolodex.length)
// dossier de stockage (un par lettre)
This.destination.sousDossierPages:=This.document.getSousDossierPersonnes()+Lowercase($lettre; *)+"/"
Folder(This.destination.dossierRacine.path+This.destination.sousDossierPages).create()
This.CréerListe($c; "UUIDpatronyme")
//break// pas test
End for each
Function CréerListe($c : Collection; $nom : Text)
var $sessionStorage; $entité : Object
$sessionStorage:=This.getStorage()
For each ($entité; $c) While (Not(This.tache.Tuer.signaled))
// (re)intialiser la requête (ici pas de rebouclage)
Use ($sessionStorage)
$sessionStorage.UserWebRequetePersonnes:=Null
// pour le template, renseigner le choix utilisateur
Use ($sessionStorage["UserParams"])
$sessionStorage["UserParams"][$nom]:=$entité.IDunique
End use
End use
// Créer la page html de ce nom
This.page.name:=$entité.IDunique+".html"
This.page.template:="liste.shtml"
This.CréerPageHTML()
//break// pas test
End for each
//----------------------
//MARK:Communes
//----------------------
Function CréerPagesEtatCivil()
var $lettre : Text
var $c : Collection
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Traitement de "+String(This.DataStoreSelect.selection.length)+" communes")
This.AfficherAvancement(6000; This.document.LireLocatedSTR(5119))
wwwEtatNavigation:="liste_communes"
This.tache.FixerParamsAvancement(6000; 2500) // fin 8500
For each ($lettre; This.DataStoreSelect.entreesRolodex) While (Not(This.tache.Tuer.signaled))
// sélectionner les communes d'initiale $lettre
$c:=This.DataStoreSelect.selection.query("nom = :1"; $lettre+"@")
This.tache.FixerEtat(This.tache.Etat+" "+$lettre)
This.tache.FixerAvancement(This.DataStoreSelect.entreesRolodex.indexOf($lettre)/This.DataStoreSelect.entreesRolodex.length)
// dossier de stockage (un par lettre)
This.destination.sousDossierPages:=This.document.getSousDossierEtatCivil()+Lowercase($lettre; *)+"/"
Folder(This.destination.dossierRacine.path+This.destination.sousDossierPages).create()
This.CréerPageEtatCivil($c)
End for each
Function CréerPageEtatCivil($c : Collection)
var $entité : cs.Communes
var $sessionStorage : Object
var $objetClass : Object
$sessionStorage:=This.getStorage()
For each ($entité; $c) While (Not(This.tache.Tuer.signaled))
// (re)intialiser la requête (ici pas de rebouclage)
Use ($sessionStorage)
$sessionStorage.UserWebRequeteEvents:=Null
// pour le template, renseigner le choix utilisateur
Use ($sessionStorage["UserParams"])
$sessionStorage["UserParams"].UUIDcommune:=$entité.IDunique
$sessionStorage["UserParams"].UUIDpatronyme:=""
End use
End use
// sélectionner les events de la commune demandée
$objetClass:=$entité.LesEvents()
This.SessionStorageAjouter($objetClass; "UserParams")
// pas de sélection de medias
$objetClass:=cs.MediasSelect.new(New collection)
This.SessionStorageAjouter($objetClass; "UserParams")
// Créer la page html de ce nom
This.page.name:=$entité.IDunique+".html"
This.page.template:="affichageCommune.shtml"
This.CréerPageHTML()
End for each
//----------------------
//MARK:Cartographie
//----------------------
Function CréerPageCartographie()
// dossier de stockage
This.destination.sousDossierPages:=""
// données de la carte complète (cf carto sur BDDmère)
This.CréerRessourcesCarte()
// fixer les variables process de construction de la page
This.RestaurerHTTPvars("HTTPvars")
wwwEtatNavigation:="cartographie"
// Créer la page html de ce nom
This.page.name:="cartographie.html"
This.page.template:="cartographieWeb.shtml"
This.CréerPageHTML()
Function CréerRessourcesCarte()
// créer les données de la carte
var $sessionStorage; $carte; $params : Object
$sessionStorage:=This.getStorage()
// classe de gestion de la carto
$carte:=cs.xCarto.$carte.new()
$params:=New object
// fixer les variables process type www
This.FixerHTTPvars($params)
// init de la sélection de lieux et des paramètres associés de la zone à afficher (la zone)
// tous les lieux
$params.sélection:=New collection(New object("DataClassNom"; "Lieux"; "IDs"; $sessionStorage.HTTP_Lieux.copy()))
// dossier où mettre les données
$params.cheminRacineHTML:=This.destination.dossierRacine.platformPath
// dossier de sessions
$params.SessionID:="CartoWeb"
$params.cheminSessionFolder:=Folder($params.cheminRacineHTML; fk platform path).folder($params.SessionID).platformPath
$params.sousDossierImages:="images"
// pour la page Web, icones d'instance vues au niveau de la session
$params.dossierCartoURL:=$params.HTTPvars.wwwRacineRessources+$params.SessionID
// urls sur le serveur Web
$params.nomFichierMarkers:="dataGP_*.js"
// formats pour serveur Web
$params.Apparence:=New object("CodeLangue"; "fr"; "SymbolConjoints"; " & "; "SymbolDateLieu"; " - "; "FormatDate"; 5; "FormatHeure"; 2; "FormatLieu"; 1; "FormatGeoLoc"; 1)
$params.PopUpOptions:=New object("Lieux"; 0x00040000; "Communes"; 0x00C80000; "Departements"; 0x00C80000; "Regions"; 0x00880000; "Pays"; 0x0000)
$params.PopUpLiens:=True
// demander la carte et générer ses données de session
$carte.getCarteData($params)
// installer les ressources carto
$carte.InstallerRessources($params.cheminRacineHTML)
// créer les fichiers
$carte.InstallerDonnées($params)
// mémoriser pour la construction de la page
Use ($sessionStorage)
$sessionStorage.MarkersData:=$params.data.MarkersData
$sessionStorage.HTTPvars:=New shared object
End use
sharedObject($params.HTTPvars; $sessionStorage.HTTPvars)
//----------------------
//MARK:Utilitaires
//----------------------
Function FixerHTTPvars($data : Object)
$data.HTTPvars:=New object
// transmettre à .getCarteData()
$data.HTTPvars.wwwRacineRessources:=""
$data.HTTPvars.wwwContexteWeb:="ALVserveur"
// initialiser les variables process contenus dans la carte
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Opacity_OSM"; Is text; $data.HTTPvars; "wwwCarto_Opacity_OSM")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Install_GP"; Is text; $data.HTTPvars; "wwwCarto_Install_GP")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_Opacity_GP"; Is text; $data.HTTPvars; "wwwCarto_Opacity_GP")
$data.HTTPvars.wwwCarto_Opacity_Cible:="0.0"
// zoom
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_ZoomMin_OL"; Is text; $data.HTTPvars; "wwwZoneWeb_ZoomMin")
This.rsc.SetObjet(Est Ressource WEB; "Carte/Carto_ZoomMax_OL"; Is text; $data.HTTPvars; "wwwZoneWeb_ZoomMax")
Function CréerPageHTML()->$result : Object
// crée une page statique WEB à partir d'une page dynamique
// crée dans le dossier destination le fichier "template" de la page statique basée sur la page dynamique du fichier "name"
// Erreur=-16403 si la page n'a pas été créée
var $path; $fichier : Object
var $texte : Text
var $texteBlobé : Blob
$result:=New object("Error"; 0; "ErrorDescription"; ""; "success"; False)
$result.Error:=-15068
Case of
: (This.page.name="")
: (This.page.template="")
// pas de nom du template de la page dynamique
: (This.destination.dossierRacine=Null)
// pas de chemin relatif de la page statique dans le dossier $2
: (This.params.ressourcesALV=Null)
Else
// paramètre du template
wwwRacineRessources:=This.document.CalculerNiveauRelatifPOSIX(This.destination.sousDossierPages)
// chemin de la page statique
$path:=File(This.destination.dossierRacine.path+This.destination.sousDossierPages+This.page.name)
$fichier:=File(This.params.ressourcesALV.path+"TemplatesPagesWeb/"+This.page.template)
$result.Error:=0
$result.success:=True
Case of
: (Not($fichier.exists))
// oops, le template n'existe pas
$result.Error:=-15042
$result.ErrorDescription:="absence du template "+$fichier.fullName
: (Not($path.parent.exists))
This.trace.EnvoyerMessages([msgk_event; msgk_log]; "Chemin invalide"; Current method name; "Le dossier "+$path.parent.platformPath+" n'existe pas encore")
Else
DOCUMENT TO BLOB($fichier.platformPath; $texteBlobé)
$result.success:=$result.success & (ok=1)
$texte:=BLOB to text($texteBlobé; UTF8 text without length)
// créer la page
PROCESS 4D TAGS($texte; $texte)
// enregistrer la page dans le dossier session
SET BLOB SIZE($texteBlobé; 0)
TEXT TO BLOB($texte; $texteBlobé; UTF8 text without length)
BLOB TO DOCUMENT($path.platformPath; $texteBlobé)
$result.success:=$result.success & (ok=1)
$result.Error:=-16403*Num(Not($result.success))
End case
End case
This.trace.Créer($result.Error; Current method name; $result.ErrorDescription).LeverException([msgk_event; msgk_log])
Function AfficherAvancement($temps : Integer; $message : Text)
This.tache.FixerTime($temps)
This.tache.FixerEtat($message)
⇧
[class]PaysSelect - 29/05/2025 19:20:23
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("PaysSelect"; $requête)
This.selection:=Null
This.length:=0
// ----------------------
//MARK:Wrappers
// ----------------------
Function CollecterTousLesPays()
This.dataClass.CollecterTousLesPays()
// ???? This.collection:=This.fct.collection
// ----------------------
//MARK:Sélection
// ----------------------
Function CréerTousLesPays()
This.CollecterTousLesPays()
This.Créer()
// trier les pays par nom
This.selection:=This.selection.orderBy("nom asc")
⇧
[class]Lieux - 29/05/2025 18:56:30
property leSite : cs.Sites
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Lieux"; $IDentité)
⇧
[class]_SF_ParametresWeb - 31/05/2025 16:49:50
Class extends _SousFormulaire
singleton Class constructor()
Super()
// ----------------------
//MARK:Formulaire
// ----------------------
Function _fct_Formulaire()
var $dataText : Text
var $cadence : Integer:=0
Case of
: (Form event code=On Load)
cs.xSDK.ResourceALV.me.SetVariable(Est Ressource WEB; "Parametres/RefreshTime"; Is longint; ->$cadence)
SET TIMER(2*$cadence)
// charger les objets
This._onEndLoad()
: (Form event code=On Timer)
$dataText:=Form.InformationsServeurHTTP.serveurComposantWeb.rootFolder
Form.dossierPartagé:=$dataText
$dataText:=Form.InformationsServeurHTTP.serveurComposantWeb.IPAddressToListen
Form.IP_Serveur:=$dataText
End case
Function _onEndLoad()
var $c : Collection
var $functionID : Text
// en DUR pour l'instant
$c:=["URLdomaine"; "NomSousDomaine"; "IP_FAI"; "portHTTP"; "portHTTPS"; "TimeOutProcess"; "TimeOutSession"; "adresseFTP"; "IDconnexionFTP"; "MdPconnexionFTP"; "URLherbergement"]
For each ($functionID; $c)
This.nomOBJ:=$functionID
This["_fct_"+$functionID]()
End for each
// ----------------------
//MARK:Functions Objet
// ----------------------
Function _fct_URLdomaine()
This.EditerRessource(Est Ressource WEB; "FAI/URL_Domaine"; Is text)
Function _fct_NomSousDomaine()
var varTest : Text:=""
This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->varTest)
This.EditerRessource(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text)
Function _fct_IP_FAI()
// rappel : DNS dynamique : le lien nom Domaine / IP FAI est fait à l'extérieur (actuellement par le NAS via Synology)
// v16 : le serveur Web recupère directement l'adresse IP du FAI à partir du nom de domaine.
// "FAI/Adresse_IP_FAI" pas utile de le saisir (c'est une info)
var $dataTexte : Text:=""
var $adresseIP : Text
This.rsc.SetVariable(Est Ressource APP; "serveur_URL/Nom_sousDomaine"; Is text; ->$dataTexte)
$adresseIP:=cs.xSDK.SystemTools.new().NET_Resolve($dataTexte)
// utile ????
This.rsc.SetResourceALV(Est Ressource WEB; "FAI/Adresse_IP_FAI"; ->$adresseIP)
This.EditerRessource(Est Ressource WEB; "FAI/Adresse_IP_FAI"; Is text)
Function _fct_portHTTP()
This.EditerRessource(Est Ressource WEB; "Serveur_web/portHTTP_sousDomaine"; Is longint)
Function _fct_portHTTPS()
This.EditerRessource(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is longint)
Function _fct_TimeOutProcess()
// A l’issue du Web_Timeout_process, le process est tué sur le serveur, la Méthode base Sur fermeture session Web est appelée puis le contexte de la session est détruit.
// appel Méthode base Sur fermeture session Web pour mémoriser les données utilisateur (variables sélections...)
var $dataEntier : Integer
This.EditerRessource(Est Ressource WEB; "Serveur_web/Web_Timeout_process"; Is longint)
Case of
: (Form event code=On Load)
// donnée supposée valide
// si on lit 0, mettre la valeur par défaut
If (Form[This.nomOBJ]=0)
WEB GET OPTION(Web inactive process timeout; $dataEntier)
Form[This.nomOBJ]:=$dataEntier
OBJECT SET RGB COLORS(*; This.nomOBJ; "Gray")
End if
End case
Function _fct_TimeOutSession()
// Permet de modifier la durée de vie des sessions inactives (durée définie dans le cookie). A l’issue de cette durée, le cookie de session expire et n’est plus envoyé par le client HTTP.
// Web_Timeout_session du cookie
var $dataEntier : Integer
This.EditerRessource(Est Ressource WEB; "Serveur_web/Web_Timeout_session"; Is longint)
Case of
: (Form event code=On Load)
// donnée supposée valide
// si on lit 0, mettre la valeur par défaut
If (Form[This.nomOBJ]=0)
WEB GET OPTION(Web inactive session timeout; $dataEntier)
Form[This.nomOBJ]:=$dataEntier
OBJECT SET RGB COLORS(*; This.nomOBJ; "Gray")
End if
End case
Function _fct_adresseFTP()
This.EditerRessource(Est Ressource HOST; "Connexion/NomHost"; Is text)
Function _fct_IDconnexionFTP()
This.EditerRessource(Est Ressource HOST; "Connexion/Identifiant"; Is text)
Function _fct_MdPconnexionFTP()
This.EditerRessource(Est Ressource HOST; "Connexion/MotDePasse"; Is text)
Function _fct_URLherbergement()
This.EditerRessource(Est Ressource WEB; "Hosting/URL"; Is text)
⇧
[class]Dossiers - 31/05/2025 16:41:24
// attributs de la classe
property volume : Integer
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Dossiers"; $IDentité)
Function getCatalogueWeb()->$result : Object
var $url : Text
var $c : Collection
$url:=This.document.getHostFolderPath("WebMedia"; This)
// une erreur peut être normale (absence de dossier ou de catalogue)
$result:=New object
If (This.serveur.LireCatalogueDuDossier($url; ->$result; ->$c).Error=0)
// ici il peut arriver (?) qu'un fichier soit indiqué dans le catalogue mais absent physiquement du dossier
// vérifier la cohérence
This.checkCatalogueWeb($result)
Else
$result:=Null
This.trace.EnvoyerMessages([msgk_event; msgk_mail]; "ALV - Maintenance Medias Web"; Current method name; "Le catalogue "+$url+" est absent")
End if
Function checkCatalogueWeb($mediasInformation : Object)
var $url; $attribut; $nomFichier : Text
var $c : Collection
$url:=This.document.getHostFolderPath("WebMedia"; This)
$c:=New collection
Case of
: (This.serveur.ListerLesDocuments($url; ->$c).Error#0)
: ($c.length=0)
Else
For each ($attribut; OB Keys($mediasInformation))
// trouver un fichier dont le nom commence par IDcodé de $nom
$nomFichier:=String(CodeEnreg(Num(Substring($attribut; 1; 5)); [19]))+"@"
If ($c.query("nom = :1"; $nomFichier).length=0)
// fichier absent, supprimer du catalogue
OB REMOVE($mediasInformation; $attribut)
End if
End for each
End case
⇧
[class]Personnes - 06/06/2026 15:30:23
property lesEvents : cs.EventsSelect
// attributs de la classe
property nom; prenom : Text
property sexe : Boolean
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Personnes"; $IDentité)
This.lesEvents:=Null
Function LibelléLié($formats : Object)->$result : Text
var $url : Text
$url:=This.URLlienSurArbre()
$result:=Super.LibelléLié($url; $formats)
Function URLlienSurArbre()->$result : Text
If (Session.info.type="standalone")
// cas STATIC pas d'arbre dans cette version
$result:=""
Else
$result:=This._tagUrl+"Web/AfficherArbre?"+This.hrefHTML()
End if
Function hrefHTML()->$result : Text
// ID de this dans un lien HTML
$result:=This.IDunique
// ----------------------
//MARK:Entité Wrappers
// ----------------------
Function Libellé($formats : Object)->$libellé : Text
$libellé:=This.dataClass.Libellé($formats)
Function Age($aLaDate : Date)->$result : Object
// Calcul de l'âge de this à :
// . à la date $1
// . à sa mort (si $1 est absent)
// . à aujourd'hui (si $1 est absent et pas mort)
// Sortie
// . $0 = 0 si calcul ok, ou -1 si absence de naissance, -2 si absence de décès, -3 si décédé avant $2.date
// . $data.âge
// . $data.âgeSTR
var $Event : Object
var $dateNaissance; $dateDécès; $dateCalcul : Date
var $age : Integer
$result:=New object("Contexte"; 0)
$Event:=This.Naissance()
If ($Event=Null)
// pas de naissance
$result.Contexte:=3120
Else
// date de naissance
$dateNaissance:=$Event.dateNum
// date de décès
$Event:=This.Décès()
If (Not($Event=Null))
$dateDécès:=$Event.dateNum
End if
Case of
: (Count parameters=1)
// calculer l'âge à la date demandée
$dateCalcul:=$aLaDate
// filtrer les cas impossibles
Case of
: ($dateDécès=!00-00-00!)
: ($dateDécès<$aLaDate)
// décédé avant la date demandée
$result.Contexte:=3121
End case
: ($dateDécès=!00-00-00!)
$dateCalcul:=Current date
End case
// on calcule quelque chose
$age:=Year of($dateCalcul)-Year of($dateNaissance)-1
If ((Month of($dateCalcul)>Month of($dateNaissance)) | (((Month of($dateCalcul)=Month of($dateNaissance)) & (Day of($dateCalcul)>=Day of($dateNaissance)))))
$age:=$age+1
End if
Case of
: ($result.Contexte>0)
// on connait la situation
: ($age<0)
$result.Contexte:=3120
: ($age>110)
$result.Contexte:=3122
Else
$result.Contexte:=3119
End case
$result.âge:=$age
$result.âgeSTR:=String($age)+This.document.LireLocatedSTR(1002; New object("genre"; False; "plur"; $age>1))
End if
Function Naissance()->$result : Object
// renvoie un objet _EvenementPersonnel
$result:=This._EvenementPersonnel(22000)
Function Baptême()->$result : Object
// renvoie un objet _EvenementPersonnel
$result:=This._EvenementPersonnel(22300)
Function Décès()->$result : Object
// renvoie un objet _EvenementPersonnel
$result:=This._EvenementPersonnel(22100)
Function _EvenementPersonnel($type : Integer)->$result : Object
// renvoie l'entité events perso de type $1
var $c : Collection
If (This.lesEvents=Null)
This.lesEvents:=This.LesEvents()
End if
$result:=Null
$c:=This.lesEvents.selection.query("type = :1"; $type)
If ($c.length>0)
$result:=$c[0]
End if
// ----------------------
//MARK:Sélection
// ----------------------
// attention, les liens généalogiques (Parents et conjoint) ne peuvent pas être traités ici en direct
// la création des personnes ramènerait ici, d'où un bouclage infernale
// Parents et conjoints sont accessibles par les fonctions suivantes
Function LesEvents()->$result : cs.EventsSelect
// créer la collection des events
$result:=cs.EventsSelect.new(This.dataClass.LesEvents())
$result.Créer()
Function LesUnions()->$result : cs.UnionsSelect
// créer la collection des unions triées par date
$result:=cs.UnionsSelect.new(This.dataClass.LesUnions())
$result.Créer()
// trier les unions par date
$result.selection:=$result.selection.orderBy("leEvent.dateNum asc")
Function LesParents()->$result : Object
// créer un objet des parents : membre1 = père, membre2 = mère
var $union : cs.Unions
// l'union parentale
$union:=cs.Unions.new(This.dataClass.LesParents())
// créer les membres de $union : lesMembres .membre1 = homme, .membre2 = femme
// peuvent être Null
$union.LesProtagonistes()
$result:=$union.lesMembres
Function LesMedias()->$result : cs.MediasSelect
// chercher les medias à afficher de la personne
var $c : Collection
// vérifier que la personne est accessible
If (Session.storage["HTTP_Personnes"].indexOf(This.ID)>-1)
// on a une personne
// sélectionner les medias de la personne
$c:=This.dataClass.LesMedias()
$result:=cs.MediasSelect.new($c)
$result.Créer()
// filtrer les medias webables
$result.FiltrerSurID("HTTP_Medias")
// filtrer les medias privés
$result.FiltrerLesPrivés()
End if
// ----------------------
//MARK:PageHTML
// ----------------------
Function Biographie($formats : Object)->$result : Text
// biographie de this
// Créer le lien vers la page individuelle
var $EventsSelect : cs.EventsSelect
var $union : cs.Unions
var $event : cs.Events
var $texte : Text
var $i : Integer
$result:=""
$texte:=This.LibelléLié($formats)
// une valeur nulle correspond à une personne non Webable
If ($texte#"")
$texte:="<p>"+$texte
// genrer les events en fonction du sexe de la personne
$formats.genre:=This.sexe
// écrire tous les events perso
$EventsSelect:=This.LesEvents()
$texte:=$texte+$EventsSelect.Information($formats)
// Trouver les mariages
For each ($union; This.LesUnions().selection)
$event:=$union.leEvent
If ($event#Null)
$texte:=$texte+$event.BioData($formats)
// les enfants
$i:=$union.LesEnfants().length
$texte:=$texte+"<span>"
Case of
: ($union.SansEnfant=True)
$texte:=$texte+" (Pas d'enfants connus)"
: ($i=0)
$texte:=$texte+" (Sans enfant)"
: ($i=1)
$texte:=$texte+" (1 enfant connu)"
Else
$texte:=$texte+" ("+String($i)+" enfants connus)"
End case
$texte:=$texte+"</span>"
End if
End for each
$result:=$texte+"</p>"
End if
Function Informations()->$result : Text
// titre : nom de this
$result:="<h1>"+This.nom+" "+This.prenom+"</h1>"
// le tableau des vignettes medias de this
$result:=$result+Session.storage.UserParams.MediasSelect.EcrireTableauVignettes()
Function InformationParents($formats : Object)->$result : Text
// de this au format $1
var $sélection; $entité : Object
$sélection:=This.LesParents()
$result:=""
If (Not($sélection=Null))
$result:=", "+This.document.LireLocatedSTR(5122+Num(This.sexe))
// premier parent
If ($sélection.membre1#Null)
$entité:=$sélection.membre1
$result:="<span>"+$result+"</span>"
$result:=$result+$entité.PersonneAgé($formats)
End if
// second
If ($sélection.membre2#Null)
$entité:=$sélection.membre2
$result:=$result+("<span>"+This.document.LireLocatedSTR(1014)+"</span>")*Num($sélection.membre1#Null)
$result:=$result+$entité.PersonneAgé($formats)
End if
End if
Function PersonneAgé($formats : Object)->$result : Text
// écrire le libellé de this avec son âge
var $params; $entité : Object
var $texte : Text
$result:=""
$params:=This.Age($formats.aLaDate)
// on a reçu .âge (type nombre) et .âgeSTR (typée chaine)
$entité:=OB Copy(This)
Case of
: ($params.Contexte=3119)
// cas normal : date de naissance connue et vivant à la date demandée
Use (Storage.STR)
Storage.STR.texte_1:=String($params.âge) // pour le calcul de la chaine "5124"
End use
$texte:=This.LibelléLié($formats)
$result:=$texte+"<span> "+This.document.LireLocatedSTR(5124; New object("genre"; This.sexe; "plur"; $params.âge>1))+"</span>"
: ($params.Contexte=3120)
// date de naissance inconnue
$result:=This.LibelléLié($formats)
: ($params.Contexte=3121)
// décédé à la date demandée
$result:="<span>"+This.document.LireLocatedSTR(5125; New object("genre"; This.sexe; "plur"; False))+"</span>"+This.LibelléLié($formats)
: ($params.Contexte=3122)
// doute (centenaire?)
$result:=This.LibelléLié($formats)
End case
// ----------------------
//MARK:Saisie HTTP
// ----------------------
Function getEntité($data)->$entité : Object
// renvoie l'entité de this correspondant à l'objet saisie ($data)
var $result; $entitéThis : Object
$result:=This.InitResult(0; ""; False)
$result.entité:=Null
If (This.DataClassNom=$data.DataClassNom)
// c'est l'entité personnes
$result.entité:=This
$result.success:=True
Else
// essayer les events perso
For each ($entitéThis; This.LesEvents().selection)
If (Not($result.success))
$result:=$entitéThis.getEntité($data)
End if
End for each
// essayer les unions
For each ($entitéThis; This.LesUnions().selection)
If (Not($result.success))
$result:=$entitéThis.getEntité($data)
End if
End for each
End if
$entité:=$result.entité
Function Modifier($params : Object)->$result : Object
// rien à faire de plus
$result:=This.InitResult()
Function UrlDuLien($fonction : Text)->$result : Text
$result:=This._tagUrl+$fonction+"?"+This.IDunique
⇧
[class]$pageWebSTATIC - 18/02/2026 10:32:39
Class extends $pageWeb
Class constructor()
Super()
//----------------------
//MARK:Wrapper WebREQUETE
//----------------------
// remarque v8.2.10 : dans le cas du site Web, l'appel se fait par une balise 4D ; "Caractère(1)+" est nécessaire
Function ListerNomsPersonnes()
var $texte : Text
$texte:=cs.PersonnesSelect.new(Session.storage.HTTP_Personnes).ListerNomsPersonnes(New object("balise"; "h4"; "Options"; 1))
This.result.resultat:=Char(1)+$texte
Function ListerNomsCommunes()->$result : Text
var $texte : Text
$texte:=cs.CommunesSelect.new(Session.storage.HTTP_Communes).ListerNomsCommunes(New object("balise"; "h4"; "Options"; 0))
This.result.resultat:=Char(1)+$texte
Function ServeurWebURL()
// on renvoie directement l'adresse sécurisée (rappel : HSTS non activé sur le site hôte)
var $texte : Text:=""
var $numPort : Integer:=0
This.rsc.SetVariable(Est Ressource APP; "Serveurs_ALV/IP_Serveur"; Is text; ->$texte)
This.rsc.SetVariable(Est Ressource WEB; "Serveur_web/portHTTPS_sousDomaine"; Is integer; ->$numPort)
$texte:="https://"+$texte+":"+String($numPort)
$texte:=$texte+"/index.shtml"
This.result.resultat:=Char(1)+$texte
⇧
[class]$pageWebARB - 06/06/2026 15:37:23
property entité : cs.Personnes
Class extends $pageWeb
Class constructor()
Super()
Function UrlAfficher()->$result : Text
$result:="/4DCGI/Web/AfficherArbre?"+Session.storage.UserParams.UUIDpersonne
//----------------------------------
// MARK:Element HTML
//----------------------------------
Function Afficher()
var $texte : Text
// restaurer le contexte
This.entité:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
// lancer la construction ; le resultat est dans arbreXML
This.Construire()
// écrire l'arbre (plus menus au besoin)
$texte:=This.AjouterMenus()
This.result.resultat:=Char(1)+$texte
Function Construire()
// créer l'arbre dans arbreXML
var $params; $EtatProcessus : Object
var $path : Text
// lancer la création de l'arbre
arbreXML:=""
OB SET($params; "IDarbre"; This.entité.ID)
OB SET($params; "IDpersonne"; CodeEnreg(This.entité.ID; [1]))
OB SET($params; "NmaxAscendance"; 1)
OB SET($params; "NmaxDescendance"; 1)
// la génération du site statique "WEBStatic" crée une forêt d'arbres => la BDD_AG grossit et les commandes SELECT prennent des plombes
// dans ce cas, on réduit la taille de la BDD_AG en créant des BDD_AG alphabétiques
$path:=This.document.getSessionFolder().platformPath
If (Session.info.type="standalone") // cas STATIC
//%W-533.1
$path:=This.document.getSessionFolder().folder(This.entité.nom[[1]]).platformPath
//%W+533.1
End if
Folder($path; fk platform path).create()
OB SET($params; "CheminDossierBDD_AG"; $path)
OB SET($params; "nomBDD"; "session")
$path:="serveur HTML "+Session.storage.UserParams.OrientationEcran+".xml"
OB SET($params; "Modele"; $path)
OB SET($params; "functionID"; "Construire_AG")
// nom et collections des éléments Webables
OB SET($params; "EntitésWebables"; New object)
OB SET($params; "PersonnesAffichables"; "HTTP_Personnes")
OB SET($params.EntitésWebables; "HTTP_Personnes"; Session.storage["HTTP_Personnes"])
OB SET($params; "EventsAffichables"; "HTTP_Events")
OB SET($params.EntitésWebables; "HTTP_Events"; Session.storage["HTTP_Events"])
OB SET($params; "Session_Etat"; Storage.Host.Session_Etat)
OB SET($params; "optionsMsg"; [msgk_event])
// options : on veut les cadres des personnes absentes (=> largeur image SVG fixe)
OB SET($params; "Options"; 0x0007) // liens dynamiques
If (Session.info.type="standalone") // cas STATIC
OB SET($params; "Options"; 0x000B) // liens statiques
End if
OB SET($params; "SéparateurParamsURL"; "?") // séparateur des paramètres dans les URL (4DACTION...)
// initialiser l'état
OB SET($EtatProcessus; "Params"; 0x0000)
//OB FIXER($EtatProcessus;"Params";0x0000 ?? 25) // afficher viewer
OB SET($EtatProcessus; "SaisieAutorisée"; True)
OB SET($params; "EtatProcessus"; $EtatProcessus)
// fixer le retour
OB REMOVE($params; "numProcessAppelant")
OB REMOVE($params; "numFenetreAppelante") // au cas où!
// on lance (le résultat sera reçu dans arbreXML)
cs.xARB.$arbre.new().Imager_AG($params)
If ($params.success)
arbreXML:=$params.arbreXML
End if
//----------------------------------
// MARK:Menus HTML
//----------------------------------
Function AjouterMenus()->$result : Text
// ajouter les menus saisie à l'arbre ArbreXML
var $arbreXML; $ElémentXML; $dataTexte; $menu : Text
var $i; $ID; $IDunion : Integer
$menu:=""
If (ArbreXML="")
$result:="Arbre non disponible"
Else
// récupérer l'arbre
$arbreXML:=DOM Parse XML variable(ArbreXML)
If (Session#Null)
// lister les objets affichés
ARRAY TEXT($tab; 0)
$ElémentXML:=DOM Find XML element($arbreXML; "/svg/g"; $tab)
// chercher le DeCujus et ajouter son menu ajout
For ($i; 1; Size of array($tab))
// normalement l'attribut existe toujours
DOM GET XML ATTRIBUTE BY NAME($tab{$i}; "typeElement"; $dataTexte)
If ($dataTexte="0") // de-Cujus
// ajouter le menu ajout du de-cujus
DOM GET XML ATTRIBUTE BY NAME($tab{$i}; "id"; $ID)
// menu de nom $ID lié à l'objet $ID
$menu:=This.CréerMenuPersonne($arbreXML; $ID)
End if
End for
// chercher les mariages de $ID
If (Session.storage.WebUser.droits ?? 0)
For ($i; 1; Size of array($tab))
// normalement l'attribut existe toujours
DOM GET XML ATTRIBUTE BY NAME($tab{$i}; "typeElement"; $dataTexte)
// chercher une union
If (($dataTexte="160") | ($dataTexte="176")) // union ou autre union
// ajouter le menu
DOM GET XML ATTRIBUTE BY NAME($tab{$i}; "id"; $IDunion)
// menu de nom $ID lié à l'entité [Unions]
$menu:=$menu+This.CréerMenuUnion($arbreXML; $IDunion)
End if
End for
End if
End if
// c'est fini
// lire l'arbre modifié
DOM EXPORT TO VAR($arbreXML; $result)
// pour des tests
//DOM EXPORTER VERS FICHIER($RacineXML; Dossier 4D(Dossier Logs; *)+"Test Arbre.xml")
DOM CLOSE XML($arbreXML)
// supprimer la balise <?xml >
$result:=Substring($result; Position("<"; $result; 2; *))
End if
// envoyer arbre complété suivi des menus
$result:=$result+$menu
Function CréerMenuPersonne($arbreXML : Text; $ID : Integer)->$result : Text
var $ElémentXML; $EnfantXML; $PetitEnfantXML; $toutPetitEnfantXML : Text
var $data : Object
var $ajouter : Boolean
// ajouter le bouton image à l'arbre
This.CréerBoutonImage($arbreXML; $ID)
// créer le popUpmenu : This.RacineXML
This.CréerPopUpMenuXML($ID)
// créer la liste des menus
$ElémentXML:=DOM Create XML element(This.RacineXML; "ul"; "class"; "menuDeroulant")
// les modifications
// autoriser l'affichage du formulaire (la saisie sera verrouillée si pas autorisée)
$EnfantXML:=DOM Create XML element($ElémentXML; "li")
$EnfantXML:=DOM Create XML element($EnfantXML; "a"; "href"; "/4DCGI/WebSAISIE/AfficherSaisie?"+String($ID)+"+?-1")
DOM SET XML ELEMENT VALUE($EnfantXML; This.document.LireLocatedSTR(92))
If (Session.storage.WebUser.droits ?? 0)
//Saisie Autorisée
// les ajouts sont de 2 sortes : création d'une personne, ou utilisation d'une personne déjà en BDD
// premier cas : le menu envoie une action de type /4DCGI/BDD/saisir_ajout?quoi+?aqui+?-1
// second cas : le menu appelle la fenetre modale avec en paramètre ajout?quoi+?aqui+? ('qui' est fixé par la fonction javascript associée à la fenetre modale)
$EnfantXML:=DOM Create XML element($ElémentXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "a"; "href"; "#")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3040))
$EnfantXML:=DOM Create XML element($EnfantXML; "ul")
// trouver les parents de la personne demandée
$data:=cs.Personnes.new(Session.storage.UserParams.UUIDpersonne)
$data:=$data.LesParents()
// ajout d'un père
$ajouter:=True
Case of
: ($data=Null)
// pas de parents
: ($data.membre1=Null)
// père inconnu
Else
$ajouter:=False
End case
If ($ajouter)
// * créer un père
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "href"; "/4DCGI/Web/AjouterAlaPersonne?"+String(WEB Ajouter Père)+"+?"+String($ID)+"+?-1")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16314"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16314.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3021))
// * utiliser une personne de la BDD
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "onclick"; "afficherFenetreModale('#openSelectPersons','ParamsAjout','Ajout?"+String(WEB Ajouter Père)+"+?"+String($ID)+"+?')")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16309"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16309.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3115))
End if
// ajout d'une mère
$ajouter:=True
Case of
: ($data=Null)
// pas de parents
: ($data.membre2=Null)
// père inconnu
Else
$ajouter:=False
End case
If ($ajouter)
// au besoin, créer un séparateur
If (DOM Count XML elements($EnfantXML; "li")>0)
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "groupSeparator")
Else
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
End if
// * créer une personne
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "href"; "/4DCGI/Web/AjouterAlaPersonne?"+String(WEB Ajouter Mère)+"+?"+String($ID)+"+?-1")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16315"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16315.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3022))
// * utiliser une personne de la BDD
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "onclick"; "afficherFenetreModale('#openSelectPersons','ParamsAjout','Ajout?"+String(WEB Ajouter Mère)+"+?"+String($ID)+"+?')")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16309"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16309.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3116))
End if
// au besoin, créer un séparateur
If (DOM Count XML elements($EnfantXML; "li")>0)
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "groupSeparator")
Else
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
End if
// créer une union
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "href"; "/4DCGI/Web/AjouterAlaPersonne?"+String(WEB Ajouter Conjoint)+"+?"+String($ID))
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16313"; "width"; "28"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16313.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3023))
// * utiliser un conjoint de la BDD
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "onclick"; "afficherFenetreModale('#openSelectPersons','ParamsAjout','Ajout?"+String(WEB Ajouter Conjoint)+"+?"+String($ID)+"+?')")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16309"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16309.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3117))
End if
// finalement
$result:=This.CréerPopUpMenu()
Function CréerMenuUnion($arbreXML : Text; $ID : Integer)->$result : Text
// rappel : $ID = IDobjetCodé de l'union
var $ElémentXML; $EnfantXML; $PetitEnfantXML; $toutPetitEnfantXML : Text
// ajouter le bouton image à l'arbre
This.CréerBoutonImage($arbreXML; $ID)
// créer le popUpmenu : This.RacineXML
This.CréerPopUpMenuXML($ID)
$ElémentXML:=DOM Create XML element(This.RacineXML; "ul"; "class"; "menuDeroulant")
// les ajouts
$EnfantXML:=DOM Create XML element($ElémentXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "a"; "href"; "#")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3040))
// ajout d'un enfant
// * par création
$EnfantXML:=DOM Create XML element($EnfantXML; "ul")
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "href"; "/4DCGI/Web/AjouterAlaPersonne?"+String(WEB Ajouter Enfant)+"+?"+String($ID))
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16316"; "width"; "30"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16316.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3024))
// * par utilisant d'une personne de la BDD
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "li"; "class"; "barreMenus")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "a"; "onclick"; "afficherFenetreModale('#openSelectPersons','ParamsAjout','Ajout?"+String(WEB Ajouter Enfant)+"+?"+String($ID)+"+?')")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "img"; "alt"; "image 16309"; "width"; "20"; "height"; "20"; "src"; Session.storage.HTTPvars.wwwRacineRessources+"ressources/images/16309.png")
DOM SET XML ELEMENT VALUE($PetitEnfantXML; This.document.LireLocatedSTR(3118))
// finalement
$result:=This.CréerPopUpMenu()
Function CréerBoutonImage($arbreXML : Text; $ID : Integer)
// le bouton sert d'appelau popUpMenu
var $texte; $ElémentXML; $EnfantXML; $PetitEnfantXML; $toutPetitEnfantXML : Text
var $taille : Integer
// ID du popUpMenu
$texte:="MC_"+String($ID)
// ajouter le point d'appel du menu dans l'image SVG
// créer un élément externe
This.RacineXML:=DOM Create XML Ref("menu")
// créer une image du bouton
$taille:=16
$ElémentXML:=DOM Create XML element(This.RacineXML; "g"; "transform"; "translate(-"+String($taille/2)+", -"+String($taille/2)+") scale("+String($taille/512; "&xml")+", "+String($taille/512; "&xml")+")")
$EnfantXML:=DOM Create XML element($ElémentXML; "g"; "width"; "512"; "height"; "512")
$EnfantXML:=DOM Create XML element($EnfantXML; "a"; "onclick"; "PopUpMenuSaisi('"+$texte+"')")
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "g"; "stroke"; "silver"; "fill"; "silver"; "stroke-width"; "24")
$PetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "rect"; "x"; "50"; "y"; "50"; "width"; "400"; "height"; "400"; "rx"; "128")
$PetitEnfantXML:=DOM Create XML element($EnfantXML; "g"; "fill"; "black"; "stroke-width"; "24"; "stroke-linejoin"; "round")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "path"; "d"; "M128,226 H384, L256,128, L128,226 Z")
$toutPetitEnfantXML:=DOM Create XML element($PetitEnfantXML; "path"; "d"; "M128,276 H384, L256,384, L128,276 Z")
// insérer l'élément au bon endroit de l'image
$EnfantXML:=DOM Find XML element by ID($arbreXML; String($ID))
$EnfantXML:=DOM Insert XML element($EnfantXML; $ElémentXML; 1)
DOM CLOSE XML(This.RacineXML)
Function CréerPopUpMenuXML($ID : Integer)
var $texte : Text
// ID du popUpMenu
$texte:="MC_"+String($ID)
// créer le menu popUp
// rappel : une image SVG ne traite pas les balise HTML : le menu doit être à l'extérieur
// renvoyer une structure texte
This.RacineXML:=DOM Create XML Ref("nav")
DOM SET XML ATTRIBUTE(This.RacineXML; "class"; "popUpMenuDeroulant"; "id"; $texte; "name"; $texte; "style"; "display: none"; "z-index"; 1000)
Function CréerPopUpMenu()->$result : Text
// exporter le menu
DOM EXPORT TO VAR(This.RacineXML; $result)
DOM CLOSE XML(This.RacineXML)
// supprimer la balise <?xml >
$result:=Substring($result; Position("<"; $result; 2; *))
//----------------------------------
// MARK:Submit
//----------------------------------
Function SoumettreFormulaire()
// gère tous les submit de l'arbre
// récupérer les données du formulaire
var $error : Integer
This.LireHTTPvars()
// exécuter le submit
$error:=-15068
Case of
: (Session.storage.HTTPvars=Null)
: (Session.storage.HTTPvars.length=0)
: (Not(OB Is defined(Session.storage.HTTPvars; "wwwBtnSelectionValider")))
// ce n'est pas le formulaire sélection
: (Not(OB Is defined(Session.storage.HTTPvars; "wwwParamsAjout")))
: (Not(OB Is defined(Session.storage.HTTPvars; "wwwIDselectedEntity")))
Else
// on a tout
$error:=0
End case
If ($error=0)
// fixer les paramètres Quoi, aQui, Qui
This.LireParametresUrl(Session.storage.HTTPvars.wwwParamsAjout+Session.storage.HTTPvars.wwwIDselectedEntity)
// faire l'ajout
This.AjouterAlaPersonne()
Else
// re-afficher la page
This.Rediriger(This.UrlAfficher())
End if
⇧
[class]$pageWebLISTE - 05/06/2025 09:41:04
Class extends $pageWeb
Class constructor()
Super()
// ----------------------
//MARK:Sélection
// ----------------------
Function ListerPatronymes()
var $requête : Text
var $classeObjet : cs.DicoDesNomsSelect
// renvoyer la liste de tous les patronymes commençant par WebUserPrefs.rolodexPatronyme
$requête:="patronyme LIKE '"+This.getStorage().WebUserPrefs["rolodexPatronyme"]+"%'"
$classeObjet:=cs.DicoDesNomsSelect.new($requête)
$classeObjet.Créer()
$classeObjet.FiltrerSurID() // filtrage par défaut (pas de paramètre)
This.result.resultat:=Char(1)+$classeObjet.ListerPatronymes()
Function ListerCommunes()
var $requête : Text
var $classeObjet : cs.CommunesSelect
// renvoyer la liste de toutes les communes commençant par WebUserPrefs.rolodexCommune
$requête:="nom LIKE '"+This.getStorage().WebUserPrefs["rolodexCommune"]+"%'"
$classeObjet:=cs.CommunesSelect.new($requête)
$classeObjet.Créer().FiltrerSurID() // filtrage par défaut (pas de paramètre)
This.result.resultat:=Char(1)+$classeObjet.ListerCommunes()
// ----------------------
//MARK:Rolodex
// ----------------------
Function RolodexerPatronymes()
// des patronymes webables
var $c : Collection
$c:=New collection
This.RestaurerHTTP_collection("HTTP_Patronymes"; ->$c)
This.result.resultat:=cs.DicoDesNomsSelect.new($c).CréerRolodex()
Function RolodexerCommunes()->$result : Text
// des patronymes webables
var $c : Collection
$c:=New collection
This.RestaurerHTTP_collection("HTTP_Communes"; ->$c)
This.result.resultat:=cs.CommunesSelect.new($c).CréerRolodex()
⇧
[class]DicoDesNoms - 06/06/2026 12:55:20
property lesNoms : Collection
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("DicoDesNoms"; $IDentité)
This.FiltrerSurPersonne()
Function Libellé($format : Object)->$result : Text
$result:=This.dataClass.Libellé($format)
// ----------------------
//MARK:Sélection
// ----------------------
Function FiltrerSurPersonne()
// supprimer de .lesNoms ceux qui ne sont pas dans HTTP_Personnes
// une liste doit exister
var $c1; $c2 : Collection
var $nom : Text
// récupérer la collection de noms
This.lesNoms:=This.dataClass.lesNoms
Case of
: (This.lesNoms=Null)
: (This.lesNoms.length<2)
Else
// collecter les personnes Webables
$c1:=cs.PersonnesSelect.new(Session.storage.HTTP_Personnes).dataClass.CollecterNomsSurID()
$c2:=New collection
For each ($nom; This.lesNoms)
If ($c1.indexOf($nom)>-1)
$c2.push($nom)
End if
End for each
// collection filtrée
This.lesNoms:=$c2
End case
Function LesPersonnes()->$result : cs.PersonnesSelect
// créer la sélection des personnes liés à ce patronyme
var $c : Collection
$c:=This.dataClass.LesPersonnes()
$result:=cs.PersonnesSelect.new($c)
$result.Créer()
// filtrer les personnes webables
$result.FiltrerSurID("HTTP_Personnes")
// ----------------------
//MARK:HTML
// ----------------------
Function LibelléLiéSurPersonnes()->$result : Text
var $url : Text
$url:=This.URLlienSurPersonnes()
$result:="<p>"
$result:=$result+Super.LibelléLié($url; New object("Options"; 0x0000))
// ajouter la liste des noms ayant le même patronyme (option : mise entre parenthèses)
This.selection:=This.lesNoms
$result:=$result+" "+This.EcrireListeNoms(New object("balise"; "span"; "Options"; 2))
$result:=$result+"</p>"
Function URLlienSurPersonnes()->$result : Text
If (Session.info.type="standalone")
// cas STATIC
$result:=This.Libellé()
$result:=This.document.getURLpersonnes()+Lowercase($result[[1]]; *)+"/"+This.hrefHTML()+".html"
Else
$result:=This._tagUrl+"Web/AfficherPersonnes?"+This.hrefHTML()
End if
Function LibelléLiéSurEvents()->$result : Text
var $url : Text
$url:=This.URLlienSurEvents()
$result:=Super.LibelléLié($url; New object("Options"; 0x0000))
Function URLlienSurEvents()->$result : Text
If (Session.info.type="standalone")
// cas STATIC : pas de lien
$result:=""
Else
$result:=This._tagUrl+"WebLISTE/AfficherLaCommune"+"?"+Session.storage.UserParams.UUIDcommune+"+?"+This.hrefHTML()
End if
Function hrefHTML()->$result : Text
// ID de this dans un lien HTML
$result:=This.IDunique
⇧
[class]UnionsSelect - 05/08/2024 19:00:20
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("UnionsSelect"; $requête)
This.selection:=Null
This.length:=0
Function TrierSelectionRecherche($triParConjoint1 : Boolean)
If ($triParConjoint1)
// trier par le nom / prénom du premier conjoint
This.selectionRecherche:=This.selectionRecherche.orderBy("itemNom asc")
Else
// trier par le nom / prénom du secon conjoint
This.selectionRecherche:=This.selectionRecherche.orderByMethod(Formula(Compare strings(Substring($1.itemNom.value; Position(" & "; $1.itemNom.value)+3); Substring($1.itemNom.value2; Position(" & "; $1.itemNom.value2)+3))<0))
End if
⇧
[class]$pageWebREQUETE - 06/06/2026 15:31:42
property entité : cs.Medias
Class extends $pageWeb
Class constructor()
Super()
//----------------------------------
// MARK:Accueil
//----------------------------------
Function ListerNomsPersonnes()
var $texte : Text
$texte:=cs.PersonnesSelect.new(Session.storage.HTTP_Personnes).ListerNomsPersonnes(New object("balise"; "h4"; "Options"; 1))
// remarque v8.1.16 : dans le cas du serveur WEB, l'appel se fait par un workerWeb ; "Caractère(1)+" n'est plus utile
WEB SEND TEXT($texte; "text/html")
Function ListerNomsCommunes()
var $texte : Text
$texte:=cs.CommunesSelect.new(Session.storage.HTTP_Communes).ListerNomsCommunes(New object("balise"; "h4"; "Options"; 1))
// remarque v8.1.16 : dans le cas du serveur WEB, l'appel se fait par un workerWeb ; "Caractère(1)+" n'est plus utile
WEB SEND TEXT($texte; "text/html")
Function estMotDePasseValide()
var $texte : Text
var $result : Boolean
$result:=False
Case of
: (This.paramsUrl.length=0)
: (This.paramsUrl[0]="")
Else
$texte:=""
BASE64 DECODE(This.paramsUrl[0]; $texte)
// @ est interdit dans le mdp
$result:=Not(This.fct.ContientJoker($texte))
$result:=$result & Match regex("(?=.*?[a-z])(?=.*?[A-Z])(?=.*?[0-9])(?=.*?[#!*$%&-_]).{10,}"; $texte)
End case
$texte:=String($result)
WEB SEND TEXT($texte; "text/html")
//----------------------------------
// MARK:Personnes
//----------------------------------
Function ListerPersonnes()
var $data; $sessionStorage : Object
var $personnesSelect : Object
var $texte : Text
$sessionStorage:=This.getStorage()
// sélectionner le patronyme demandé (il est forcément dans "HTTP_Patronymes")
// v8.1.17 : envoi des personnes par groupe
// le processus est contrôlé par l'objet UserWebRequete.personnes, qui comprend la collection des personnes et les paramètres d'avancement
$data:=$sessionStorage["UserWebRequetePersonnes"]
If ($data=Null)
// créer la sélection de Personnes
$personnesSelect:=cs.DicoDesNoms.new($sessionStorage.UserParams.UUIDpatronyme).LesPersonnes()
This.SessionStorageAjouter($personnesSelect; "UserWebRequetePersonnes")
$data:=$sessionStorage.UserWebRequetePersonnes
Use ($data)
// initialiser les paramètres de la boucle
$data.indexDébut:=0
// construction du site statique : un seul appel
// requete serveur : paquet de 20 par appel
$data.taille:=Choose(Session.info.type="standalone"; $personnesSelect.selection.length; 20)
End use
End if
$texte:=This.ListerGroupePersonnes()
Case of
: (Session.info.type="standalone")
// cas STATIC : renvoyer cette liste (elle est complète)
// remarque v8.2.10 : dans le cas du site Web, l'appel se fait par une balise 4D ; "Caractère(1)+" est nécessaire
This.result.resultat:=Char(1)+$texte
// on est en construction dynamique de le page : fixer le groupe suivant
: (OB Is empty($data))
// cas où le user a quitté la page avant la fin du processus
This.CloreRequete("UserWebRequetePersonnes")
Else
// paquet suivant
Use ($data)
$data.indexDébut:=$data.indexDébut+$data.taille
End use
If ($data.indexDébut<=$sessionStorage.UserWebRequetePersonnes.PersonnesSelect.selection.length)
// ajouter l'indicateur de suite
$texte:=$texte+"<p id="+Char(Double quote)+"ListerPersonnes"+Char(Double quote)+"><img alt="+Char(Double quote)+"waiting"+Char(Double quote)+" height="+Char(Double quote)+"16"+Char(Double quote)+" src="+Char(Double quote)+"<!--#4DTEXT wwwRacineRessources-->ressources/images/waiting.gif"+Char(Double quote)+" width="+Char(Double quote)+"16"+Char(Double quote)+"/></p>"
Else
// c'est le dernier envoi, purger la requête
This.CloreRequete("UserWebRequetePersonnes")
End if
WEB SEND TEXT($texte; "text/html")
End case
Function ListerGroupePersonnes()->$result : Text
// traiter un paquet de .taille de la selection .UserWebRequetePersonnes.selection
var $sessionStorage; $data : Object
var $indexDébut; $indexFin; $tailleSelection : Integer
var $PersonnesSelect : cs.PersonnesSelect
$sessionStorage:=This.getStorage()
$data:=$sessionStorage.UserWebRequetePersonnes
$tailleSelection:=$data.PersonnesSelect.selection.length
// début de lecture de la sélection
$indexDébut:=$data.indexDébut
// fin de lecture de collection
$indexFin:=Choose(($indexDébut+$data.taille-1)<$tailleSelection; $indexDébut+$data.taille-1; $tailleSelection)
// créer la sélection à lister
$PersonnesSelect:=cs.PersonnesSelect.new()
$PersonnesSelect.selection:=$data.PersonnesSelect.selection.slice($indexDébut; $indexFin+1) // rappel : $indexFin+1 n'est pas dans $PersonnesSelect.selection
$result:=$PersonnesSelect.EcrireSelection()
//----------------------------------
// MARK:Events
//----------------------------------
Function ListerEvenements()
var $sessionStorage; $data : Object
var $eventsSelect : Object
var $i; $j : Integer
var $texte : Text
$sessionStorage:=This.getStorage()
// v8.1.17 : envoi des évènements pour une table décennale, autant d'appels que de tables
// le processus est contrôlé par UserWebRequeteEvents
$data:=$sessionStorage.UserWebRequeteEvents
If ($data=Null)
// fixer les Events de la commune :
// de plus les events doivent appartenir à une personne patronymée 'UserParams.UUIDpatronyme'
$eventsSelect:=$sessionStorage.UserParams.EventsSelect.FiltrerSurPatronyme()
This.SessionStorageAjouter($eventsSelect; "UserWebRequeteEvents")
$data:=$sessionStorage.UserWebRequeteEvents
// coté serveur, chaque décennie fait l'objet d'une requête HTTP
// trouver la première décennie
$i:=Year of($eventsSelect.selection[0].dateNum)
$i:=10*Int($i/10)
// trouver la dernière décennie
$j:=Year of($eventsSelect.selection[$eventsSelect.length-1].dateNum)
$j:=10*Int($j/10)+1
Use ($data)
$data.dateDébut:=$i
$data.dateFin:=$j
End use
End if
Case of
: (Session.info.type="standalone")
// cas STATIC, on doit génèrer toutes les décennies d'un coup
$texte:=""
Repeat
$texte:=$texte+This.EvenementsDecennaux($sessionStorage)
Use ($data)
$data.dateDébut:=$data.dateDébut+10
End use
Until ($data.dateDébut>$data.dateFin)
// remarque v8.2.10 : dans le cas du site Web, l'appel se fait par une balise 4D ; "Caractère(1)+" est nécessaire
This.result.resultat:=Char(1)+$texte
: (OB Is empty($data))
// cas où le user a quitté la page avant la fin du processus
This.CloreRequete("UserWebRequeteEvents")
Else
// calculer cette décennie
$texte:=This.EvenementsDecennaux($sessionStorage)
// préparer la décennie suivante (pour le prochain appel)
Use ($data)
$data.dateDébut:=$data.dateDébut+10
End use
// s'il reste des decennies à traiter, prévenir le client
If ($data.dateDébut<$data.dateFin)
// ajouter l'indicateur de suite = un élément HTML avec id = nom de cette function (cf le workerd javascript)
$texte:=$texte+"<p id="+Char(Double quote)+"ListerEvenements"+Char(Double quote)+"><img alt="+Char(Double quote)+"waiting"+Char(Double quote)+" height="+Char(Double quote)+"16"+Char(Double quote)+" src="+Char(Double quote)+"<!--#4DTEXT wwwRacineRessources-->ressources/images/waiting.gif"+Char(Double quote)+" width="+Char(Double quote)+"16"+Char(Double quote)+"/></p>"
Else
// purger la requête
This.CloreRequete("UserWebRequeteEvents")
End if
WEB SEND TEXT($texte; "text/html")
End case
//Fin de si
Function EvenementsDecennaux($sessionStorage : Object)->$result : Text
// éditer les évents de la décennie demandée
var $formats; $data : Object
$result:=""
If ($sessionStorage.UserWebRequeteEvents.EventsSelect.length>0)
// fixer les formats affichage d'un event et d'une personne
$formats:=New object
$formats.event:=OB Copy($sessionStorage.WebUserPrefs.Apparence)
$formats.event.Options:=0x1100
$formats.personne:=New object("Options"; 0x0007)
// ajouter les Tables Decennales de la sélection entités
$data:=New object
$data.formats:=$formats
If ($sessionStorage.UserWebRequeteEvents.dateDébut<$sessionStorage.UserWebRequeteEvents.dateFin)
// les events de cette décennie
$data.index:=$sessionStorage.UserWebRequeteEvents.dateDébut
$result:=This.EvenementsDecennie($sessionStorage; $data)
End if
End if
Function EvenementsDecennie($sessionStorage : Object; $data : Object)->$result : Text
// events de la décennie
var $eventsSelect : cs.EventsSelect
$result:=""
$data.dateMin:=Add to date(!00-00-00!; $data.index; 1; 1)
$data.dateMax:=Add to date(!00-00-00!; $data.index+10; 1; 1)
// ne garder que des actes d'état civil :
// sélection d'events de la décennie (plus les reconnaissances et divorces)
$eventsSelect:=$sessionStorage.UserWebRequeteEvents.EventsSelect.FiltrerSurDecennie($data)
If ($eventsSelect.length>0)
// on a des biscuits : écrire la décennie
$result:=$eventsSelect.EcrireDecennie($data)
End if
//----------------------------------
// MARK:Lieux
//----------------------------------
Function getDepartementsDuPays()
var $texte : Text
var $entité : Object
var $c : Collection
$texte:="<option value=-3> </option>" // pas de sélection par défaut
Case of
: (This.paramsUrl.length=0)
: (Not(Match regex("[0-9ABCDEF]{32}"; This.paramsUrl[0])))
Else
$entité:=cs.Pays.new(This.paramsUrl[0])
$c:=$entité.LesDepartements().selection
If ($c.length>0)
For each ($entité; $c)
// traiter l'entité courante
$texte:=$texte+"<option id = "+$entité.IDunique+">"+String($entité.numero)+"</option>"
End for each
End if
End case
WEB SEND TEXT($texte; "text/html")
Function getCommunesDuDepartement()
var $texte : Text
var $entité : Object
var $c : Collection
$texte:="<option value=-3> </option>" // pas de sélection par défaut
Case of
: (This.paramsUrl.length=0)
: (Not(Match regex("[0-9ABCDEF]{32}"; This.paramsUrl[0])))
Else
$entité:=cs.Departements.new(This.paramsUrl[0])
$c:=$entité.LesCommunes().selection
If ($c.length>0)
For each ($entité; $c)
// traiter l'entité courante
$texte:=$texte+"<option id = "+$entité.IDunique+">"+$entité.nom+"</option>"
End for each
End if
End case
WEB SEND TEXT($texte; "text/html")
//----------------------------------
// MARK:Diaporama
//----------------------------------
Function FixerOrientationEcran()
If (This.paramsUrl.length>0)
Use (Session.storage.UserParams)
Session.storage.UserParams.OrientationEcran:=This.paramsUrl[0]
End use
End if
// réponse pour une requête HTML
WEB SEND TEXT(""; "texte/html")
Function InformationMedia()
// l'url est de la forme /4DACTION/EcrireElement/ALVHTTP/WebREQUETE/getInformationMedia/function?indiceMedia
var $texte : Text
// erreur par défaut
$texte:="err getInformtionMedia"
Case of
: (This.paramsUrl.length=0)
: (Not(OB Is defined(This; This.paramsUrl[0])))
// function inconnue
: (Session.storage.UserParams.MediasSelect.length=0)
: (Num(This.paramsUrl[1])>Session.storage.UserParams.MediasSelect.length)
Else
// ok on a tout
// le media concerné
This.entité:=Session.storage.UserParams.MediasSelect.selection[Num(This.paramsUrl[1])]
// demander l'info
This[This.paramsUrl[0]]()
End case
Function LireLargeur()
WEB SEND TEXT(String(This.entité.largeur); "texte/html")
Function LireHauteur()
WEB SEND TEXT(String(This.entité.largeur); "texte/html")
Function LireNumerotation()
var $texte : Text
$texte:=String(Num(This.paramsUrl[1])+1)+" / "+String(Session.storage.UserParams.MediasSelect.length)
WEB SEND TEXT($texte; "texte/html")
Function LireTitre()
var $texte : Text
$texte:=This.entité.titre
$texte:=$texte+" - "+Choose(This.entité.dateNumValid; ""; "vers ")+This.entité.dateChaine
WEB SEND TEXT($texte; "texte/html")
Function LireMedia()
var $path; $texte : Text
// il faudrait tester le Type de media (image / video)
// chemin du media
$path:=This.document.getHostMediaPath("URLMedia"; This.entité; New object("attribute"; "ID"))
$texte:="<a>"
$texte:=$texte+"<img src="+Char(Double quote)+$path+Char(Double quote)+" title="+Char(Double quote)+This.entité.titre+Char(Double quote)
// terminer la balise (format flex)
Case of
: (This.entité.largeur>=This.entité.hauteur)
$texte:=$texte+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: (This.entité.largeur<This.entité.hauteur)
$texte:=$texte+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$texte:=$texte+"</a>"
WEB SEND TEXT($texte; "texte/html")
Function LireComment()
var $formats; $entité : Object
var $ID : Integer
var $texte : Text
// on va changer localement des options : les recopier
$formats:=OB Copy(Session.storage.WebUserPrefs.Apparence)
// la zone du media
$ID:=This.entité.ID
ARRAY LONGINT($tabID; 0)
Begin SQL
SELECT ID FROM Zones WHERE Zones.media = :$ID AND type = 1 INTO :$tabID;
End SQL
If (Size of array($tabID)>0)
$ID:=$tabID{1}
// media de qui?
Begin SQL
SELECT personne FROM Personnages WHERE Personnages.zone = :$ID INTO :$tabID;
End SQL
End if
// finalement :
If (Size of array($tabID)>0)
$entité:=cs.Personnes.new($tabID{1})
$formats.Options:=7
$texte:=$entité.Libellé($formats)
Else
Begin SQL
SELECT event FROM Instantanes WHERE Instantanes.zone = :$ID INTO :$tabID;
End SQL
If (Size of array($tabID)>0)
$entité:=cs.Events.new($tabID{1})
$formats.Options:=0x3D00
$texte:=$entité.Libellé($formats)
Else
Begin SQL
SELECT lieu FROM Paysages WHERE Paysages.zone = :$ID INTO :$tabID;
End SQL
If (Size of array($tabID)>0)
$entité:=cs.Lieux.new($tabID{1})
$formats.Options:=0x00040000
$texte:=$entité.Libellé($formats)
Else
$texte:=""
End if
End if
End if
WEB SEND TEXT($texte; "texte/html")
//----------------------------------
// MARK:Recherche
//----------------------------------
Function RechercherPersonnes()
var $classeObjet : Object
var $sélection : cs.PersonnesSelect
var $texte : Text
// chercher les personnes répondant aux critères This.paramsUrl
$classeObjet:=cs.xSQL.PersonnesSelect.new()
$classeObjet.Chercher(This.paramsUrl)
// créer et filtrer la sélection de personnes
$sélection:=cs.PersonnesSelect.new($classeObjet.collection)
$sélection.Créer()
$sélection.FiltrerSurID("HTTP_Personnes")
// créer la liste
$sélection.CréerListeDeSélection()
// trier
$sélection.TrierSelectionRecherche()
// créer l'élément HTML
$texte:=$sélection.CréerTableauHTML()
WEB SEND TEXT($texte; "texte/html")
Function RechercherUnions()
var $classeObjet : Object
var $sélection : cs.UnionsSelect
var $texte : Text
// chercher les personnes répondant aux critères This.paramsUrl
$classeObjet:=cs.xSQL.UnionsSelect.new()
$classeObjet.Chercher(This.paramsUrl)
// créer la sélection d'unions
$sélection:=cs.UnionsSelect.new($classeObjet.collection)
$sélection.Créer()
// créer la liste
$sélection.CréerListeDeSélection()
// trier
$sélection.TrierSelectionRecherche(True)
// créer l'élément HTML
$texte:=$sélection.CréerTableauHTML()
WEB SEND TEXT($texte; "texte/html")
//----------------------------------
// MARK:Utilitaires
//----------------------------------
Function CloreRequete($nom : Text)
// purger la requête $nom
Use (Session.storage)
Session.storage[$nom]:=Null
End use
⇧
[class]DepartementsSelect - 24/06/2024 19:07:03
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("DepartementsSelect"; $requête)
This.selection:=Null
This.length:=0
⇧
[class]Events - 30/05/2025 14:40:48
property leLieu : cs.Lieux
// attributs de la classe
property type : Integer
property dateNum : Date
property dateChaine; commentaire; source : Text
property genre : Boolean
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
// rappel : l'event est genré dynamiquement (voir le getEvent() de la classe Personne)
Super("Events"; $IDentité)
// ----------------------
//MARK:Wrappers
// ----------------------
Function Libellé($formats : Object)->$libellé : Text
$libellé:=This.dataClass.Libellé($formats)
Function FormaterDate($formats : Object)->$result : Text
$result:=This.dataClass.FormaterDate($formats)
Function FormaterHeure($formats : Object)->$result : Text
$result:=This.dataClass.FormaterHeure($formats)
Function parent()->$result : Object
// chercher le parent
$result:=This.dataClass.parent()
// ----------------------
//MARK:Selection
// ----------------------
Function getEntité($data)->$result : Object
// renvoie l'entité de this correspondant à l'objet saisie ($data)
$result:=This.InitResult()
$result.entité:=Null
Case of
: (This.DataClassNom#$data.DataClassNom)
: (Not(OB Is defined($data; "type")))
: (This.type#$data.type)
Else
// c'est cette entité
$result.entité:=This
End case
$result.success:=Not($result.entité=Null)
Function LesProtagonistes()->$result : cs.PersonnesSelect
var $c : Collection
$c:=This.dataClass.LesProtagonistes()
$result:=cs.PersonnesSelect.new($c)
$result.Créer()
// trier par sexe
$result.selection.orderBy("sexe asc")
Function LeLieu()->$result : cs.Lieux
$result:=cs.Lieux.new(This.leLieu.ID)
// ----------------------
//MARK:PageHTML
// ----------------------
Function BioData($formats : Object)->$result : Text
// informations d'un biodata : nomType / date / heure / lieu avec lien
var $sessionStorage; $formats_locaux : Object
var $entité : cs.Communes
$sessionStorage:=This.getStorage()
// ne pas toucher aux options amont
$formats_locaux:=OB Copy($formats)
// fixer les options de l'event : bits 8, 10, 12, 13 et 14 (date, heure avec entêtes)
// fixer les options du lieu : bits 16, 22 (n° département commune, département)
$formats_locaux.Options:=0x00417500
// fixer le format horodatage
$formats_locaux.FormatDate:=$sessionStorage.WebUserPrefs.Apparence.FormatDate
$formats_locaux.FormatHeure:=$sessionStorage.WebUserPrefs.Apparence.FormatHeure
// les formats sont fixés
$result:=This.Libellé($formats_locaux)
If ($result#"")
$result[[1]]:=Lowercase($result[[1]]; *)
End if
// ajouter la commune de l'event
$result:="<span>, "+$result
Case of
: (This.leLieu=Null)
: (This.leLieu.ID<=0)
//cas possible en serveur Web
Else
$entité:=cs.Communes.new(This.leLieu.leSite.laCommune.ID)
$result:=$result+This.document.LireLocatedSTR(1012)+$entité.LibelléLiéSurEvent($formats_locaux)
End case
$result:=$result+"</span>"
Function EtatCivil($formats : Object)->$result : Text
// informations d'un évent d'état civil : date / heure / nomType / les protagonistes
var $texte; $soustexte : Text
var $entité : Object
var $c : Collection
// écrire la date de l'event
$soustexte:=This.FormaterDate($formats.event)
// écrire l'heure de l'event
$soustexte:=$soustexte+This.FormaterHeure($formats.event)
If ($soustexte#"")
// supprimer le premier blanc
$soustexte:=Substring($soustexte; 2)
// début de phrase
$soustexte[[1]]:=Uppercase($soustexte[[1]]; *)
End if
$texte:="<p>"
$texte:=$texte+"<span>"+$soustexte+", "
// écrire le nom de l'event
$soustexte:=This.Libellé($formats.event)+This.document.LireLocatedSTR(1001)
If ($soustexte#"")
$soustexte[[1]]:=Lowercase($soustexte[[1]]; *)
End if
$texte:=$texte+$soustexte+"</span>"
// écrire la personne ou le couple
// fixer les formats affichage d'un event et d'une personne
$formats.personne.aLaDate:=This.dateNum
Case of
: (Int(This.type/1000)=22) // event perso
// chercher la personne de l'event
$entité:=This.LesProtagonistes().selection[0]
$soustexte:=$entité.LibelléLié($formats.personne)
$texte:=$texte+$soustexte
// ajouter les parents
$soustexte:=$entité.InformationParents($formats.personne)
$texte:=$texte+$soustexte
: (Int(This.type/1000)=33) // event fam
// chercher les personnes de l'event
$c:=This.LesProtagonistes().selection
For each ($entité; $c)
$soustexte:=$entité.PersonneAgé($formats.personne)
$texte:=$texte+$soustexte
// ajouter les parents
$soustexte:=$entité.InformationParents($formats.personne)
$texte:=$texte+$soustexte
// lien conjoints
If ($c.indexOf($entité)=0)
$texte:=$texte+"<span>"+","+This.document.LireLocatedSTR(1088)+","+This.document.LireLocatedSTR(1014)+"</span>"
Else
$texte:=$texte+"<span>"+","+This.document.LireLocatedSTR(1089)+"</span>"
End if
End for each
End case
$result:=$texte+"</p>"
// ----------------------
//MARK:Saisie
// ----------------------
Function Modifier($params : Object)->$result : Object
// ici, voir si l'event n'a pas été modifié
// $3 est une entité saisie
var $data; $entité : Object
var $UUID : Text
var $ID : Integer
// nouveau lieu?
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_nom")))
// saisie incomplète (valeur nulle, en principe virée précédemment)
$result:=This.InitResult(-16402; "le nom de la commune n'est pas saisi"; False)
: (This.estNouvelleCommune($params))
// on a le nom d'une nouvelle commune : la créer au département saisi (sélectionné ou nouveau, ici on ne sait pas)
// ajouter une commune au département demandé. 2 cas :
If ($params.leLieu_leSite_laCommune_leDepartement_numero=$params.leLieu_leSite_laCommune_leDepartement_IDnumero)
// on a sélectionné un département existant :
$entité:=cs.Departements.new($params.leLieu_leSite_laCommune_leDepartement_IDunique)
Else
// on a saisi le nom d'un nouveau département : ajouter la commune à un département de travail existant :
$entité:=cs.Departements.new("312AC6A580A649E2A9D760585382E5A3")
End if
// on a un département ; lui ajouter une commune
// les données de la commune sont dans l'entité saisie $params
$result:=$entité.Ajouter(WEB Ajouter Commune; $params)
If ($result.success)
$UUID:=$result.entitéAjoutée.IDunique
End if
: ($params.leLieu_leSite_laCommune_IDunique=This.LeLieu().Le("Communes").IDunique)
// pas de changement
$UUID:=""
Else
// on a sélectionné une autre commune (existante)
$UUID:=$params.leLieu_leSite_laCommune_IDunique
End case
// si ok, on a le UUID de la commune de l'event
Case of
: ($result.success=False)
: ($UUID="")
Else
// on a une commune
// trouver son lieu de type 60700 (existe toujours)
$ID:=cs.Communes.new($UUID).LieuParDefaut().ID
If ($ID>0)
// ok lier ce lieu à this
// crée un quoi à this
$data:=New object
// définir l'entité aQui
$data.aQui:=New object("DataClassNom"; This.DataClassNom; "IDunique"; This.IDunique)
// définir l'entité Qui
$data.Qui:=Null
// les paramètres
$data.params:=New object("attribut"; "lieu"; "valeur"; $ID)
// faire l'ajout en BDD
$result:=This.LierDansDataStore($data)
If ($result.success)
cs.$filtrageDonnees.new().Ajouter(cs.Lieux.new($ID))
End if
Else
$result:=This.InitResult(-15006; "le lieu de type 60700 de la commune "+$params.leLieu_leSite_laCommune_nom+" n'est pas unique"; False)
End if
End case
Function estNouvelleCommune($params : Object)->$result : Boolean
// renvoie vrai si une nouvelle commune est saisie
$result:=True
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_IDnom")))
// on a saisi le nom d'une nouvelle commune, mais pas de ID (a priori nouveau département / pays)
: ($params.leLieu_leSite_laCommune_nom#$params.leLieu_leSite_laCommune_IDnom)
// on a saisi le nom d'une nouvelle commune à la place d'une ancienne (en BDD)
Else
$result:=False
End case
Function FixerQuoiAjout()->$result : Integer
// fixer le Quoi pour un ajout à la BDD
If (This.type<22999)
$result:=WEB Ajouter Event Personnel
Else
$result:=WEB Ajouter Event Familial
End if
⇧
[class]Regions - 30/05/2025 14:37:12
property lePays : cs.Pays
Class extends _WEB_DataStore
Class constructor($IDentité : Variant)
// initialiser l'objet avec les données de l'entité $IDentité de la BDD
Super("Regions"; $IDentité)
// ----------------------
//MARK:Saisie
// -----------------------
Function Modifier($params : Object)->$result : Object
// voir si la région a été modifiée
var $entité; $data : Object
$result:=This.InitResult()
// ici pas d'attibuts gérés en saisie
// si nouveau pays, le créer
Case of
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom")))
// pas trop normal
$result.Error:=-15068
$result.ErrorDescription:="$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom n'est pas défini"
: (Not(OB Is defined($params; "leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDunique")))
// pas trop normal
$result.Error:=-15068
$result.ErrorDescription:="$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDunique n'est pas défini"
: (This.Le("Pays").nom=$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom)
// la région est accrochée au bon endroit
: ($params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_nom=$params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDnom)
// le pays existe, faire le lien ; trouver son ID
$entité:=cs.Pays.new($params.leLieu_leSite_laCommune_leDepartement_laRegion_lePays_IDunique)
$data:=New object
// définir l'entité aQui
$data.aQui:=New object("DataClassNom"; This.DataClassNom; "IDunique"; This.IDunique)
// définir l'entité Qui
$data.Qui:=Null
// les paramètres
$data.params:=New object("attribut"; "pays"; "valeur"; $entité.ID)
// faire l'ajout en BDD
$result:=This.LierDansDataStore($data)
Else
// on est dans un nouveau pays
// créer un pays à la région
$result:=This.Ajouter(WEB Ajouter Pays; $params)
End case
⇧
[class]CommunesSelect - 03/04/2025 13:49:46
Class extends _WEB_DataStore
Class constructor($requête : Variant)
Super("CommunesSelect"; $requête)
This.selection:=Null
This.length:=0
Function CréerRolodex()->$result : Text
// des communes webables
This.getEntréesRolodex("nom")
$result:=Super.EcrireRolodex("nom"; "Web/SelectionnerCommunes")
// ----------------------
//MARK:Sélection
// ----------------------
Function Créer()->$result : Object
// créer une collection d'entités
This.setEntités()
// filtrer les redondances
// pour une suite éventuelle
$result:=This
Function FiltrerSurID()
// filtrer les entités de .selection
Super.FiltrerSurID("HTTP_Communes")
Function ListerNomsCommunes($params : Object)->$result : Text
// lister le nom des communes Webables
This.selection:=This.dataClass.CollecterNomsSurID()
$result:=This.EcrireListeNoms($params)
Function ListerCommunes()->$result : Text
// renvoyer la liste des noms de this.collection, avec lien
var $entité; $formats : Object
// les trier
This.selection:=This.selection.orderBy("nom asc")
// fixer les formats affichage
$formats:=New object("Options"; 0x00C80000)
$result:=""
For each ($entité; This.selection)
// lien sur le nom de la commune
$result:=$result+$entité.LibelléLiéSurNom($formats)
End for each
// ----------------------
//MARK:Maintenance
// ----------------------
Function CréerMediasWebables($data : Object; $params : Object; $dossier : 4D.Folder)
// passer en revue toutes les communes sélectionnés, et copier leur blason webiné dans le dossier temporaire
var $entité : cs.Communes
var $pict : Picture
var $cheminFichier : Text
// c'est parti (on ne fait pas dans la dentelle : toutes les images sont recréées)
For each ($entité; This.selection) While (Not($data.tache.partage.Tuer.signaled))
$pict:=$entité.CréerVersionWebable($params)
// ajouter le fichier image au dossier
$cheminFichier:=$dossier.file($params.document.getNomFichierMedia($entité; New object("attribute"; "icône"))).platformPath
WRITE PICTURE FILE($cheminFichier; $pict; Web Icon format)
End for each
⇧
[class]$pageWebPROFIL - 31/07/2025 09:55:02
property sessionUser; Utilisateur : cs.UtilisateursALV
Class extends $pageWeb
Class constructor()
Super()
//----------------------------------
// MARK:Element HTML
//----------------------------------
Function EcrireUserAuthentification()
var $texte : Text
// créer un utilisateur vide
This.getUser()
$texte:=""
$texte:=$texte+This.EcrireAttribut("LogIn"; 141; "")
$texte:=$texte+This.EcrireAttribut("Password"; 118; " motDePasse")
$texte:=$texte+This.EcrireSubmit("Annuler"; "Se connecter")
This.result.resultat:=Char(1)+$texte
Function EcrireProfilUtilisateur()
var $texte : Text
$texte:=""
If (Not(Session.isGuest()))
// quel est l'utilisateur de cette session? -> dans This.sessionUser
This.getUser()
$texte:=$texte+This.EcrireAttribut("LogIn"; 141; "")
$texte:=$texte+This.EcrireAttribut("Password"; 118; " passWord")
$texte:=$texte+This.EcrireMessage(5043)
$texte:=$texte+This.EcrireAttribut("AdresseEmail"; 142; "")
$texte:=$texte+This.EcrireSubmit("Annuler"; "Valider")
End if
This.result.resultat:=Char(1)+$texte
Function EcrireAttribut($attribut : Text; $libellé : Integer; $typeLigne : Text)->$result : Text
var $Xpath; $pathSaisie; $ElémentXML : Text
This.InitStructureXML("saisieProfil ligne")
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$pathSaisie:=This.sessionUser.DataClassNom+"?"+String(This.sessionUser.ID)+"?"+$attribut+"?"+String(Is text)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil libelleProfil")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p/label"; "for"; $pathSaisie)
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR($libellé))
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil valeurProfil"+$typeLigne)
$ElémentXML:=DOM Create XML element($ElémentXML; "input"; "value"; This.sessionUser[$attribut]; "type"; "text"; "id"; $pathSaisie; "name"; $pathSaisie; "size"; "20")
If ($typeLigne="@motDePasse@")
DOM SET XML ATTRIBUTE($ElémentXML; "type"; "password")
End if
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil")
If ($typeLigne="@passWord@")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p[2]/img"; "class"; "elementProfil"; "id"; "feuRouge"; "alt"; "image 16332"; "height"; "16"; "width"; "16"; "src"; "../../ressources/images/16332.svg")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p[2]/img"; "class"; "elementProfil"; "id"; "feuVert"; "alt"; "image 16333"; "height"; "16"; "width"; "16"; "src"; "../../ressources/images/16333.svg")
End if
$result:=This.ExporterStructureXML()
Function EcrireMessage($libellé : Integer)->$result : Text
var $Xpath; $ElémentXML : Text
This.InitStructureXML("nonSaisieProfil ligne libelleProfil")
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil messageProfil")
DOM SET XML ELEMENT VALUE($ElémentXML; This.document.LireLocatedSTR($libellé))
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil")
$result:=This.ExporterStructureXML()
Function EcrireSubmit($koLabel : Text; $okLabel : Text)->$result : Text
var $Xpath; $ElémentXML : Text
This.InitStructureXML("nonSaisieProfil ligne libelleProfil")
DOM GET XML ELEMENT NAME(This.RacineXML; $Xpath) // récupérer la racine
$Xpath:=$Xpath+"/"
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil"; "id"; "submitProfil")
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p[2]/a/input"; "type"; "submit"; "name"; "wwwBtnSubmit"; "value"; $koLabel)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p[2]/a[2]/input"; "type"; "submit"; "name"; "wwwBtnSubmit"; "value"; $okLabel)
$ElémentXML:=DOM Create XML element(This.RacineXML; $Xpath+"p"; "class"; "elementProfil")
$result:=This.ExporterStructureXML()
Function getUser()
This.sessionUser:=cs.UtilisateursALV.new(Session.userName)
//----------------------------------
// MARK:Submit
//----------------------------------
Function SoumettreFormulaire()
// gère le submit de la saisie du profil
// récupérer les données du formulaire
This.LireHTTPvars()
// exécuter le submit
Case of
: (Session.storage.HTTPvars=Null)
: (Session.storage.HTTPvars.length=0)
: (OB Is defined(Session.storage.HTTPvars; "wwwBtnSubmit"))
Case of
: (Session.storage.HTTPvars.wwwBtnSubmit="Annuler")
// retour à l'accueil
This.Envoyer("accueil.shtml"; "accueil")
: (Session.storage.HTTPvars.wwwBtnSubmit="Se connecter")
// on a cliqué sur le btn ok de formulaire Auth
This.Authentifier()
: (Session.storage.HTTPvars.wwwBtnSubmit="Valider")
// on a cliqué sur le btn ok de formulaire Profil
This.Modifier()
// supprimer le cookie, pour forcer la ré authentification
This.SupprimerCookie()
// retour site static
This.Deconnecter()
End case
End case
Function Modifier()
var $entité; $objet; $result : Object
// lire les données actuelles en BDD
This.getUser()
$entité:=This.sessionUser
// lire ce qui a été saisi
$objet:=This.LireSaisie(This.sessionUser)
// faire les modifications (comparaison entre This.Descripteur et $objet)
// rappel 'This.sessionUser' est la porte d'entrée au DataStore
$result:=$entité.ModifierDansDataStore($entité; $objet)
Function LireSaisie($user : Object)->$result : Object
// lire ce qui a été saisi
var $i : Integer
// $user = données actuelles ; recopier dedans ce qui a été saisi
$result:=OB Copy($user)
ARRAY TEXT($tableauDeNoms; 0)
ARRAY TEXT($tableauDeValeurs; 0)
// les variables récupérées correspondent à des objets de formulaire Web ayant un attribut "name"
WEB GET VARIABLES($tableauDeNoms; $tableauDeValeurs)
For ($i; 1; Size of array($tableauDeNoms))
// récupérer les paramètres du champ
This.Descripteur:=Split string($tableauDeNoms{$i}; "?")
// rappel : this.Descripteur est du type [ UtilisateursALV ; IDentité ; nomAttribut ; typeValeurAttribut ]
Case of
: ($tableauDeValeurs{$i}="")
// filtrer les valeurs non saisie (vides)
: (This.Descripteur[0]#"UtilisateursALV")
// pas reconnu ! en particulier les submit
Else
$result[This.Descripteur[2]]:=$tableauDeValeurs{$i}
End case
End for
// verrue : IOS a tendance à imposer une majuscule en début de saisie
// attention ici on impose des lettres minuscules sans accent
$result.LogIn:=Lowercase($result.LogIn)
// ----------------------
//MARK:Utilitaires XML
// -----------------------
Function InitStructureXML($nomClass : Text)
This.RacineXML:=DOM Create XML Ref("div")
DOM SET XML ATTRIBUTE(This.RacineXML; "class"; $nomClass)
// récupérer le user courant
This.Utilisateur:=Session.storage.UserParams.Personnes
Function ExporterStructureXML()->$result : Text
var $datatexte : Text
DOM EXPORT TO VAR(This.RacineXML; $datatexte)
DOM CLOSE XML(This.RacineXML)
$result:=This.Nettoyer($datatexte)
Function Nettoyer($texte : Text)->$result : Text
$result:=Substring($texte; Position("<"; $texte; 2; *))
$result:=Replace string($result; "\r\r"; "")
⇧
[class]$maintenanceMedias - 18/02/2026 10:38:15
property serveur : cs.xSDK.ServicesFTP
property dossierTravail : 4D.Folder
property cataloguesBDD; cataloguesWeb : Object
Class extends $composant
Class constructor()
Super()
This.dossierTravail:=cs.$document.new().getDossierTravail().folder("WEB_TempoWebMedia")
This.dossierTravail.delete(Delete with contents)
// serveur FTP
This.serveur:=cs.xSDK.ServicesFTP.new()
//----------------------------
//MARK:Traitement Fichiers
//----------------------------
Function MettreAjourFichiersWeb($data : Object)
// les classes utilisent des données de la session utilisateur
// ici pas de session ; les données sont dans Storage
// rappel : $composant.getStorage() choisit le storage en fonction du contexte
Use (Storage)
Storage.sessionLocale:=New shared object
End use
// sélectionner tous les medias Webables
cs.$filtrageDonnees.new().CréerLesFiltres(False)
// Types de documents à générer / mettre à jour
// 1 - les documents (png et pdf) dérivés des médias Webables de la BDD mère (utilise les fichiers déposés dans l'hébergement)
// 2 - les autres images utilisés par le site (blasons...)
If (This.serveur.existsParamètres)
// c'est ok; on a les paramètres pour se connecter au site hébergeur
This.dossierTravail.create()
// *** commencer par les medias Webables
This.MettreAjourMediasWeb($data)
This.dossierTravail.delete(Delete with contents)
// // *** passer aux blasons des communes
This.dossierTravail.create()
This.MettreAjourIconsWeb($data)
// c'est fini
This.dossierTravail.delete(Delete with contents)
End if
Function MettreAjourMediasWeb($data : Object)
var $DossiersSelect : cs.DossiersSelect
var $MediasSelect : cs.MediasSelect
var $dossier : 4D.Folder
var $params; $result : Object
var $mediasInformation : Object
var $url : Text
This.trace.EnvoyerMessages([msgk_event; msgk_mail]; "ALV - Maintenance serveur Web"; Current method name; "MettreAjourMediasWeb")
// remarque : les dossiers video ne sont pas hébergés : il est normal qu'une erreur soit générée
// sélectionner tous les volumes possibles
$DossiersSelect:=cs.DossiersSelect.new("volume > 0")
$DossiersSelect.Créer()
// lister les catalogues disponibles des medias BDD
This.cataloguesBDD:=$DossiersSelect.getCataloguesBDD()
// lister les catalogues disponibles des medias Web
This.cataloguesWeb:=$DossiersSelect.getCataloguesWeb()
// sélectionner les medias Webables
$MediasSelect:=cs.MediasSelect.new(Session.storage.HTTP_Medias)
$MediasSelect.Créer()
// c'est parti
$MediasSelect.CréerMediasWebables($data; This)
// lister les dossiers créés, non vides
// transférer les medias webinés sur l'hébergeur
For each ($dossier; This.dossierTravail.folders(fk ignore invisible)) While (Not($data.tache.partage.Tuer.signaled))
If ($dossier.files().length>0)
// le nom des dossiers est au format des chemins FTP : "folder_IDvolume"
$url:=This.document.getHostFolderPath("WebMedia")+$dossier.name+"/"
// transférer le contenu (options = remplacer si existent, supprimer les fichiers orphelins)
$params:=New object
$params.dossier:=$dossier
$params.cheminFTP:=$url
$params.Options:=0x0005
$params.tache:=cs.xSDK.RegistreTaches.new().Inscrire(New object("nomProcess"; Current process name; "nomTache"; "miseAjourMedias"; "numProcessAppelant"; Current process))
// lancer la tâche
$result:=This.serveur.MettreAjourDossier($params)
This.trace.Créer($result.Error; Current method name; "Envoi du contenu du dossier "+$dossier.name).LeverException([msgk_log])
If ($result.Error=0)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "ALV - Maintenance Medias Web"; Current method name; String($dossier.files().length)+" fichiers envoyés dans le dossier "+$url+" (voir détails dans les log)")
This.trace.EnvoyerMessages([msgk_log]; "Fichiers transférés"; Current method name; JSON Stringify($result.rapport))
End if
// envoyer le catalogue correspondant
$url:=This.document.getHostFolderPath("WebMedia")+$dossier.name
$mediasInformation:=OB Copy(OB Get(This.cataloguesWeb; String(Num($dossier.name)); Is object))
$result:=This.serveur.EcrireCatalogueDuDossier($url; $mediasInformation)
This.trace.Créer($result.Error; Current method name; "Envoi du catalogue du dossier "+$dossier.name).LeverException([msgk_log])
If ($result.Error=0)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_mail]; "ALV - Maintenance Medias Web"; Current method name; "Catalogue "+$dossier.name+" transféré dans "+$url)
This.trace.EnvoyerMessages([msgk_log]; "Catalogue transféré"; Current method name; JSON Stringify($mediasInformation))
End if
End if
End for each
// c'est fini pour les medias Webables
Function MettreAjourIconsWeb($data : Object)
var $CommunesSelect : cs.CommunesSelect
var $dossier; $result : Object
var $cheminFTP : Text
// sélectionner les communes Webables
$CommunesSelect:=cs.CommunesSelect.new(Session.storage.HTTP_Communes)
$CommunesSelect.Créer()
// récepteur des fichiers
$dossier:=This.dossierTravail.folder("icons")
$dossier.delete(Delete with contents)
$dossier.create()
// c'est parti
$CommunesSelect.CréerMediasWebables($data; This; $dossier)
// url du répertoire
$cheminFTP:=This.document.getHostFolderPath("WebIcons")
// nettoyer
$result:=This.serveur.SupprimerRépertoire($cheminFTP)
$result:=This.serveur.CréerRépertoire($cheminFTP)
// mettre à jour
$result:=This.serveur.EnvoyerDossier($dossier; $cheminFTP)
This.trace.EnvoyerMessages([msgk_event; msgk_log; msgk_notif]; "ALV - Maintenance serveur Web"; Current method name; String($dossier.files().length)+" blasons transférés dans "+$cheminFTP)
⇧
[ ]SF_ParamètresWeb - 23/04/2025 11:46:10
cs._SF_ParametresWeb.me.TraiterFORMevent()
⇧
[ ]SF_ParamètresWeb - objet grpDyn_LancerServeur - 03/04/2025 12:32:49
var $varName : Text
Case of
: (Form event code=On Clicked)
If (WEB Server(Web server database).isRunning)
cs.$serveur.new().Arreter()
Else
cs.$serveur.new().Demarrer()
End if
End case
If ((Form event code=On Load) | (Form event code=On Clicked))
$varName:=OBJECT Get name(Object current)
OBJECT SET TITLE(*; $varName; Choose(WEB Server(Web server database).isRunning; Localized string("3102"); Localized string("3101")))
End if
⇧
[ ]SF_ExporterSiteWeb - 23/04/2025 11:59:03
cs._SF_ExporterSiteWeb.me.TraiterFORMevent()
⇧
onStartup - 04/11/2025 14:15:57
// ne s'exécute pas dans une base hôte
ON ERR CALL(Formula(traceHandler).source; ek global)
// pour les tests hors base hôte
cs.$composant.new().InitVariablesWEB()
CALL WORKER("WK_Composant_WEB"; Formula(initProcess).source)
// installer le dossier racine Webserveur
cs.$composant.new().InstallerServeur()
⇧
onServerStartup - 08/05/2025 15:55:32
Pas de code
⇧
onExit - 01/04/2025 20:09:14
// ne s'exécute pas dans une base hôte
// exporter le code du composant si pas compilé
ON ERR CALL(Formula(traceHandler).source; ek local)
cs.xSDK.ExportCode4D.new().DémarrerComposant()
⇧
onWebConnection - 28/02/2025 10:01:06
#DECLARE($url : Text; $entete : Text; $IPnavigateur : Text; $IPserveur : Text; $LogIn : Text; $motDePasse : Text)
cs.$serveur.new().surConnexionWeb($url; $entete; $IPnavigateur; $IPserveur; $LogIn; $motDePasse)
⇧
onWebAuthentication - 21/11/2024 10:16:13
#DECLARE($url : Text; $entete : Text; $IPnavigateur : Text; $IPserveur : Text; $LogIn : Text; $motDePasse : Text)->$result : Boolean
$result:=cs.$serveur.new().surAuthentificationWeb($url; $entete; $IPnavigateur; $IPserveur; $LogIn; $motDePasse)
⇧
onWebSessionSuspend - 25/08/2023 15:19:37
//Fermeture session Web
⇧
onSystemEvent - 29/03/2025 17:23:01
#DECLARE($sysEvent : Integer)
ErrorNum:=0
ON ERR CALL(Formula(traceHandler).source; ek local) // gestion des erreurs
Case of
: ($sysEvent=On application foreground move)
: ($sysEvent=On application background move)
End case
⇧
onHostDatabaseEvent - 04/11/2025 14:15:40
#DECLARE($numEvent : Integer)
Case of
: ($numEvent=On before host database startup)
// ici pas d'interaction avce les autres composants et la BDDmère
ON ERR CALL(Formula(ErrorHandler).source; ek local)
cs.$composant.new().InitVariablesWEB()
Use (Storage.System)
Storage.System.estExécutéDansHôte:=True
Storage.System.estExécutéDansAPP:=cs.xSDK.EnvironnementALV.new().estExecuteDansAPP()
End use
// déactiver les ASSERT si le composant est compilé (réactivable par les options d'appel du composant)
SET ASSERT ENABLED(Not(Is compiled mode))
CALL WORKER("WK_Composant_WEB"; Formula(initProcess).source)
: ($numEvent=On after host database startup)
// à faire ici tout est initialisé, en particulier le monde extérieur
ON ERR CALL(Formula(traceHandler).source; ek global)
cs.$composant.new().Installer()
: ($numEvent=On before host database exit)
// placer ici le code à exécuter avant le "Sur fermeture" de la base hôte
cs.$maintenance.new().Arrêter()
cs.$serveur.new().Arreter()
: ($numEvent=On after host database exit)
// placer ici le code à exécuter après le "Sur fermeture" de la base hôte
End case
⇧
onRESTAuthentication - 07/12/2021 18:01:35
Pas de code
⇧
onMobileAppAuthentication - 06/07/2023 14:46:25
Pas de code