⇧
Exécuter Function Coopérative - 10/03/2025 14:17:55
#DECLARE($classe : Object; $params : Object)->$nunProc : Integer
var $nomProcess; $nomTache : Text
var $data : Object
$nunProc:=0
Case of
: (Not(OB Is defined($params; "functionID")))
cs._Trace.me.Créer(-15068; Current method name; "'functionID' n'est pas défini dans $params").LeverException([msgk_event; msgk_log])
: (Value type($params.functionID)#Is text)
cs._Trace.me.Créer(-15068; Current method name; "'$params.functionID' n'est pas un texte").LeverException([msgk_event; msgk_log])
: (Not(OB Is defined($params; "numProcessAppelant")))
cs._Trace.me.Créer(-15068; Current method name; "'numProcessAppelant' n'est pas défini dans $params").LeverException([msgk_event; msgk_log])
: ($params.numProcessAppelant=-1)
$nomTache:=$params.nomTache
$nomProcess:="$ALV_process_"+$nomTache
If (OB Is defined($params; "nomProcess"))
$nomProcess:=$params.nomProcess
End if
// créer le nouveau process
$params.numProcessAppelant:=Current process
$nunProc:=New process(Current method name; 0; $nomProcess; $classe; $params; *)
Else
// c'est ok
cs._composant.new().InitProcess()
// construire la classe
$data:=$classe.new()
If ($data[$params.functionID]#Null)
// lancer le traitement demandé
$data[$params.functionID]($params)
// appeler un callBack
If (OB Is defined($params; "CallBack"))
$data:=$params
// ici on doit être thread-safe
//CALL WORKER("WK_Services"; Appeler Le Formulaire; $params.numProcessAppelant; OB Get($params; "CallBack"; Is text); $data)
End if
Else
cs._Trace.me.Créer(-15081; Current method name; "La classe "+$classe.name+" n'est pas de function "+$params.functionID).LeverException([msgk_event; msgk_log])
End if
$nunProc:=Current process
End case
⇧
InitProcess - 29/03/2025 17:14:17
Capable de process préemptif
ProcInProgressCmd:=""
AsynchroProgress:=0
ProcInProgressTime:=0
ON ERR CALL(Formula(traceHandler).source; ek local)
Use (Storage.Processes)
Storage.Processes[Current process name]:=New shared object("Commande"; "")
End use
⇧
Bac à sable ALB - 04/06/2026 10:44:26
Partagée entre composants et base hôte
var $commande; $i : Integer
var $fichier; $Xpath; $texte; $titre : Text
var $xml; $racineXML : Text
var $heure : Time
var $o; $oo; $ooP : Object
var $image; $pict : Picture
var $c : Collection
$o:=New object
$oo:=New object
InitProcess
$c:=New collection(0)
$c.push(6)
For each ($i; $c)
$commande:=$commande ?+ $i
End for each
//$oo:=$o.serveur.ListerLesDocuments($x; ->$c)
// MARK:00 Console
If ($commande ?? 0)
// afficher la console de l'application
var $params : Object
$params:=New object
$params.Commande:="Afficher"
$params.sourceLogs:=ALV Client APP
$params.wndTitre:="Logs application ALV"
cs.xSDK.ResourceALV.me.SetObjet(Est Ressource APP; "Ressources_Communes/nbrMaxLogs"; Is longint; $params; "nbrMaxLogs")
cs.xSDK.EvenementsALV.me.AfficherEditeur($params)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "WK libellé 1"; Current method name; "test ALB : WK description 1")
End if
// MARK:01 Photos
If ($commande ?? 1)
cs.$photos.new().MettreAjour()
End if
// MARK:02 Test traces
If ($commande ?? 2)
var $erreurSDK : cs.xSDK.Traces
$erreurSDK:=cs.xSDK.Traces.new().CréerErreur("SDK"; -15068; Current method name; "test erreur -15068")
$erreurSDK.ErrorLabel:=Localized string(String($erreur.Error))
$erreurSDK.LeverException([msgk_event; msgk_log])
Waiting(1)
var $erreur : cs._Trace
$erreur:=cs._Trace.new().Créer(0; Current method name; "")
$erreur.Error:=-16212
$erreur.ErrorDescription:="test erreur -16212"
$erreur.LeverException([msgk_event; msgk_log])
Waiting(1)
var $trace : cs._Trace
$trace:=cs._Trace.me
$trace.EnvoyerMessages([msgk_event; msgk_log]; "WK libellé 1"; Current method name; "singleton ALB : WK description 1")
$heure:=Create document(cs.xSDK.Traces.new().GetGarbageDossier().file("test").platformPath)
$trace.Créer(-16212; Current method name; "singleton ALB : test erreur -16212")
$trace.LeverException([msgk_event; msgk_log])
Waiting(1)
Use (Storage.Host)
Storage.Host.Session_Etat:=(Storage.Host.Session_Etat ?+ 6) ?+ 8
End use
$trace.DebugerMethode("Catalogue"; Current method name; "Mise à jour de l'album ")
End if
// MARK:03 Edit / Visu Album
If ($commande ?? 3)
// appel pour test local du composant
var $data : Object
$data:=New object
// créer les paramètres
$data.Informations:=New object
$data.params:=New object
$data.params.groupesFamiliaux:=New collection
$data.params.CheminDossierFTP:=cs._document.new().getDossierTravail().folder("ALB_FTP").platformPath
Case of
: (Macintosh control down)
// afficher la consultation
$data.Commande:="$albumsVisualisateur"
$data.Informations.Contexte:="_album_"
$data.params.userIDfamille:=-1006
Else
// afficher l'édition
$data.Commande:="$albumsEditeur"
$data.Informations.Contexte:="Albums"
$data.params.userIDfamille:=0
End case
cs.$albums.new().ModifierVisualisations($data)
End if
// MARK:04 requete
If ($commande ?? 4)
// test $pageXXX
$o:=Folder(fk home folder).folder("Sites/WebFolder/albums/18E07508C1294065966C1E7BB93374DD").file("Data_ALB.json")
$texte:=Document to text($o.platformPath; "UTF-8"; Document with LF)
$oo:=JSON Parse($texte; Is object)
$ooP:=New shared object("Album"; New shared object)
//Utiliser ($ooP)
//$ooP.Album:=Créer objet partagé
//Fin utiliser
$oo:=JSON Parse($texte; Is object)
sharedObject($oo; $ooP.Album)
$oo:=cs.$pageWebREQUETE.new("/4DCGI/WebREQETE/LireMediaDate?MED_HoroDate?0")
$texte:=$oo.LireMediaDate()
End if
// MARK:05
If ($commande ?? 5)
$titre:="005_modif"
$fichier:="/Users/philippe/Documents/"+$titre+".jpg"
$o:=File($fichier)
READ PICTURE FILE($o.platformPath; $image)
$racineXML:=DOM Create XML Ref("metaData")
GET PICTURE METADATA($image; ""; $racineXML)
//DOM EXPORTER VERS VARIABLE($racineXML;$texte)
DOM EXPORT TO FILE($racineXML; System folder(Documents folder)+$titre+"_XML.xml")
DOM GET XML ELEMENT NAME($RacineXML; $Xpath)
$xml:=DOM Find XML element($racineXML; $Xpath+"/TIFF")
DOM GET XML ATTRIBUTE BY NAME($xml; "ImageDescription"; $texte)
DOM SET XML ATTRIBUTE($xml; "ImageDescription"; $texte+" modif")
DOM REMOVE XML ATTRIBUTE($xml; "XResolution")
DOM REMOVE XML ATTRIBUTE($xml; "YResolution")
DOM EXPORT TO FILE($xml; System folder(Documents folder)+$titre+"_$xml_XML.xml")
SET PICTURE METADATA($image; IPTC caption abstract; "toto")
DOM CLOSE XML($racineXML)
$fichier:="/Users/philippe/Documents/"+$titre+"_modif.jpg"
$o:=File($fichier)
WRITE PICTURE FILE($o.platformPath; $image)
READ PICTURE FILE($o.platformPath; $pict)
$racineXML:=DOM Create XML Ref("metaData")
GET PICTURE METADATA($pict; ""; $racineXML)
DOM EXPORT TO FILE($racineXML; System folder(Documents folder)+$titre+"_modif_XML.xml")
DOM CLOSE XML($racineXML)
//DOM EXPORTER VERS VARIABLE($racineXML;$texte)
//$oo:=Créer objet("propriété";EXIF date time digitized;"valeur";Chaîne(Date du jour;ISO date GMT;Heure courante))
//FIXER MÉTADONNÉES IMAGE($image;$oo.propriété;$oo.valeur)
//$fichier:="/Users/philippe/Documents/004_modif.jpg"
//$o:=Fichier($fichier)
//ÉCRIRE FICHIER IMAGE($o.platformPath;$image;"JPEG")
End if
// MARK:06 maintenance
If ($commande ?? 6)
// lancer la mise à jour des albums
cs._composant.new().InitVariablesALB()
cs._maintenance.new().Démarrer()
End if
// MARK:31 traduction
If ($commande ?? 31)
cs._composant.new().ModifierTraduction()
End if
⇧
Avancement Process - 18/11/2024 17:44:44
#DECLARE($numProc : Integer; $ProcInProgressStartTime : Integer; $ProcInProgressDuration : Integer; $numProgress : Integer)
// calcule l'avancement (variable process "ProcInProgressTime") de la tâche réalisée par le process "$1"
// dont le début est $2 et la durée est $3 (hypothèse : la tâche entretient son avancement entre 0 et 10000)
// met jour les variables process courant de l'état de l'avancement du process "$1"
// met a jour l'état d'un PROGRESS, si un ID existe
var $ProcInProgressTime : Integer
Case of
: ($numProc>0)
// surveiller le process $1
If (Count parameters=3)
$numProgress:=0
End if
While (Process state($numProc)#Aborted)
// espionner le process $numProc
GET PROCESS VARIABLE($numProc; ProcInProgressEtat; ProcInProgressEtat; ProcInProgressTime; $ProcInProgressTime; ProcInProgressState; ProcInProgressState)
// mettre à jour l'avancement du thermomètre
ProcInProgressTime:=$ProcInProgressStartTime+($ProcInProgressDuration*$ProcInProgressTime/10000) // normalisation (/10000) * durée de la tâche
// objet PROGRESS
If ($numProgress>0)
// mettre à jour le libellé de l'état d'avancement
Progress SET PROGRESS($numProgress; ProcInProgressTime/10000; ProcInProgressEtat; False)
// tuer le process à la demande de l'utilisateur
Case of
// il n'y a peut-être pas de btn
: (Not(Progress Get Button Enabled($numProgress)))
// action?
: (Not(Progress Stopped($numProgress)))
Else
// purger le process
SET PROCESS VARIABLE($numProc; ProcInProgressCmd; "Tuer process")
End case
End if
Waiting(10)
End while
End case
⇧
Exécuter Function Préemptive - 04/06/2026 10:34:00
Capable de process préemptif
#DECLARE($classe : Object; $params : Object)->$nunProc : Integer
var $nomTache : Text
var $data : Object
var $trace : cs._Trace
$trace:=cs._Trace.me
$nunProc:=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 la tâche existante
cs.xSDK.RegistreTaches.me.Tuer($nomTache)
// créer le nouveau process
$params.numProcessAppelant:=Current process
$nunProc:=New process(Current method name; 0; "$ALB_process_"+$nomTache; $classe; $params; *)
Else
// c'est ok
cs._composant.new().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ême 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
$nunProc:=Current process
End case
⇧
traceHandler - 23/12/2024 17:59:05
Capable de process préemptif
cs._Trace.me.Intercepter()
⇧
COMPILER_WEB - 23/11/2024 10:55:28
// initialiser les variables process gérés par cs._composant.InitHTTPvars()
// *** session
var vs4D; wwwRacineRessources; wwwEtatNavigation; wwwURLalbum; wwwIndexMedia; wwwTitre; wwwComment : Text
var wwwNbrMedias : Integer
vs4D:=""
wwwRacineRessources:="../../"
wwwEtatNavigation:=""
wwwURLalbum:=""
wwwIndexMedia:=""
wwwNbrMedias:=0
wwwTitre:=""
wwwComment:=""
var wwwEtatNavigationALB : Text
⇧
ALB_EcrireElementHTML - 22/01/2025 11:50:00
Partagée entre composants et base hôte
Disponible via les balises HTML et les URLs 4D (4DACTION...)
Capable de process préemptif
// traiter une requete de worker
#DECLARE($url : Text)->$retour : Text
var $serveurWeb : cs.$serveurWeb
var $result : Object
$serveurWeb:=cs.$serveurWeb.new()
$result:=$serveurWeb.TraiterURL($url)
// renvoyer le resultat
$retour:=$result.resultat
⇧
COMPILER - 26/02/2025 10:27:37
//••••• Général •••••
var ProcInProgressTime; ProcInProgressState : Integer
var ProcInProgressCmd; ProcInProgressEtat : Text
var AsynchroProgress : Integer
var ErrorNum : Integer
⇧
[class]_albums - 19/02/2026 19:10:24
property FTP : cs._FTP
property params; Album; mediaInformation; requête : Object
property listeAlbums; pathsAlbums; nomsAlbums : Collection
property indexAlbum : Integer
property indexMedia : Integer
// données standard pour tout formulaire
property grandEcran : Boolean:=False
property mémoTaille : Boolean:=True
Class extends _composant
Class constructor()
Super()
This.params:=New object // peut servir
// données d'album
This.listeAlbums:=Null
This.pathsAlbums:=Null
This.Album:=New object
// données de medias
This.mediaInformation:=New object
// données de requete
This.requête:=New object
// FTP
This.FTP:=cs._FTP.new()
// ----------------------
// MARK:Sélection
// -----------------------
Function ListerAlbums()->$result : cs._Trace
// lire sur le serveur la liste des albums
var $data : Object
$result:=cs._Trace.me.Initialiser(Current method name)
// pour gérer la connexion FTP
$data:=This.requête
// le dossier est créé dans le process appelant
This.CréerDossierDeTravail("ALBs_FTP")
$data.dossierTravail:=This.dossierTravail
// lister les albums
// on ne veut que les dossiers de la racine
$data.Options:=0x0002
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
Case of
: (Not(This.FTP.ListerLesDocuments($data).success))
$result.Error:=-16217
$result.ErrorDescription:="FTP : connexion impossible à "+This.FTP.serveur.params.hébergement
: (Not(OB Is defined($data; "listeDocuments")))
$result.Error:=-15068
$result.ErrorDescription:="propriété 'listeDocuments' non définie"
: ($data.listeDocuments.length=0)
$result.Error:=-16209
$result.ErrorDescription:="FTP : pas d'albums trouvés à "+This.FTP.racineFTP
Else
// c'est ok
This.FiltrerSurFamille($data)
// s'approprier la liste des albums
This.listeAlbums:=$data.listeDocuments
This.pathsAlbums:=$data.pathsDocuments
This.nomsAlbums:=$data.nomsDocuments
End case
Function FiltrerSurFamille($data : Object)
var $result : cs._Trace
var $path : Text
var $c1; $c2; $c3 : Collection
// remarque: le IDfamille existe, sinon on ne serait pas là
$c1:=New collection
$c2:=New collection
$c3:=New collection
For each ($path; $data.pathsDocuments)
$result:=This.getDonnéesAlbum($path)
Case of
: ($result.Error#0)
// nouvel album
$c1.push($data.listeDocuments[$data.pathsDocuments.indexOf($path)])
$c2.push($path)
$c3.push(Localized string("1"))
: ($result.Album=Null)
// les droits sont un objet avec NomGroupe, IDgroupe (familial) et Droits (vrai si la famille y a accès)
: (($result.Album.Acces_Droits.query("IDgroupe = :1"; This.params.params.userIDfamille).length=0) & (Storage.System.estExecuteDansHote) & (This.environnement.typeApplication()#ALV BDD mère))
Else
// le user a accès à cet album
$c1.push($data.listeDocuments[$data.pathsDocuments.indexOf($path)])
$c2.push($path)
$c3.push($result.Album.Nom)
End case
End for each
$data.listeDocuments:=$c1.copy()
$data.pathsDocuments:=$c2.copy()
$data.nomsDocuments:=$c3.copy()
Function getDonnéesAlbum($path : Text)->$result : cs._Trace
// lire le fichier xml des données de l'album
var $data : Object
var $dataTexte : Text
$result:=cs._Trace.me.Initialiser(Current method name)
// nouveau dossier de travail
This.requête.dossierTravail.create()
// contexte
$data:=This.requête
// demander le fichier à l'hébergeur, créer la requête :
$data.pathFichier:=$path+"Data_ALB.json" // ne pas détruire .cheminDossier
$data.cheminFichier:=$data.dossierTravail.platformPath+"Data_ALB.json"
$result:=This.FTP.TéléchargerFichier($data)
// plusieurs cas gérés
If ($result.success)
// c'est bon
$dataTexte:=Document to text($result.fichier.platformPath; "UTF-8"; Document with LF)
$result.Album:=JSON Parse($dataTexte; Is object)
Else
$result.Album:=Null
End if
Function OuvrirAlbum()->$result : cs._Trace
// lire les informations de l'album courant
var $path; $nom : Text
$result:=cs._Trace.me.Initialiser(Current method name)
// chemin FTP de l'album courant
$path:=This.pathsAlbums[This.indexAlbum]
$result:=This.getDonnéesAlbum($path)
// plusieurs cas gérés
Case of
: (This.pathsAlbums=Null)
: ($result.Error=0)
// c'est bon
This.Album:=$result.Album
: (This.ImporterDonnées($path).Error=0)
// ok (en particulier import des anciennes structures)
// This.Album est renseigné
This.Album.pathDossier:=$path
Else
// ici on a un nouvel album, initialiser ses données
This.Album:=New object
This.Album.Identification_ID:=Generate UUID
This.Album.Acces_Droits:=New collection
This.Album.Medias:=New collection
This.Album.pathDossier:=$path
// fixer son ID_nom
$nom:=Split string($path; "/"; sk ignore empty strings)[1]
This.Album.Identification_Nom:=$nom
This.Album.Nom:=Localized string("1")
// créer le dossier des media
$result.Error:=This.FTP.serveur.CréerRépertoire(This.document.getAlbumMediasURL($path)).Error
End case
// les erreurs sont traitées au dessus
$result.LeverException([msgk_event; msgk_log])
Function ImporterDonnées($path : Text)->$result : cs._Trace
// lire les données disponibles au chemin $1
var $fichier : 4D.File
var $data : Object
var $structureDeDonnées; $varName; $dataTexte : Text
var $i : Integer
var $c : Collection
var $valid : Boolean
var $xml : cs.xSDK.XML
$xml:=cs.xSDK.XML.me
$data:=This.requête
$data.pathFichier:=$path+"Informations.xml" // ne pas détruire .cheminDossier
$data.cheminFichier:=$data.dossierTravail.platformPath+"Informations.xml"
$result:=This.FTP.TéléchargerFichier($data)
This.Album:=New object
If ($result.Error=0)
// c'est ok, importer les données
$fichier:=$result.fichier
// Lire et éditer les infos de l'album
$structureDeDonnées:=""
$result:=$xml.LireFichier($fichier; ->$structureDeDonnées)
// renseigner les objets du formulaire dont le nom = "xml " & xPath de $path
ARRAY TEXT($Objets; 0)
ARRAY POINTER($Variables; 0)
FORM GET OBJECTS($Objets; $Variables; *)
For ($i; 1; Size of array($Objets))
Case of
: ($Objets{$i}="ALB_@")
$varName:=Replace string($Objets{$i}; "ALB_"; "")
//xPath XML
$path:=Replace string($varName; "_"; "/")
$dataTexte:="" // re-init !
$xml.LireLeChemin(->$structureDeDonnées; $path; ->$dataTexte)
This.Album[$varName]:=$dataTexte
End case
End for
ARRAY LONGINT($IDfamille; 0)
// lire les droits : c'est un tableau d'ID familiaux ayant droit sur cet album
$xml.LireLeChemin(->$structureDeDonnées; "Acces/Droits"; ->$IDfamille)
$c:=New collection
ARRAY TO COLLECTION($c; $IDfamille)
// récupérer dans la BDD la liste des ID de groupes familiaux
ARRAY TEXT($Noms; 0)
ARRAY LONGINT($IDs; 0)
// lire les groupes familiaux
If (Storage.System.estExecuteDansHote)
Begin SQL
SELECT Nom, IDfamille FROM wwwGroupes INTO :$Noms, :$IDs;
End SQL
End if
This.Album.Acces_Droits:=New collection
For ($i; 1; Size of array($Noms))
$valid:=($c.indexOf($IDs{$i})>-1)
This.Album.Acces_Droits.push(New object("Droits"; $valid; "NomGroupe"; $Noms{$i}; "IDgroupe"; $IDs{$i}))
End for
// initialiser le catalogue de medias
This.Album.Medias:=New collection
End if
Function TrierMedias()
// trier les medias de l'album par date d'origine
This.Album.Medias:=This.Album.Medias.orderBy("MED_HoroDate")
Function FermerAlbum()
// enregistrer les données de l'album
var $data; $fichier : Object
var $dataTexte; $path : Text
var $result : cs._Trace
$result:=cs._Trace.me.Créer(-15068; Current method name; "Err params")
$data:=This.requête
Case of
// possible (au chargement en particulier)
: (This.Album=Null)
: (Not(OB Is defined(This.Album; "pathDossier")))
: (This.Album.pathDossier="")
Else
// enregistrer les données album en local
$fichier:=$data.dossierTravail.file("Data_ALB.json")
$dataTexte:=JSON Stringify(This.Album)
TEXT TO DOCUMENT($fichier.platformPath; $dataTexte; "UTF-8"; Document with LF)
// mettre à jour sur l'hébergeur
$path:=This.Album.pathDossier+"Data_ALB.json"
$result.Error:=This.FTP.serveur.EnvoyerFichier($fichier.platformPath; $path).Error
End case
$result.LeverException([msgk_event; msgk_log])
⇧
[class]$albumsEditeur - 04/06/2026 10:56:21
property saisie : Object
property fichier : 4D.File
property catalogueMedias : Collection
property saisieEnCours; modifié : Boolean
property ProcInProgressNum : Integer:=0
property avancement : Integer:=0
property rangMedia : Integer:=0
property listeMedias : Integer:=0
Class extends _albums
Class constructor()
Super()
This.saisie:=New object
This.listeMedias:=0
// ----------------------
//Mark:Sélection
// -----------------------
Function ListerAlbums()
// alimenter le sélecteur d'albums
// collectionner les albums
Super.ListerAlbums()
// créer la collection des albums avec cette collection
Form.selecteur.values:=This.nomsAlbums
Function FixerNavigationClavier()
If (This.saisieEnCours)
// invalider la navigation fléchée
OBJECT SET SHORTCUT(*; "grpBtnNav@"; "")
Else
// retablir la navigation fléchée
OBJECT SET SHORTCUT(*; "grpBtnNavPreviousRecord"; Shortcut with Left arrow)
OBJECT SET SHORTCUT(*; "grpBtnNavNextRecord"; Shortcut with Right arrow)
End if
Function MajGroupesFamiliaux()
// vérifier la complétude de la liste les groupes familiaux
var $groupe : Object
Case of
: (This.params.params.groupesFamiliaux.length=0)
Else
For each ($groupe; This.params.params.groupesFamiliaux)
If (This.Album.Acces_Droits.query("NomGroupe = :1"; $groupe.Nom).length=0)
// nouveau groupe
This.Album.Acces_Droits.push(New object("Droits"; False; "NomGroupe"; $groupe.Nom; "IDgroupe"; $groupe.IDfamille))
End if
End for each
End case
// ----------------------
// MARK:Formulaire
// -----------------------
Function OuvrirAlbum()->$result : Object
// ouvrir l'album
Super.OuvrirAlbum()
// récupérer les groupes familiaux
This.MajGroupesFamiliaux()
Form.modifié:=False
Function OuvrirFormulaire()
// méthode du process U_Nav Albums
var $wndNum : Integer
var $nomForm : Text
NO DEFAULT TABLE
// la fenêtre est ouverte en taille normale. Le user ne peut pas modifier la taille
$nomForm:="U_Nav Albums"
$wndNum:=Open form window($nomForm; -Palette form window; Horizontally centered; Vertically centered; *)
// initialiser la valeur
DIALOG($nomForm; This)
CLOSE WINDOW
CLEAR VARIABLE($wndNum)
Function InitFormulaire()
// lire / mettre à jour les medias
var $data : Object
Form.AsynchroProgress:=True
// fermer un précédent album
Case of
: (Form.indexAlbum=-1)
// pas d'album sélectionné
: (Form.ProcInProgressNum>0)
// un process en cours, attendre
Else
// mettre à jour le catalogue de l'album sélectionné (il y a peut-être de nouveaux media)
$data:=New object("params"; New object)
$data.params.Album:=Form.Album
$data.params.numFenetreAppelante:=Current form window
$data.params.function:="CallBack"
$data.params.dossierTravail:=Form.requête.dossierTravail
$data.params.commande:="Démarrer"
// construire l'appel au worker
$data.execute:=Formula(cs.$albumsEditeur.new().MettreAjourCatalogue(This.params))
// lancer le traitement
CALL WORKER("WK_Composant_ALB"; Formula($data.execute().source))
End case
Function FermerAlbum()->$result : Object
// enregistrer les données de l'album
var $fichier : Object
If (Form.modifié)
$result:=Super.FermerAlbum()
End if
// purger
$fichier:=This.requête.dossierTravail.file("Data_ALB.json")
CLEAR VARIABLE($fichier)
OB REMOVE(This.requête; "fichier")
// purger le dossier de travail
This.requête.dossierTravail.delete(Delete with contents)
// RAZ données de l'album courant
Form.Album:=New object
// RAZ récipient des données affichées de l'album courant
Form.saisie:=New object
// RAZ LH
Form.listeMedias:=New list
// ----------------------
// MARK:Import
// -----------------------
Function MettreAjourCatalogue($params : Object)
// passer en revue les medias et mettre à jour le catalogue si des ajouts / suppressions sont détectés
var $result; $data; $mediaInformation : Object
var $i; $width; $height : Integer
var $catalogueMedias; $c; $poubelle : Collection
var $image : Picture
// en principe s'exécute dans un process externe
ON ERR CALL(Formula(traceHandler).source; ek local)
// initialiser la classe
This.Album:=$params.Album
This.dossierTravail:=$params.dossierTravail
// lister les medias de l'album sélectionné
$data:=New object
$data.pathDossier:=This.document.getFTPalbumMediasPath(This.Album.Identification_Nom)
$data.Options:=0x0005
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
$data.listeInfos:=New collection
$result:=This.FTP.ListerLesDocuments($data)
$result:=cs._Trace.me.Initialiser(Current method name)
If ($data.pathsDocuments.length=0)
// ici on est mal !
$result.ErrorDescription:="L'album "+This.Album.Identification_Nom+" est vide"
Else
// tout est ok pour créer / mettre à jour le catalogue
$catalogueMedias:=This.Album.Medias
This.modifié:=False
For ($i; 1; $data.pathsDocuments.length)
// état du media
$c:=$catalogueMedias.query("MED_IDunique = :1"; File($data.listeDocuments[$i-1]; fk platform path).name)
Case of
: ($c.length=0)
// les données du media ne sont pas connues, ajouter au catalogue
// récupérer les chemins d'origine du fichier et de son dossier
This.fichier:=File($data.pathsDocuments[$i-1])
$data.pathDossier:=This.fichier.parent.path
// télécharger le fichier
$data.pathFichier:=$data.pathsDocuments[$i-1]
$data.cheminFichier:=This.dossierTravail.platformPath+$data.listeDocuments[$i-1]
$result:=This.FTP.serveur.RecevoirFichier($data.pathFichier; $data.cheminFichier)
// récupérer le fichier téléchargé
This.fichier:=File($data.cheminFichier; fk platform path)
// récupérer les infos et metadata du fichier
This.mediaInformation:=New object
// path du fichier sur l'hébergeur
This.mediaInformation.nomFichier:=This.fichier.fullName
This.mediaInformation.pathFichier:=$data.pathsDocuments[$i-1]
This.mediaInformation.taille:=$data.listeInfos[$i-1].taille
// horodatage du fichier
This.mediaInformation.dateModification:=$data.listeInfos[$i-1].date
This.mediaInformation.heureModification:=$data.listeInfos[$i-1].heure
// metadata du fichier
$result:=This.ImporterMétaDonnéesImage()
If ($result.success)
// on a reconnu un media
// deux cas : un nouveau media, ou un media existant qui a été modifié
If ($catalogueMedias.query("MED_IDunique = :1"; This.mediaInformation.MED_IDunique).length=0)
// un nouveau media, l'ajouter au catalogue
$catalogueMedias.push(This.mediaInformation)
End if
// si on est ici, c'est que le fichier a été ajouté ou modifié
$data.fichier:=This.fichier
// This.fichier est en local, mettre à jour le fichier dans l'album
// consiste à supprimer l'ancien fichier sur l'hébergeur, puis téléverser le fichier local (baptisé UUID)
$result:=This.FTP.serveur.SupprimerFichier($data.pathFichier)
$data.pathFichier:=$data.pathDossier+This.fichier.fullName
$result:=This.FTP.serveur.EnvoyerFichier(This.fichier.platformPath; $data.pathFichier)
// mettre à jour le chemin du media
This.mediaInformation.nomFichier:=This.fichier.fullName
This.mediaInformation.pathFichier:=$data.pathFichier
$data.pathsDocuments[$i-1]:=$data.pathFichier
End if
This.modifié:=True
// voir si le media a changé de dossier
: ($data.pathsDocuments[$i-1]#$c[0].pathFichier)
This.mediaInformation:=$c[0]
This.mediaInformation.pathFichier:=$data.pathsDocuments[$i-1]
// voir si le media a été modifié
: (($data.listeInfos[$i-1].date=$c[0].dateModification) & ($data.listeInfos[$i-1].taille=$c[0].taille) & ($data.listeInfos[$i-1].heure=$c[0].heureModification))
// rappel : ici les heures sont des entierLong
Else
// télécharger le fichier
$data.commande:="TéléchargerFichier"
$data.pathFichier:=$data.pathsDocuments[$i-1]
$data.cheminFichier:=This.dossierTravail.platformPath+$data.listeDocuments[$i-1]
$result:=This.FTP.serveur.RecevoirFichier($data.pathFichier; $data.cheminFichier)
This.fichier:=File($data.cheminFichier; fk platform path)
// mettre à jour les infos
This.mediaInformation:=$c[0]
// nom du fichier (l'extension a peut-être changé)
This.mediaInformation.nomFichier:=This.fichier.fullName
This.mediaInformation.pathFichier:=$data.pathsDocuments[$i-1]
// horodatage du fichier
This.mediaInformation.dateModification:=$data.listeInfos[$i-1].date
This.mediaInformation.heureModification:=$data.listeInfos[$i-1].heure
// image
This.mediaInformation.taille:=$data.listeInfos[$i-1].taille
READ PICTURE FILE(This.fichier.platformPath; $image)
If (Picture size($image)>0)
// écrire la largeur / hauteur de l'image
PICTURE PROPERTIES($image; $width; $height)
OB SET(This.mediaInformation; "MED_DimensionX"; $width)
OB SET(This.mediaInformation; "MED_DimensionY"; $height)
End if
This.modifié:=True
End case
ProcInProgressEtat:=$data.pathsDocuments[$i-1]
ProcInProgressTime:=$i/$data.pathsDocuments.length*10000
//If (This.tache.Tuer.signaled)
//$i:=1+$data.pathsDocuments.length
//End if
End for
// y a t-il des articles du catalogue qui ne sont plus des fichiers?
$poubelle:=New collection
$c:=$data.pathsDocuments
For each ($mediaInformation; $catalogueMedias)
If ($c.indexOf($mediaInformation.pathFichier)=-1)
$poubelle.push($catalogueMedias.indexOf($mediaInformation))
End if
End for each
// supprimer les $mediaInformation non retrouvés
If ($poubelle.length>0)
For ($i; $poubelle.length; 1; -1)
$catalogueMedias.remove($poubelle[$i-1])
End for
This.modifié:=True
End if
ProcInProgressEtat:=""
ProcInProgressTime:=10000
Waiting(30)
// trier par date d'origine
This.catalogueMedias:=$catalogueMedias.orderBy("MED_HoroDate")
End if
// ici on a un catalogueMedias
$params.catalogueMedias:=This.catalogueMedias
$params.modifié:=This.modifié
// renvoyer le resultat
Case of
: (Not(OB Is defined($params; "numFenetreAppelante")))
Else
// envoyer pour la suite
$data:=New object
$data.params:=OB Copy($params)
// il n'y a que le texte qui semble passer dans les .params
// construire l'appel au requêteur
$data.execute:=Formula(cs.$albumsEditeur.new()["CallBack"](This.params))
CALL FORM($params.numFenetreAppelante; Formula($data.execute().source))
End case
Function ImporterMétaDonnéesImage()->$result : cs._Trace
// autopsier les infos de l'image, et compléter This.mediaInformation
var $image : Picture
var $texte; $dateSaisie; $titreSaisi; $commentaireSaisi; $racineXML; $ElementXML; $attribut; $valeur : Text
var $width; $height; $nbAttributs; $i : Integer
var $GPS : Object
$result:=cs._Trace.me.Initialiser(Current method name)
READ PICTURE FILE(This.fichier.platformPath; $image)
If (Picture size($image)>0)
// initialiser les données (au cas où elles manqueraient)
$dateSaisie:=""
$commentaireSaisi:=""
// écrire la largeur / hauteur de l'image
PICTURE PROPERTIES($image; $width; $height)
OB SET(This.mediaInformation; "MED_DimensionX"; $width)
OB SET(This.mediaInformation; "MED_DimensionY"; $height)
//v8.1.17 après modification la date est dans 'IEXIF user comment'
GET PICTURE METADATA($image; EXIF user comment; $dateSaisie)
If (($dateSaisie="") | (Date($dateSaisie)=!00-00-00!))
// lire un horodatage disponible de création de l'image
GET PICTURE METADATA($image; EXIF date time original; $dateSaisie)
If (($dateSaisie="") | (Date($dateSaisie)=!00-00-00!))
GET PICTURE METADATA($image; EXIF date time digitized; $dateSaisie)
If (($dateSaisie="") | (Date($dateSaisie)=!00-00-00!))
GET PICTURE METADATA($image; IPTC digital creation date time; $dateSaisie)
If (($dateSaisie="") | (Date($dateSaisie)=!00-00-00!))
GET PICTURE METADATA($image; IPTC date time created; $dateSaisie)
If (($dateSaisie="") | (Date($dateSaisie)=!00-00-00!))
// on prend les données fichier
$dateSaisie:=String(This.fichier.modificationDate; ISO date GMT; This.fichier.modificationTime)
End if
End if
End if
End if
End if
// écrire l'horodatage de création de l'image
OB SET(This.mediaInformation; "MED_HoroDate"; $dateSaisie)
// l'UUID du fichier peut ne pas exister (metadata non initialisées)
GET PICTURE METADATA($image; EXIF image unique ID; $texte)
Case of
: (Match regex("[0-9ABCDEF]{32}"; $texte))
// media déjà initialisé
GET PICTURE METADATA($image; TIFF document name; $titreSaisi)
Else
// le titre de l'image est le nom d'origine du fichier
$titreSaisi:=This.fichier.fullName
$texte:=Generate UUID
// mémoriser dans l'image : le nom original du fichier, l'initialisation du titre et du UUID,
SET PICTURE METADATA($image; EXIF image unique ID; $texte)
WRITE PICTURE FILE(This.fichier.platformPath; $image)
End case
// renommer le fichier
This.fichier:=This.fichier.rename($texte+This.fichier.extension)
//mettre le nouveau nom
OB SET(This.mediaInformation; "nomFichier"; This.fichier.fullName)
// finalement
OB SET(This.mediaInformation; "MED_IDunique"; $texte)
OB SET(This.mediaInformation; "MED_Nom"; $titreSaisi)
// lire le nom d'origine
OB SET(This.mediaInformation; "MED_NomOrigine"; $titreSaisi)
// lire le commentaire de l'image
GET PICTURE METADATA($image; IPTC caption abstract; $commentaireSaisi)
OB SET(This.mediaInformation; "MED_Commentaire"; $commentaireSaisi)
// lire les meta données GPS
$racineXML:=DOM Create XML Ref("Root")
$ElementXML:=DOM Create XML element($racineXML; "/Root/GPS")
GET PICTURE METADATA($image; "GPS"; $ElementXML)
$nbAttributs:=DOM Count XML attributes($ElementXML)
$GPS:=New object
For ($i; 1; $nbAttributs)
DOM GET XML ATTRIBUTE BY INDEX($ElementXML; $i; $attribut; $valeur)
$GPS[$attribut]:=$valeur
End for
DOM CLOSE XML($racineXML)
OB SET(This.mediaInformation; "GPS"; $GPS)
Else
$result.Error:=-15068
$result.ErrorDescription:="image non disponible, "+This.fichier.platformPath+" non reconnu"
// $2 est vide
End if
$result.FixerSuccess()
// les erreurs sont traitées au dessus
$result.LeverException([msgk_event; msgk_log])
Function CallBack($data : Object)
// le catalogue de l'album sélectionné a été créé dans $1, on continue
// mémoriser dans Form la liste (chronologique) des medias
Form.Album.Medias:=$data.catalogueMedias
Form.modifié:=$data.modifié
This.ListerMedias()
Function ListerMedias()
var $metaData : Object
var $i : Integer
This.Album.Medias:=Form.Album.Medias.orderBy("MED_HoroDate")
// créer la LH des medias
Form.listeMedias:=New list
For ($i; 1; Form.Album.Medias.length)
$metaData:=Form.Album.Medias[$i-1]
// itemref est la position dans le LH (cad index+1 du media dans le catalogue de medias)
APPEND TO LIST(Form.listeMedias; $metaData["MED_Nom"]; $i)
SET LIST ITEM PARAMETER(Form.listeMedias; 0; "UUID"; $metaData["MED_IDunique"])
SET LIST ITEM PROPERTIES(Form.listeMedias; 0; False; Italic; 0; -1)
SET LIST ITEM PARAMETER(Form.listeMedias; 0; Additional text; $metaData["MED_NomOrigine"])
End for
SET LIST PROPERTIES(Form.listeMedias; 0; 0; 17)
Form.AsynchroProgress:=False
// afficher la première photo
Form.rangMedia:=1
This.AfficherMedia()
// ----------------------
// MARK:Saisie
// -----------------------
Function AfficherMedia()
// afficher les données du media rangMedia dans les champs EXIF_
var $mediaInformation; $data; $result : Object
var $image : Picture
var $dataTexte : Text
$data:=Form.requête
Form.saisie.photo:=0
Form.IndexCatalogue:=""
// données affichées saisissables
Form.saisie.Date:=!00-00-00!
Form.saisie.Heure:=?00:00:00?
Form.saisie.MED_Nom:=""
Form.saisie.MED_Commentaire:=""
Case of
: (Not(OB Is defined(Form.Album; "Medias")))
: (Form.Album.Medias.length=0)
Else
// sélectionner le média (nécessaire quand on navigue par les flèches)
SELECT LIST ITEMS BY POSITION(Form.listeMedias; Form.rangMedia)
Form.IndexCatalogue:=String(Form.rangMedia)+" / "+String(Form.Album.Medias.length)
// récupérer les infos dans le catalogue
$mediaInformation:=Form.Album.Medias[Form.rangMedia-1]
// fixer pathFichier (affiché dans le formulaire, non saisissable)
Form.pathFichier:=$mediaInformation.pathFichier
// afficher la photo
$data.pathFichier:=$mediaInformation.pathFichier
$data.nomFichier:=$mediaInformation.nomFichier
$result:=This.FTP.TéléchargerFichierMedia($data)
If ($result.success)
READ PICTURE FILE($result.fichier.platformPath; $image)
Form.saisie.photo:=$image
End if
// afficher les infos MED, saisissables
$dataTexte:=$mediaInformation["MED_HoroDate"]
Form.saisie.Date:=Date($dataTexte)
Form.saisie.Heure:=Time($dataTexte)
Form.saisie.MED_Nom:=$mediaInformation["MED_Nom"]
Form.saisie.MED_Commentaire:=$mediaInformation["MED_Commentaire"]
End case
Function ModifierDonnée()
var $varName; $dataTexte : Text
var $mediaInformation : Object
// retrouver le nom de l'objet modifié
$varName:=OBJECT Get name(Object with focus)
Case of
// filtrer les modifications d'album
: ($varName="Albums")
: ($varName="ALB_@")
// les modifications de données d'album sont faites directement dans l'objet Album
Form.modifié:=True
: (Not(OB Is defined(Form; "Album")))
// pas encore d'album disponible
: (Not(OB Is defined(Form.Album; "Medias")))
: (Form.Album.Medias.length=0)
// pas encore de medias disponibles
: (Form.rangMedia<1)
// rien d'initialisé
: (Form.rangMedia>Form.Album.Medias.length)
// pb
Else
// ici on a une modification d'un media
// récupérer les infos dans le catalogue
$mediaInformation:=Form.Album.Medias[Form.rangMedia-1]
Case of
: ($varName="selection")
// filtrer
: (($varName="Date") | ($varName="Heure"))
$dataTexte:=String(OB Get(Form.saisie; "Date"; Is date); ISO date GMT; OB Get(Form.saisie; "Heure"; Is time))
$mediaInformation.MED_HoroDate:=$dataTexte
Form.modifié:=True
Else
// cas génériques
$dataTexte:=OB Get(Form.saisie; $varName; Is text)
OB SET($mediaInformation; $varName; $dataTexte)
Form.modifié:=True
End case
// mettre à jour la LH
If ($varName="MED_Nom")
GET LIST ITEM(Form.listeMedias; *; $i; $dataTexte)
$dataTexte:=OB Get(Form.saisie; $varName; Is text)
SET LIST ITEM(Form.listeMedias; $i; $dataTexte; $i)
End if
End case
Function EditerRessourceComposant($path : Text)
// Lire / écrire une ressource application
// par principe la donnée est éditée dans un formulaire
// $1 = objet où lire / écrire, $2 = nom propriété de $1, $3 = chemin dans la ressource du composant {, $4 type valeur}
var $erreur : cs._Trace
var $nomObjet : Text
var $dataTexte : Text
$erreur:=cs._Trace.me.Initialiser(Current method name)
$nomObjet:=OBJECT Get name(Object current)
Case of
: (Not(This.rsc.SetVariable(Est Ressource ALB; $path; Is text; ->$dataTexte)))
$erreur.Error:=-15058
$erreur.ErrorDescription:=$path+" est une donnée inconnue"
: (Form event code=On Load)
Form[$nomObjet]:=$dataTexte
: (Form event code=On Data Change)
$dataTexte:=Form[$nomObjet]
$erreur.Error:=-16003*Num(Not(This.rsc.SetResourceALV(Est Ressource ALB; $path; ->$dataTexte)))
End case
$erreur.LeverException([msgk_event; msgk_log])
⇧
[class]_document - 27/02/2026 10:56:44
property environnement : cs.xSDK.EnvironnementALV
property rsc : cs.xSDK.ResourceALV
// fixer par les classes héritantes
property nomServeurWeb : Text
Class constructor
This.environnement:=cs.xSDK.EnvironnementALV.new()
This.rsc:=cs.xSDK.ResourceALV.me
Function getDataServeurFolder()->$result : Object
$result:=Storage.Host.$document.call(Null).getDataServeurFolder()
//------------------
//mark:Installation
//------------------
Function getDataFolder()->$result : 4D.Folder
// installation : dossier des albums pour le composant
Case of
: (Storage.System.typeApplication=ALV Serveur APP)
// cas opérationnel
$result:=This.getDataServeurFolder().folder("WEBalbums")
$result.create()
: (Storage.System.typeApplication=ALV Serveur HTTP)
// utilisation de 4D Server pour debug
$result:=cs.xSDK.Traces.new().GetGarbageDossier().folder("_ALBdebug").folder("WEBalbums")
$result.create()
: (Storage.System.typeApplication=ALV BDD mère)
// pour test local
$result:=cs.xSDK.Traces.new().GetGarbageDossier().folder("_ALBdebug").folder("WEBalbums")
$result.create()
Else
// rien
$result:=Null
End case
Function getRacineHTMLFolder($nomServeurWeb : Text)->$result : Object
// renvoyer le chemin du dossier racine du serveur $nomServeurWeb
var $c : Collection
$result:=Null
Case of
: (Application type=4D Remote mode)
// filtrer (pas concerné pour l'instant)
Else
$c:=WEB Server list.query("name = :1"; $nomServeurWeb)
Case of
: ($c.length#1)
: ($c[0].isRunning=False)
Else
$result:=Folder($c[0].rootFolder)
End case
End case
Function getInstallationMobileFolder()->$result : Object
var $serveur : Object
$result:=Null
$serveur:=WEB Server(Web server host database)
Case of
: (Application type=4D Remote mode)
: (Not(Storage.System.estExecuteDansHote))
// filtrer (pas concerné pour l'instant)
: (Not(This.environnement.estServeur()))
// pour les tests (BDDmère uniquement)
$result:=This.getDossierTravail().folder("ALB_debugMobile")
: ($serveur=Null)
// pas de serveur hôte
Else
// on se met dans le dossier racine du site Web hôte
$result:=Folder($serveur.rootFolder)
End case
Function getDossierTravail()->$result : Object
$result:=cs.xSDK.Traces.new().GetGarbageDossier().folder("tempo_ALB")
$result.create()
//------------------
//MARK:Hébergeur
//------------------
Function getAlbumMediasURL($IDnom : Text)->$result : Text
$result:=$IDnom+"Medias/"
Function getFTPalbumMediasPath($IDnom : Text)->$result : Text
$result:=This.getFTPalbumPath($IDnom)
$result+="Medias/"
Function getFTPalbumPath($IDnom : Text)->$result : Text
This.rsc.SetVariable(Est Ressource ALB; "chemins/FTP/Path"; Is text; ->$result)
$result+=$IDnom+"/"
//------------------
//MARK:Requete
//------------------
Function getWEBalbumsFolder_Courant()->$result : Object
var $nomDossier : Text
$result:=Null
Case of
: (Not(This.rsc.SetVariable(Est Ressource ALB; "chemins/albums/URL"; Is text; ->$nomDossier)))
Else
$result:=This.getRacineHTMLFolder_Courant().folder($nomDossier)
End case
Function getRacineHTMLFolder_Courant()->$result : Object
// renvoyer le chemin du dossier racine du serveur courant
// attention le composant peut être utilisé par 2 serveurs Web
var $serveur : 4D.WebServer
// trouver le serveur requeteur
$serveur:=WEB Server(Web server receiving request)
$result:=Null
Case of
: (Application type=4D Remote mode)
// filtrer (pas concerné pour l'instant)
: ($serveur=Null)
Else
// cas serveur APP ou BDD mère (pour test)
$result:=Folder($serveur.rootFolder)
End case
//------------------
//MARK:Site Web
//------------------
Function getWEBalbumMediasFolder($IDabum : Text)->$result : Object
$result:=This.getWEBalbumFolder($IDabum).folder("Medias")
$result.create()
Function getWEBalbumVignettesFolder($IDabum : Text)->$result : Object
$result:=This.getWEBalbumFolder($IDabum).folder("Vignettes")
$result.create()
Function getWEBalbumFolder($IDabum : Text)->$result : Object
$result:=This.getWEBalbumsFolder().folder($IDabum)
Function getWEBalbumsFolder()->$result : 4D.Folder
// les albums sont installés dans les données du serveur APP
var $nomDossier : Text
$result:=Null
Case of
: (Not(This.rsc.SetVariable(Est Ressource ALB; "chemins/albums/URL"; Is text; ->$nomDossier)))
Else
$result:=This.getDataFolder().folder($nomDossier)
$result.create() // au cas ou
End case
Function getWEBalbumMediasURL()->$result : Text
$result:=Session.storage.ALB_HTTPvars.wwwURLalbum+"Medias/"
Function getWEBalbumVignettesURL()->$result : Text
$result:=Session.storage.ALB_HTTPvars.wwwURLalbum+"Vignettes/"
⇧
[class]_composant - 18/02/2026 16:49:20
property environnement : cs.xSDK.EnvironnementALV
property document : cs._document
property fct : cs.xSDK.Outils
property rsc : cs.xSDK.ResourceALV
property dossierTravail : Object
Class constructor()
// environnement
This.environnement:=cs.xSDK.EnvironnementALV.new()
This.document:=cs._document.new()
This.fct:=cs.xSDK.Outils.me
This.rsc:=cs.xSDK.ResourceALV.me
This.dossierTravail:=Null
Function InitProcess()
ProcInProgressCmd:=""
AsynchroProgress:=0
ProcInProgressTime:=0
ON ERR CALL(Formula(traceHandler).source; ek local)
Use (Storage.Processes)
Storage.Processes[Current process name]:=New shared object("Commande"; "")
End use
//---------------------
// MARK:Installation
//---------------------
Function InitVariablesALB()
var $data : Object
Use (Storage)
Storage["System"]:=New shared object
Storage["Host"]:=New shared object
Storage["Processes"]:=New shared object
End use
Use (Storage.System)
Storage.System.estExecuteDansHote:=False
Storage.System.estExecuteDansAPP:=False
// tout le monde n'est pas initialisé ; on ne sait pas si on est serveur Web
Storage.System.estServeur:=False
Storage.System.AlertesHôte:=6 // gère les messages d'alerte
// obsolete
Storage.System.Session_Etat:=0 // équivalent des UserPrefs
Storage.System.Status:=0
$data:=cs.xSDK.EnvironnementALV.new()
Storage.System.typeApplication:=$data.typeApplication()
Storage.System.estServeur:=$data.estServeur()
Storage.System.estClient:=$data.estClient()
End use
Use (Storage.Host)
Storage.Host.Session_Etat:=0
End use
// partager des ressources
$data:=New object
// fichier de ressources
$data.chemin:=Get 4D folder(Current resources folder)+"DataALB.xml"
// accès au worker du composant
$data.nomWorker:="WK_Composant_ALB"
$data.méthodeWorker:="Installer Albums"
// mémoriser
cs.xSDK.ResourceALV.me.Inscrire(Est Ressource ALB; $data)
Function Installer()
Use (Storage.System)
Storage.System.estExecuteDansAPP:=This.environnement.estExecuteDansAPP()
End use
cs.xSDK.$composant.new().InstallerRessourcesAPP()
This.InstallerDonnéesHote()
This.IntegerDansHote()
// lancer la maintenance
cs._maintenance.new().Démarrer()
Function InstallerDonnéesHote()
// lire les données d'installation
var $attribut : Text
var $data : Object
Case of
: (Not(Storage.System.estExecuteDansHote))
// exécution du composant en local
: (Not(Storage.System.estExecuteDansAPP))
// exécution du composant dans un composant
Use (Storage)
Storage.Host:=New shared object
End use
: (Storage.System.typeApplication=ALV Client APP)
: (Storage.System.typeApplication=4D Remote mode)
// filtrer
Else
$data:=New object
// une erreur est générée si l'appel vient d'un composant en test
EXECUTE METHOD(Modifier la DataStore; $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
Function IntegerDansHote()
// BDDmère ou APP ou client
// intégrer le composant dans la base hôte, pour les interfaces :
If (Storage.System.estExecuteDansHote)
// dans cette version rien à faire
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; "Installer Albums"; "Intégration dans base hôte")
End if
//---------------------
// MARK:Travail
//---------------------
Function CréerDossierDeTravail($nomDossier : Text)
// créer le dossier de travail
This.dossierTravail:=This.document.getDossierTravail().folder($nomDossier)
This.dossierTravail.delete(Delete with contents)
This.dossierTravail.create()
Function SupprimerDossierDeTravail()
This.dossierTravail.delete(Delete with contents)
// ----------------------
// MARK:Modification
// ----------------------
Function ModifierTraduction()
// ouvrir l'éditeur des traductions
cs.xSDK.TraductionsEditeur.new().ModifierTraductions()
⇧
[class]_FTP - 22/02/2026 09:18:57
property fct : cs.xSDK.Outils
property rsc : cs.xSDK.ResourceALV
property serveur : cs.xSDK.ServicesFTP
property racineFTP : Text
Class constructor()
var $data : Object
This.fct:=cs.xSDK.Outils.me
This.rsc:=cs.xSDK.ResourceALV.me
// paramètres de connexion FTP
$data:=This.FixerParametresFTP()
This.racineFTP:=$data.racine
This.serveur:=cs.xSDK.ServicesFTP.new($data.params)
Function ListerLesDocuments($requête : Object)->$result : cs._Trace
var $path : Text
var $c : Collection
var $élément : Object
$result:=cs._Trace.me.Initialiser(Current method name)
// options :
// - bit 0 = les fichiers
// - bit 1 = les dossiers
// - bit 2 = chemin récursif
If (OB Is defined($requête; "pathDossier"))
// cas normal
$path:=$requête.pathDossier
Else
// le demandeur ne connait rien du contexte
$path:=This.racineFTP
End if
$c:=New collection
$result.Error:=This.serveur.ListerLesDocuments($path; ->$c).Error
If (OB Is defined($requête; "Options"))
// on renvoie le path absolu des fichiers dans .pathsDocuments, nom dans .listeDocuments, date, heure et taille dans .listeInfos
// Attention : les collections doivent avoir été créées à l'appel pour être reçues en retour
If (Not(OB Is defined($requête; "pathsDocuments")))
// pour que la suite fonctionne ! rappel : les collections créées ici ne sont pas reçues par l'appelant
$requête.pathsDocuments:=New collection
$requête.listeDocuments:=New collection
$requête.listeInfos:=New collection
End if
// ajouter les documents trouvés
// pas d'options
Case of
: ($c.length=0)
: ($requête.Options ?? 0)
// ajouter les fichiers à la collection
For each ($élément; $c)
Case of
: ($élément.nom=".@")
: ($élément.type#Is a document)
Else
// ajouter le chemin du fichier
$requête.pathsDocuments.push($path+$élément.nom)
// ajouter le nom du fichier
$requête.listeDocuments.push($élément.nom)
If (OB Is defined($requête; "listeInfos"))
$requête.listeInfos.push(OB Copy($élément))
End if
End case
End for each
: ($requête.Options ?? 1)
// ne garder que les dossiers
For each ($élément; $c)
Case of
: ($élément.nom=".@")
: ($élément.type#Is a folder)
Else
// ajouter le chemin du dossier
$requête.pathsDocuments.push($path+$élément.nom+"/")
// ajouter le nom du fichier
$requête.listeDocuments.push($élément.nom)
End case
End for each
End case
// récursivité des dossiers
If ($requête.Options ?? 2)
// mémoriser le niveau courant
$path:=$requête.pathDossier
For each ($élément; $c)
If ($élément.type=Is a folder)
// relancer avec ce dossier
$requête.pathDossier:=$path+$élément.nom+"/"
$result:=This.ListerLesDocuments($requête)
End if
End for each
End if
End if
$result.FixerSuccess()
Function TéléchargerFichier($data : Object)->$result : cs._Trace
var $info : Object
$result:=cs._Trace.me.Initialiser(Current method name)
$result.Error:=-15068
Case of
: (Not(OB Is defined($data; "pathFichier")))
$result.ErrorDescription:="le paramètre 'pathFichier' n'est pas renseigné"
: (Not(OB Is defined($data; "cheminFichier")))
$result.ErrorDescription:="le paramètre 'cheminFichier' n'est pas renseigné"
: (Not(This.serveur.getFileInfo($data.pathFichier; ->$info).success))
$result.Error:=10060
$result.ErrorDescription:="err 'getFileInfo'"
Else
// ok, on a tout
// télécharger
$result.Error:=This.serveur.RecevoirFichier($data.pathFichier; $data.cheminFichier).Error
$result.ErrorDescription:=("err 'RecevoirFichier'")*Num($result.Error#0)
// restaurer l'horodatage original du fichier
If ($result.Error=0)
SET DOCUMENT PROPERTIES($data.cheminFichier; False; False; OB Get($info; "date"; Is date); OB Get($info; "heure"; Is time); OB Get($info; "date"; Is date); OB Get($info; "heure"; Is time))
End if
// retourner le fichier téléchargé
$result.fichier:=File($data.cheminFichier; fk platform path)
End case
$result.FixerSuccess()
Function TéléchargerFichierMedia($data : Object)->$result : cs._Trace
var $fichier : Object
$result:=cs._Trace.me.Initialiser(Current method name)
$fichier:=File($data.dossierTravail.platformPath+$data.nomFichier; fk platform path)
If ($fichier.exists)
$result.fichier:=$fichier
$result.success:=True
Else
// télécharger
$result:=This.TéléchargerFichier($data)
End if
Function FixerParametresFTP()->$result : cs._Trace
// fixer les noms d'hébergement, identif et mdp pour la connexion à l'host des albums ALV
// en principe uniquement la BDD mère
// lire les données dans le fichier en ressource
var $hébergement; $identifiant; $motDePasse; $path : Text
$result:=cs._Trace.me.Initialiser(Current method name)
$hébergement:=""
$identifiant:=""
$motDePasse:=""
$result.Error:=-15012
Case of
: (Not(This.rsc.SetVariable(Est Ressource ALB; "ConnexionFTP/NomHost"; Is text; ->$hébergement)))
$result.ErrorDescription:="Connexion/NomHost"
: (Not(This.rsc.SetVariable(Est Ressource ALB; "ConnexionFTP/Identifiant"; Is text; ->$identifiant)))
$result.ErrorDescription:="Connexion/Identifiant"
: (Not(This.rsc.SetVariable(Est Ressource ALB; "ConnexionFTP/MotDePasse"; Is text; ->$motDePasse)))
$result.ErrorDescription:="Connexion/MotDePasse"
// lire le chemin du dossier des albums
: (Not(This.rsc.SetVariable(Est Ressource ALB; "chemins/FTP/Path"; Is text; ->$path)))
$result.ErrorDescription:="Connexion/NomHost"
Else
// c'est ok
$result.Error:=0
$result.ErrorDescription:=""
$result.params:=New object
$result.params.hébergement:=$hébergement
$result.params.user:=New object
$result.params.identifiant:=$identifiant
$result.params.motDePasse:=$motDePasse
// serveur un peu lent à se réveiller !
$result.params.timeOut:=30
$result.racine:=$path
End case
$result.LeverException([msgk_event])
⇧
[class]_maintenance - 10/08/2026 09:50:46
property nomTache : Text:="MaintenanceALB"
property tache : cs.xSDK.Tache
property FTP : cs._FTP
property Taches : Collection
property pathAlbum : Text
property Album : Object
Class extends _composant
Class constructor($params : Object)
Super()
Case of
: (Count parameters=0)
: (Not(OB Is defined($params; "Session_Etat")))
Else
// en particulier pour test local
Use (Storage.Host)
Storage.Host.Session_Etat:=$params.Session_Etat
End use
End case
This.FTP:=cs._FTP.new()
//---------------------
// MARK:Maintenance Web
//---------------------
Function FixerListeTâches()
// lister les tâches à exécuter
var $data : Object
This.Taches:=New collection
$data:=New object
$data.functionID:="MettreAjourData"
// prochaine nuit à 4:02
$data.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?04:02:00?)
// tous les jours
$data.période:=New object("jour"; 1; "seconde"; 0)
// lancer au démarrage du serveur APP
$data.initialiser:=True
This.Taches.push(OB Copy($data))
$data:=New object
$data.functionID:="MettreAjourPhotos"
// prochaine nuit à 4:30
$data.dateTache:=String(Add to date(Current date; 0; 0; 1); ISO date GMT; ?04:30:00?)
// tous les jours
$data.période:=New object("jour"; 1; "seconde"; 0)
// lancer au démarrage du serveur APP
$data.initialiser:=True
This.Taches.push(OB Copy($data))
cs._Trace.me.EnvoyerMessages([msgk_event]; "Maintenance"; Current method name; "tâche <MettreAjourData> programmée (voir détails dans Logs)")
cs._Trace.me.EnvoyerMessages([msgk_log]; "Maintenance - MettreAjourData"; Current method name; JSON Stringify($data))
Function Démarrer()
// exécuter dans un process externe
var $data : Object
var $numProc : Integer
Case of
: ((Storage.System.typeApplication#ALV Serveur APP) & (Not(Storage.Host.estDebugAPP())))
// serveur ALV seul uniquement ou debug
Else
$data:=New object
$data.functionID:="SuperviserLesTaches"
$data.nomTache:=This.nomTache
$data.numProcessAppelant:=-1
$numProc:=Exécuter Function Préemptive(cs._maintenance; $data)
End case
Function Arrêter()
cs.xSDK.RegistreTaches.me.Tuer(This.nomTache)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Arrêt du monitoring")
Function SuperviserLesTaches($data : Object)
// gérer les tâches de la maintenance des sessions et données albums
var $tâche : Object
var $nbre : Integer
This.tache:=$data.tache
This.tache.FixerEtat("init")
// tempo de 3 mn
Waiting(3*60*60)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "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
This[$tâche.functionID]()
// date de la prochaine maintenance
// nombre de jours
// . on peut avoir rater des périodes ; combien?
$nbre:=Current date-Date($tâche.dateTache)
// . ajouter la période
$nbre:=$nbre+$tâche.période.jour+((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; $nbre); ISO date GMT; Time(Current time+$tâche.période.seconde))
$tâche.initialiser:=False
End case
End for each
// *** attendre la période suivante
Waiting(60*10)
Until (This.tache.Tuer.signaled)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Fin du monitoring")
Function MettreAjourData()
// mettre à jour les albums dans le dossier d'installation du serveur APP, ou serveur HTTP (4D Serveur)
// ce dossier est un dossier de stockage, initialisé puis mis à jour, et à disposition des autres composants
This.tache.FixerEtat("active")
This.MettreAjourWebData()
This.tache.FixerEtat("pending")
//---------------------
// MARK:WEB
//---------------------
Function MettreAjourWebData()
// transfert des albums de l'hébergeur vers le dossier d'installation
var $data : Object
var $i : Integer
var $result : cs._Trace
// créer le dossier de travail
This.CréerDossierDeTravail("ALB_FTP")
// lister les dossiers de la racine
$data:=New object
$data.Options:=0x0002
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
$result:=This.FTP.ListerLesDocuments($data)
Case of
: (Not($result.success))
$result.Error:=-16217
$result.ErrorDescription:="Connexion FTP impossible : "+$result.ErrorDescription
: ($data.listeDocuments.length=0)
$result.Error:=-16209
$result.ErrorDescription:="FTP : pas d'albums trouvés à "+This.FTP.racineFTP
Else
// c'est parti
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Mise à jour des albums"; Current method name; "dans '"+This.document.getWEBalbumFolder().platformPath+"'")
For ($i; 0; $data.pathsDocuments.length-1)
This.Album:=$data.listeDocuments[$i]
This.pathAlbum:=$data.pathsDocuments[$i]
This.MettreAjourWebDocuments()
If (This.tache.Tuer.signaled)
// arrêter les frais
$i:=$data.pathsDocuments.length
End if
End for
End case
$result.LeverException([msgk_event; msgk_log])
This.SupprimerDossierDeTravail()
Function MettreAjourWebDocuments()
var $catalogueMedias; $fichier : Object
var $path; $dataTexte : Text
var $result : cs._Trace
$result:=cs._Trace.me.Initialiser(Current method name)
// récupérer les informations de l'album
$fichier:=This.dossierTravail.file("Data_ALB.json")
$result.Error:=This.FTP.serveur.RecevoirFichier(This.pathAlbum+"Data_ALB.json"; $fichier.platformPath).Error
$result.success:=($result.Error=0)
If ($result.success)
// lire le catalogue
$dataTexte:=Document to text($fichier.platformPath; "UTF-8"; Document with LF)
$catalogueMedias:=JSON Parse($dataTexte; Is object)
ASSERT(cs._Trace.me.DebugerMethode("Catalogue"; Current method name; "Mise à jour de l'album '"+$catalogueMedias.Identification_Nom+"'"))
// *** mettre à jour les informations medias
$fichier.copyTo(This.document.getWEBalbumFolder($catalogueMedias.Identification_ID); "Data_ALB.json"; fk overwrite)
// *** transférer les medias modifiés des albums dans les dossiers du site WEB
This.MettreAjourWebDossierMedia($catalogueMedias; 0x0007)
// puis, mettre à jour les vignettes
This.CréerWebVignettes($catalogueMedias; 0x0007)
// *** écrire les ressources
$path:=This.pathAlbum+"ressources/"
$fichier:=This.document.getWEBalbumFolder($catalogueMedias.Identification_ID).folder("ressources")
$result:=This.FTP.serveur.RecevoirDossier($path; $fichier.platformPath; 0x0300)
End if
Function MettreAjourWebDossierMedia($catalogueMedias : Object; $options : Integer)
// créer les medias s'ils n'existent pas
// bit 0 = remplacer si existe,
// bit 1 = remplacer si plus ancien,
// bit 2 = supprimer dans destination les fichiers orphelins,
// bit 3 = copier dans un seul dossier
var $dossier; $fichier; $mediaInformation; $result : Object
var $path; $ProcInProgressEtat : Text
var $mettreAjour : Boolean
var $taille : Integer
$path:=This.document.getAlbumMediasURL(This.pathAlbum)
$dossier:=This.document.getWEBalbumMediasFolder($catalogueMedias.Identification_ID)
This.rsc.SetVariable(Est Ressource ALB; "Site_Web/tailleImage"; Is longint; ->$taille)
ProcInProgressState:=0
// passer en revue chaque media source
For each ($mediaInformation; $catalogueMedias.Medias) While (Not(This.tache.Tuer.signaled))
$mettreAjour:=False
$ProcInProgressEtat:=$mediaInformation.nomFichier
$fichier:=$dossier.file($mediaInformation.nomFichier)
Case of
: (Not($fichier.exists))
// le fichier n'existe pas, le transférer
$mettreAjour:=True
$ProcInProgressEtat:="Ajout de "+$mediaInformation.nomFichier
: ($fichier.exists & ($options ?? 0))
// il existe, mais forcer le transfert
$ProcInProgressEtat:="Remplacement de "+$ProcInProgressEtat
If ($options ?? 1)
// on ne met à jour que si l'existant est plus ancien
// rappel : l'heure des data_ALB est un entier long ; celle des data est un entierLong
$mettreAjour:=(($mediaInformation.dateModification>$fichier.modificationDate) | (($mediaInformation.dateModification=$fichier.modificationDate) & (Time($mediaInformation.heureModification)>$fichier.modificationTime)))
$ProcInProgressEtat:=$ProcInProgressEtat+" du "+String($fichier.modificationDate; System date short)+" à "+String(Time($fichier.modificationTime); HH MM SS)+", par celui du "+String($mediaInformation.dateModification; System date short)+" à "+String(Time($mediaInformation.heureModification); HH MM SS)
Else
// forcer la mise à jour
$mettreAjour:=True
End if
End case
If ($mettreAjour)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Traitement"; Current method name; $ProcInProgressEtat)
// copier le fichier source
$result:=This.FTP.serveur.RecevoirFichier($mediaInformation.pathFichier; $fichier.platformPath)
This.recadrerImageDuFichier($fichier; $fichier; $taille)
SET DOCUMENT PROPERTIES($fichier.platformPath; False; False; $mediaInformation.dateModification; Time($mediaInformation.heureModification); $mediaInformation.dateModification; Time($mediaInformation.heureModification))
//renseigner le nombre de mise à jour
ProcInProgressState:=ProcInProgressState+1
// respirer un peu
Waiting(1)
End if
// renseigner la progression
ProcInProgressTime:=10000*$catalogueMedias.Medias.indexOf($mediaInformation)/$catalogueMedias.Medias.length
End for each
If ($options ?? 2)
// supprimer les fichiers orphelins de destination
// boucle sur les fichiers existants en local
For each ($fichier; $dossier.files(fk ignore invisible)) While (Not(This.tache.Tuer.signaled))
// filtrer les fichiers base64 (plétore de fichiers système...)
If ($catalogueMedias.Medias.query("nomFichier =:1"; $fichier.fullName).length=0)
// ce fichier n'est pas dans ce qui est supposé exister
$fichier.delete()
End if
End for each
End if
Function CréerWebVignettes($catalogueMedias : Object; $options : Integer)
var $fichiers : Collection
var $fichier; $vignette; $dossier; $result : Object
var $taille : Integer
var $mettreAjour : Boolean
var $ProcInProgressEtat : Text
$result:=New object
// lister les fichiers existants
$fichiers:=This.document.getWEBalbumMediasFolder($catalogueMedias.Identification_ID).files(fk ignore invisible)
$result.Error:=-15068
Case of
: ($fichiers=Null)
$result.ErrorDescription:="L'album "+$catalogueMedias.Identification_ID+" n'existe pas"
: ($fichiers.length=0)
$result.ErrorDescription:="L'album "+$catalogueMedias.Identification_ID+" est vide"
Else
$result.Error:=0
ProcInProgressState:=0
// créer le dossier des vignettes de l'album sur le site Web
$dossier:=This.document.getWEBalbumVignettesFolder($catalogueMedias.Identification_ID)
// au cas où ...
$dossier.create()
$taille:=OB Get($catalogueMedias; "Vignettes_TailleVignette"; Is longint)
// passer en revue chaque media source
For each ($fichier; $fichiers) While (Not(This.tache.Tuer.signaled))
$mettreAjour:=False
$ProcInProgressEtat:=$fichier.fullName
$vignette:=$dossier.file($fichier.fullName)
Case of
: (Not($vignette.exists))
// le fichier n'existe pas, le transférer
$mettreAjour:=True
$ProcInProgressEtat:="Ajout de "+$fichier.fullName
: ($vignette.exists & ($options ?? 0))
// il existe, mais forcer le transfert
$ProcInProgressEtat:="Remplacement de "+$ProcInProgressEtat
If ($options ?? 1)
// on ne met à jour que si l'existant est plus ancien
// rappel : l'heure des data_ALB est un entier long ; celle des data est un entierLong
$mettreAjour:=(($fichier.modificationDate>$vignette.modificationDate) | (($fichier.modificationDate=$vignette.modificationDate) & (Time($fichier.modificationTime)>$vignette.modificationTime)))
$ProcInProgressEtat:=$ProcInProgressEtat+" du "+String($vignette.modificationDate; System date short)+" à "+String(Time($vignette.modificationTime); HH MM SS)+", par celui du "+String($fichier.modificationDate; System date short)+" à "+String(Time($fichier.modificationTime); HH MM SS)
Else
// forcer la mise à jour
$mettreAjour:=True
End if
End case
If ($mettreAjour)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Traitement"; Current method name; $ProcInProgressEtat)
// créer la vignette
This.recadrerImageDuFichier($fichier; $vignette; $taille)
SET DOCUMENT PROPERTIES($vignette.platformPath; False; False; $fichier.modificationDate; Time($fichier.modificationTime); $fichier.modificationDate; Time($fichier.modificationTime))
//renseigner le nombre de mise à jour
ProcInProgressState:=ProcInProgressState+1
// respirer un peu
Waiting(1)
End if
// renseigner la progression
ProcInProgressTime:=10000*$fichiers.indexOf($fichier)/$fichiers.length
End for each
End case
Function recadrerImageDuFichier($fichierIN : Object; $fichierOUT : Object; $taille : Integer)
var $image : Picture
var $width; $height; $gauche; $haut : Integer
var $zoom : Real
// lire les données de ce fichier
READ PICTURE FILE($fichierIN.platformPath; $image)
PICTURE PROPERTIES($image; $width; $height)
// calculer la taille de l'image qui rentre dans le cadre $taille x $taille
$zoom:=-Scaled to fit prop centered // format d'affichage de l'image
$gauche:=0
$haut:=0
This.fct.CalculerRectangleMedia(->$gauche; ->$haut; ->$taille; ->$taille; $width; $height; ->$zoom)
$width*=$zoom
$height*=$zoom
If ($fichierIN.extension=".jpg")
// tailler aux multiples de 8
$width-=Mod($width; 8)
$height-=Mod($height; 8)
End if
// créer l'image
CREATE THUMBNAIL($image; $image; $width; $height; Scaled to fit prop centered)
// compresser à 80% , a priori n'affecte pas les format png
CONVERT PICTURE($image; $fichierIN.extension; 0.9)
// enregistrer
WRITE PICTURE FILE($fichierOUT.platformPath; $image; $fichierOUT.extension)
//---------------------
// MARK:Photos Synology
//---------------------
Function MettreAjourPhotos()
// recopie du dossier géré par ce composant ALB dans $destination
var $tache : cs.xSDK.Tache
var $fintraitement : Boolean:=False
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance"; Current method name; "Init de la mise à jour des Albums dans Photos Synologycopie")
Repeat
// lire la présence de la tâche du composant ALB et son état
$tache:=cs.xSDK.RegistreTaches.me.LireTache(This.nomTache)
Case of
: ($tache=Null)
// maintenance non démarrée
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, maintenance ALB non démarrée")
: ($tache.Etat="init")
// tâche maintenance non démarrée
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, tâche maintenance ALB en 'init'")
: ($tache.Etat#"pending")
// maintenance en cours
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, tâche maintenance ALB en 'active'")
Else
// a priori les albums sont disponibles
// mettre à jour
cs.$photos.new().MettreAjour()
$fintraitement:=True
End case
// attendre un peu
Waiting(60*60)
Until ($fintraitement)
//---------------------
// MARK:Installation APP
//---------------------
Function InstallerAlbums($dossierDestination : 4D.Folder)
// recopie du dossier géré par ce composant ALB dans $destination
var $tache : cs.xSDK.Tache
var $fintraitement : Boolean:=False
var $dossierSource : 4D.Folder
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Init copie des albums dans "+$dossierDestination.platformPath)
Repeat
// lire la présence de la tâche du composant ALB et son état
$tache:=cs.xSDK.RegistreTaches.me.LireTache(This.nomTache)
Case of
: ($tache=Null)
// maintenance non démarrée
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, maintenance ALB non démarrée")
: ($tache.Etat="init")
// tâche maintenance non démarrée
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, tâche maintenance ALB en 'init'")
: ($tache.Etat#"pending")
// maintenance en cours
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie KO, tâche maintenance ALB en 'active'")
Else
// a priori les albums sont disponibles
// les recopier
$dossierSource:=cs._document.new().getDataFolder().folders()[0]
$dossierSource.copyTo($dossierDestination; fk overwrite)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie OK, dossier source "+$dossierSource.platformPath)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Maintenance Albums"; Current method name; "Copie OK, dossier destination "+$dossierDestination.platformPath)
$fintraitement:=True
End case
// attendre un peu
Waiting(60*60)
Until ($fintraitement)
⇧
[class]$pageWeb - 22/10/2025 11:04:13
property result : cs._Trace
Class extends $serveurWeb
Class constructor($url : Text)
Super()
This.LireParametresUrl($url)
This.result:=cs._Trace.me
//----------------------------------
// MARK:Element HTML
//----------------------------------
Function LireSTR()
This.result.resultat:=""
If (This.paramsUrl.length>0)
This.result.resultat:=Localized string(This.paramsUrl[1])
End if
This.result.resultat:=Char(1)+This.result.resultat
Function Date()
var $result : Text
var $date : Date
$result:=""
This.rsc.SetVariable(Est Ressource APP; "Ressources_Communes/Nom_Application"; Is text; ->$result)
$date:=!00-00-00!
This.rsc.SetVariable(Est Ressource ALB; "Site_Web/Date_Mise_a_jour"; Is date; ->$date)
$result:=$result+" - Le "+String($date; Internal date long)
This.result.resultat:=Char(1)+$result
Function getContact($album : Object)->$result : Text
$result:="Pas de contact"
Case of
: (Not(OB Is defined($album; "Contact_eMail")))
: (Not(OB Is defined($album; "Contact_Nom")))
Else
$result:="Contact <a href=mailto:"+$album.Contact_eMail+">"+$album.Contact_Nom+"</a>"
End case
//----------------------------------
// MARK:Requetes HTTP
//----------------------------------
Function TraiterURL()->$result : cs._Trace
// traitement des url
This.result.Initialiser(Current method name)
// 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
//----------------------------------
// MARK:Gestion des pages
//----------------------------------
Function Envoyer($nomPageWeb : Text; $EtatNavigation : Text)
// fixer les variables process
Use (Session.storage.ALB_HTTPvars)
Session.storage.ALB_HTTPvars.wwwEtatNavigation:=$EtatNavigation
End use
// restaurer les variables process de construction de la page .shtml
This.RestaurerHTTPvars()
WEB SEND FILE($nomPageWeb)
Function Rediriger($url : Text)
WEB SEND HTTP REDIRECT($url)
⇧
[class]$photos - 04/03/2026 11:33:27
property dossierPhotos : 4D.Folder
property catalogueMedias; catalogueMediasHost : Object
Class extends _maintenance
Class constructor()
Super()
//---------------------
// MARK:Traitement Photos
//---------------------
Function MettreAjour()
// copie des albums locaux vers le dossier de l'hébergeur
// attention, telle que conçue cette function n'est appelable que sur la machine hôte du serveur APP (lecture directe des dossiers)
var $c : Collection
var $dossier : 4D.Folder
If ((Storage.System.typeApplication=ALV Serveur APP) | (Not(Storage.System.estExecuteDansHote)))
// c'est parti
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; Current method name; "Mise à jour des albums PhotosSyno")
// créer le dossier de travail
This.CréerDossierDeTravail("ALB_FTP")
// initialiser FTP
This.FixerParametresFTPphotos()
// liste des albums locaux
$c:=This.document.getWEBalbumsFolder().folders(fk ignore invisible)
Case of
: (This.FTP.racineFTP="")
: ($c.length=0)
Else
For each ($dossier; $c)
This.MettreAjourDossierPhotos($dossier)
End for each
End case
This.SupprimerDossierDeTravail()
End if
Function MettreAjourDossierPhotos($dossier : 4D.Folder)
// $dossier est un dossier album sur le disque dur local
var $dataTexte : Text
var $fichiers : Collection
var $fichier : 4D.File
// lire le catalogue des albums
$fichier:=$dossier.file("Data_ALB.json")
$dataTexte:=$fichier.getText("UTF-8"; Document with LF)
This.catalogueMedias:=JSON Parse($dataTexte; Is object)
ASSERT(cs._Trace.me.DebugerMethode("Catalogue"; Current method name; "Mise à jour de l'album '"+This.catalogueMedias.Identification_Nom+"'"))
// lister les medias de $dossier (dans disque dur local) et ses sous dossiers
$fichiers:=This.document.getWEBalbumMediasFolder(This.catalogueMedias.Identification_ID).files(fk recursive+fk ignore invisible)
Case of
: (Not(This.ListerDocumentsDeDossierPhotos(This.catalogueMedias.Identification_Nom).success))
// la liste des données de l'album Photos sur l'hébergeur est vide
: ($fichiers.length=0)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Traitement"; Current method name; "L'album '"+This.catalogueMedias.Identification_Nom+"' local est vide")
Else
// dossier des photos à envoyer
This.dossierPhotos:=This.dossierTravail.folder(This.catalogueMedias.Identification_Nom)
This.dossierPhotos.create()
For each ($fichier; $fichiers)
If (This.estPhotoAncienne($fichier))
// créer le document à ajouter à $listeSyno
This.CréerPhoto($fichier)
End if
End for each
If (This.dossierPhotos.files(fk ignore invisible).length>0)
// il y a des modifications
// mettre à jour le catalogue des medias de l'album au dossier
$fichier:=$dossier.file("Data_ALB.json")
$fichier.copyTo(This.dossierPhotos)
// transférer le tout vers l'hébergeur
This.Téléverser()
Else
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Traitement"; Current method name; "pas de mise à jour de l'album '"+This.catalogueMedias.Identification_Nom+"'")
End if
This.dossierPhotos.delete(Delete with contents)
End case
Function CréerPhoto($fichier : 4D.File)
var $catalogueMedia; $params : Object
var $image : Picture
var $fichierSVG : 4D.File
// récupérer les données du fichier
Try
$catalogueMedia:=This.catalogueMedias.Medias.query("nomFichier = :1"; $fichier.fullName)[0]
Catch
$catalogueMedia:=Null
End try
If (Not($catalogueMedia=Null))
$params:=New object
$params.width:=$catalogueMedia.MED_DimensionX
$params.height:=$catalogueMedia.MED_DimensionY
$params.url:="file://"+cs.xSDK.Outils.me.ConvertirPathVersURL($fichier.platformPath; False; True)
$params.titre:=$catalogueMedia.MED_Nom
$params.taillePoliceTitre:=96
$params.taillePoliceComment:=64
$params.date:=String(Date($catalogueMedia.MED_HoroDate); Internal date long)
$params.comment:=This.traiterCaractèresSpéciaux($catalogueMedia.MED_Commentaire)
$params.length:=2*Int($params.width/$params.taillePoliceComment)
$params.nbrMaxLignes:=10
This.MultiLignerTexte($catalogueMedia.MED_Commentaire; $params)
$params.viewBoxWidth:=$catalogueMedia.MED_DimensionX
$params.viewBoxHeight:=$catalogueMedia.MED_DimensionY+(2*$params.taillePoliceTitre)+100+(($params.lignes.length-1)*$params.taillePoliceComment)
$params.Format:=Copy XML data source
This.TraiterTemplateSVG("ImageDeMedia.xml"; ->$image; $params)
$fichierSVG:=This.dossierPhotos.file(Replace string($catalogueMedia.MED_HoroDate; ":"; "_")+$catalogueMedia.nomFichier)
WRITE PICTURE FILE($fichierSVG.platformPath; $image)
End if
//---------------------
// MARK:Hébergeur
//---------------------
Function ListerDocumentsDeDossierPhotos($nomDossier : Text)->$result : cs._Trace
// fixer la liste des photos et leur catalogue sur l'hébergeur
var $data : Object
var $documents : Collection:=Null
var $dataTexte : Text
// tester la présence du dossier $nomDossier
$data:=New object
$data.pathDossier:=This.FTP.racineFTP
$data.Options:=0x0002 // les dossiers
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
$result:=This.FTP.ListerLesDocuments($data)
Case of
: (Not($result.success))
$result.Error:=-16217
$result.ErrorDescription:="Connexion FTP impossible : "+$result.ErrorDescription
: ($data.listeDocuments.indexOf($nomDossier)=-1)
// rappel : cet album est lié à des règles de 'Photos Synology' ; on ne peut pas le créer ici"
$result.Error:=-16209
$result.ErrorDescription:="L'album "+$nomDossier+" n'existe pas. Créer dans 'Photos Synology' un album intelligent à ce nom"
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Traitement"; Current method name; "L'album '"+$nomDossier+"' n'existe pas. Créer dans 'Photos Synology' un album intelligent à ce nom")
Else
$result.Error:=0
// lister les medias de l'album sur l'hébergeur
$data:=New object
$data.pathDossier:=This.FTP.racineFTP+$nomDossier+"/"
$data.Options:=0x0001 // les documents
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
$result:=This.FTP.ListerLesDocuments($data)
Case of
: (Not($result.success))
$result.Error:=-16217
$result.ErrorDescription:="Connexion FTP impossible : "+$result.ErrorDescription
Else
$result.Error:=0
$documents:=$data.listeDocuments
End case
Case of
: ($documents=Null)
: ($documents.indexOf("Data_ALB.json")=-1)
// catalogue absent
Else
// le télécharger
$data.pathFichier:=$data.pathDossier+"Data_ALB.json"
$data.cheminFichier:=This.dossierTravail.platformPath+"Data_ALB.json"
$result:=This.FTP.TéléchargerFichier($data)
If ($result.success)
// c'est bon
$dataTexte:=Document to text($result.fichier.platformPath; "UTF-8"; Document with LF)
This.catalogueMediasHost:=JSON Parse($dataTexte; Is object)
End if
End case
End case
$result.FixerSuccess()
Function estPhotoAncienne($fichier)->$result : Boolean
// $fichier est un fichier du dossier local ; on nom est
// comparer les dates de modification de la photos du catalogue local et du catalogue Syno
var $catalogueMedia; $catalogueMediaHost : Object
Try
$catalogueMedia:=This.catalogueMedias.Medias.query("nomFichier = :1"; $fichier.fullName)[0]
Catch
$catalogueMedia:=Null
End try
Try
$catalogueMediaHost:=This.catalogueMediasHost.Medias.query("nomFichier = :1"; $fichier.fullName)[0]
Catch
$catalogueMediaHost:=Null
End try
$result:=True
Case of
: ($catalogueMedia=Null)
// pas normal, on abandonne
$result:=False
: ($catalogueMediaHost=Null)
// photo non présente, on l'ajoute
: ($catalogueMediaHost.dateModification<$catalogueMedia.dateModification)
// on ajoute la plus récente
Else
// on passe
$result:=False
End case
//$result:=True // pour test !
Function Téléverser()
var $data : Object
Case of
// dossier à transférer
: (This.dossierPhotos=Null)
// chemin sur l'hébergeur
: (This.FTP=Null)
// normalement déjà initialisé
Else
// on a tout, on continue
// transférer avec les options :
$data:=New object
$data.dossier:=This.dossierPhotos
// options : forcer la mise à jour et supprimer les orphelins
$data.Options:=(0x0001 ?+ 2)
// versionner
$data.cheminFTP:=This.FTP.racineFTP+This.catalogueMedias.Identification_Nom+"/"
$data.tache:=cs.xSDK.RegistreTaches.new().Inscrire(New object("nomProcess"; Current process name; "nomTache"; "MiseAjourSynoPhotos"; "numProcessAppelant"; Current process))
// lancer la tâche
$data.result:=This.FTP.serveur.MettreAjourDossier($data)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Téléversement "+Choose($data.result.success; "[OK]"; "[KO]"); Current method name; "Mise à jour de "+String(This.dossierPhotos.files(fk ignore invisible).length)+" photos dans l'album "+This.catalogueMedias.Identification_Nom)
End case
//---------------------
// MARK:Utilitaires
//---------------------
Function traiterCaractèresSpéciaux($texte : Text)->$result : Text
$result:=$texte
$result:=Replace string($result; "&"; "&")
Function MultiLignerTexte($texte : Text; $params : Object)
// spliter dans le tableau $ptrTab le texte $texte en N lignes de $params.length max caractères
// N ne doit pas dépasser $params.nbrMaxLignes
var $c : Collection
var $itemText; $mot : Text
var $Error : Integer
$Error:=-15068
$params.lignes:=New collection
Case of
: (Not(OB Is defined($params; "length")))
: (Not(OB Is defined($params; "nbrMaxLignes")))
Else
// c'est ok
$Error:=0
$c:=Split string($texte; " "; sk ignore empty strings)
ARRAY TEXT($tabElements; 0)
COLLECTION TO ARRAY($c; $tabElements)
$itemText:=""
For each ($mot; $c)
If (Length($itemText+" "+$mot)<$params.length)
$itemText:=$itemText+$mot+" "
Else
$params.lignes.push($itemText)
$itemText:=$mot+" "
End if
End for each
// ajouter le petit dernier
$params.lignes.push($itemText)
// on ne veut pas plus de "nbrMaxLignes" lignes
If ($params.lignes.length>$params.nbrMaxLignes)
$params.lignes:=$params.lignes.resize($params.nbrMaxLignes)
// finaliser le dernier élément
$itemText:=$params.lignes[$params.lignes.length-1]
$params.lignes[$params.lignes.length-1]:=Choose(Length($itemText+"...")>$params.length; Substring($itemText; 1; Length($itemText)-3)+"..."; $itemText+"...")
End if
End case
cs._Trace.me.Créer($Error; Current method name; "paramètres incorrects").LeverException([msgk_event; msgk_log])
Function TraiterTemplateSVG($nomTemplate : Text; $ptrImage : Pointer; $params : Object)->$result : Integer
// $nomTemplate : nom du fichier template en ressources, $ptrImage image destination, $params paramètres de construction
var $format : Integer
var $path : 4D.File
var $dossier : 4D.Folder
var $racineXML : Text
var $pict : Picture
var $texteBlobé : Blob
var $dataText : Text
$path:=Folder(fk resources folder).folder("TemplatesALB").file($nomTemplate)
$dossier:=This.dossierTravail
$result:=-15068
Case of
: (Not($path.exists))
: (Type($ptrImage->)#Is picture)
// créer le fichier
: (This.TraiterBalisesFichier($path; $dossier; $params)#0)
Else
$result:=0
// résultat dans $dossier+$nomTemplate
$path:=$dossier.file($nomTemplate)
End case
Case of
// ok avant
: ($result#0)
// on a un fichier
: (Not($path.exists))
: (Not(OB Is defined($params; "Format")))
Else
DOCUMENT TO BLOB($path.platformPath; $texteBlobé)
$dataText:=BLOB to text($texteBlobé; UTF8 text without length)
$racineXML:=DOM Parse XML source($path.platformPath)
// on a une structure XML
$result:=Erreur de lecture du fichier*Num(ok=0)
If ($result=0)
// convertir en image
$format:=$params.Format
SVG EXPORT TO PICTURE($racineXML; $pict; $format)
CONVERT PICTURE($pict; ".JPG"; 0.9)
$path.delete()
$path:=Folder(fk home folder).folder("tempo_ALV/_ALBdebug").file("Test_SVG_SynoPhotos.xml")
DOM EXPORT TO FILE($racineXML; $path.platformPath) //pour des tests"
DOM CLOSE XML($racineXML)
$ptrImage->:=$pict
Else
cs._Trace.me.Créer(-15075; Current method name; "Erreur lecture du fichier de la photo '"+$params.titre+"' (voir détails dans logs)").LeverException([msgk_event; msgk_log])
cs._Trace.me.EnvoyerMessages([msgk_log]; "Erreur lecture de fichier"; Current method name; JSON Stringify($params))
End if
End case
Function TraiterBalisesFichier($fichier : 4D.File; $dossier : 4D.Folder; $params : Object)->$result : Integer
// appliquer le traitement des balises 4D au contenu d'un fichier texte
// $1 est un fichier : traiter le texte du fichier
// $2 dossier des fichiers traités
// $3 : options
var $dataTexte : Text
var $chemin : 4D.File
var $texteBlobé : Blob
$result:=-15068
Case of
: (Not($fichier.exists))
Else
$result:=0
// lire le contenu à traiter
$dataTexte:=$fichier.getText()
// créer le chemin de destination
$chemin:=$dossier.file($fichier.fullName)
// on y va
PROCESS 4D TAGS($dataTexte; $dataTexte; $params)
// on enregistre
SET BLOB SIZE($texteBlobé; 0)
TEXT TO BLOB($dataTexte; $texteBlobé; UTF8 text without length)
$chemin.setContent($texteBlobé)
End case
Function FixerParametresFTPphotos()
var $path : Text:=""
var $result : cs._Trace
This.FTP.racineFTP:="" // erreur
$result:=cs._Trace.me.Initialiser(Current method name)
$result.Error:=-15012
Case of
: (Not(This.rsc.SetVariable(Est Ressource ALB; "chemins/FTP/PathSynologyPhotos"; Is text; ->$path)))
$result.ErrorDescription:="Connexion/NomHost"
Else
$result.Error:=0
// initialiser
This.FTP.racineFTP:=$path
End case
$result.LeverException([msgk_event; msgk_log])
⇧
[class]$serveurWeb - 30/05/2025 18:39:35
property balisesUrl; paramsUrl : Collection
Class extends _composant
Class constructor()
Super()
//---------------------
// MARK:Requete HTTP
//---------------------
Function AuthentificationWeb($url : Text; $header : Text; $BrowserIP : Text; $ServerIP : Text; $user : Text; $password : Text)->$success : Boolean
// renvoie vrai
// si l'url $1 est concerné par ce serveur.
// et si l'url $1 est accepté.
// en cas serveur Web, depuis v8.2 les albums sont intégrés à la session webUser => l'authentification est donc faite avec $3
// pour les tests, ou l'anti piratage, faire une authentification locale
This.InitProcess()
// par défaut, refus accès ou pas traité ici
$success:=False
Case of
: ($url="/4DCGI/WebAlbums/seConnecter")
Case of
: (Count parameters>1)
// appel depuis le serveur WEB, $3 = un user
Case of
: (Not(OB Is defined(Session)))
: (Not(OB Is defined(Session.storage; "WebUser")))
: (Not(OB Is defined(Session.storage.WebUser; "droits")))
// pas normal !
Else
// ok on a un user
// vérifier son droit d'accès à l'espace privé (en principe déjà fait)
// on pourrait tester un bit propre à ALB
$success:=(Session.storage.WebUser.droits ?? 0)
// ici session.userName est renseigné, Session.isGuest()=faux
This.InitDataSession()
End case
Else
// appel local (test), ou piratage de l'url ...
// même logique que le serveur Web
Case of
// Pour des raisons de sécurité, refuser les noms qui contiennent @
: (($user="") | cs.xSDK.Outils.me.ContientJoker($user))
// $utilisateur="" dans 2 cas : init de la saisie LogIn/pwd et annulation de la saisie
If (wwwEtatNavigationALB#"authentification")
// ici on vient de cliquer sur "espace privé"
wwwEtatNavigationALB:="authentification"
// début du processus (demande d'identif par le navigateur)
Else
// Ici : annulation de l'authentification par user
cs.$pageWeb.new("").Envoyer("AlbumsAccueil.shtml"; "accueil")
End if
// refus demander au navigateur un LogIn / MdP
Else
// identifiant et MdP ont été saisis par le webUser : reconnaître l'utilisateur
$success:=WEB Validate digest($user; $password)
End case
End case
//: ($url="/4DCGI/Album/consulter@")
: ($url="/4DCGI/Album/editer@")
// est un albums user ?
//$3->:=ALB_Traiter Action HTML ($url;->$utilisateur)
$success:=True
: ($url="/4DCGI/WebAlbum@")
// les autres url sont autorisées si une session existe
$success:=True
: (($url="@4DSCRIPT/ALB_@") | ($url="@ressourcesAlbum@"))
// les commandes / ressources sont autorisées si une session existe
$success:=True
Else
// pas concerné, passer la main
$success:=False
End case
// initialiser les variables process
This.RestaurerHTTPvars()
Function ConnexionWeb($url : Text; $header : Text; $BrowserIP : Text; $ServerIP : Text; $user : Text; $password : Text)->$success : Boolean
// appel du composant ; ici on est thread-safe
var $result : Object
This.InitProcess()
$result:=This.TraiterURL($url)
$success:=($result.Error=0)
Function TraiterURL($url : Text)->$result : Object
// traiter toutes les url envoyées par le formulaire le client HTML (construction formulaire ou action) ou une requete HTTP javascript
// 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ême format :
// /4Dxxx/yyy/nomFunction {?param1 {?param2...}}, avec xxx = CGI ou ACTION ou SCRIPT, yyy le contexte d'une classe ($pageWebyyy)
// transmettre l'url à la bonne classe $page pour traitement
$result:=cs._Trace.me.Initialiser(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[1], 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($url).TraiterURL()
End case
// on ne lève pas d'exception (l'historique des requêtes Web est dans le journal WEB)
Function LireParametresUrl($url : Text)
// séparer $url en :
// une liste de balises 4Dxxx, yyy, nomFunction
// une liste de paramètres param1 param2...
// lire les balises
This.balisesUrl:=Split string($url; "/"; sk ignore empty strings)
This.paramsUrl:=New collection
Case of
: ($url="")
: (This.balisesUrl.length=0)
Else
// 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])
End case
//---------------------
// MARK:Serveur Web
//---------------------
Function InitDataSession()
// initialiser les variables session
This.InitData()
This.InitUserParams()
This.InitHTTPvars()
Function InitData()
var $data : Object
// variables par défaut pour la construction du site web ; surchargeables
Use (Session.storage)
Session.storage.ALB_Data:=New shared object
End use
$data:=Session.storage.ALB_Data
Use ($data)
$data.urlOuvrirALB:="/WebAlbums/OuvrirAlbum"
$data.urlVisualiserALB:="/WebAlbums/VisualiserAlbum"
$data.pageAccueilALB:="AlbumsAccueil.shtml"
$data.pageVisuALB:="AlbumVisualiser.shtml"
$data.avecContact:=True
End use
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.ALB_UserParams:=New shared object
End use
$data:=Session.storage.ALB_UserParams
Use ($data)
$data.Albums:=New shared collection
$data.Album:=New shared object
$data.Medias:=New shared collection
End use
Function InitHTTPvars()
var $data : Object
// variables utilisées dans les templates de page Web
// en cours de recherche ou de saisie utilisateur
// RAPPEL : cette liste sert à initialiser TOUTES les variables proces ; toutes ces variables doivent être dans cette liste
Use (Session.storage)
Session.storage.ALB_HTTPvars:=New shared object
End use
$data:=Session.storage.ALB_HTTPvars
Use ($data)
// init accueil
$data.wwwURLalbum:=""
$data.wwwTitre:=""
$data.wwwComment:=""
$data.wwwRacineRessources:="../../" // depuis v5.2 les 4DURL sont de la forme /4Dxxx/xxx/yyy
End use
Function InitContexte($url : Text)
var $vs4D : Text
$vs4D:="4D4D"
Case of
: ($url="@albums@")
$vs4D:="4D4Dalbum"
End case
// stocker
Use (Session.storage.ALB_HTTPvars)
Session.storage.ALB_HTTPvars.vs4D:=$vs4D
End use
Function RestaurerHTTPvars()
// copier HTTPvars dans les variables process
// ici COMPILER_WEB a été appelé (les variables process sont définies)
var $data : Object
var $attribut : Text
var $ptr : Pointer
// définir les variables process (utile en mode interprété)
COMPILER_WEB
If (OB Is defined(Session.storage; "ALB_HTTPvars"))
$data:=Session.storage.ALB_HTTPvars
For each ($attribut; $data)
$ptr:=Get pointer($attribut)
Case of
: (Undefined($ptr->))
// pas normal
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Variable indéfinie"; Current method name; "La variable '"+$attribut+"' n'a pas été initialisée dans COMPILER_WEB")
Else
// une variable
$ptr->:=$data[$attribut]
End case
End for each
End if
⇧
[class]$albumsVisualisateur - 06/02/2026 17:48:52
property IndexCatalogue; urlMenuNav : Text
property nomZoneWeb : Text:="ZoneNav"
Class extends _albums
Class constructor()
Super()
This.grandEcran:=True
This.mémoTaille:=False
// ----------------------
// sélection
// -----------------------
Function ListerAlbums()
// alimenter le sélecteur d'albums
// collectionner les albums
Super.ListerAlbums()
// créer la collection des albums avec cette collection
Form.selecteur.values:=This.nomsAlbums
// ----------------------
// formulaire
// -----------------------
Function OuvrirFormulaire()
// méthode du process U_Nav_Album_
var $wndNum : Integer
var $nomForm : Text
// créer la fenêtre
If (Is Windows)
Else
$nomForm:="Visualiser Album"
// ici on ne veut pas de palettes
// ??? This.$formulaire.FixerVisibilitéPalettes(False)
HIDE MENU BAR
$wndNum:=Open form window($nomForm; Plain form window; *)
Case of
: (Not(Storage.System.estExecuteDansHote))
SHOW MENU BAR
: (Not(This.grandEcran))
Else
SET WINDOW RECT(0; 0; Screen width; Screen height; $wndNum)
End case
SET WINDOW TITLE(""; $wndNum)
DIALOG($nomForm; This)
CLOSE WINDOW
CLEAR VARIABLE($wndNum)
End if
Function InitFormulaire()
// un album doit exister ; préparer l'affichage
Case of
: (OB Is empty(This.Album))
: (Not(OB Is defined(This.Album; "Medias")))
: (This.Album.Medias.length=0)
Else
This.TrierMedias()
This.CréerBarreNavigation()
WA OPEN URL(*; This.nomZoneWeb; This.urlMenuNav) // Ouvrir la page Web
// afficher le premier media
This.indexMedia:=0
This.AfficherMedia()
End case
Function CréerBarreNavigation()
// créer une page html avec la liste des icones de l'album
var $fichier; $template : Text
var $texteBlobé : Blob
$fichier:=Folder(Get 4D folder(Current resources folder); fk platform path).folder("TemplatesPagesWeb").file("AlbumNavigation.shtml").platformPath
DOCUMENT TO BLOB($fichier; $texteBlobé)
$template:=BLOB to text($texteBlobé; UTF8 text without length)
// ici on n'a pas les données du serveur Web => le domaine est en DUR dans le template
PROCESS 4D TAGS($template; $template; This.Album.Medias; This.Album.Identification_ID)
SET BLOB SIZE($texteBlobé; 0)
TEXT TO BLOB($template; $texteBlobé; UTF8 text without length)
$fichier:=This.requête.dossierTravail.platformPath+"ALV_navALB.htm"
BLOB TO DOCUMENT($fichier; $texteBlobé)
This.urlMenuNav:=$fichier
Function AfficherMedia()
// afficher le media courant
var $data; $result : Object
var $image : Picture
This.mediaInformation:=This.Album.Medias[This.indexMedia]
// convertir la date
Form.HoroDate:=Date(This.mediaInformation.MED_HoroDate)
// afficher la photo
$data:=This.requête
$data.pathFichier:=This.mediaInformation.pathFichier
$data.nomFichier:=This.mediaInformation.nomFichier
$result:=This.FTP.TéléchargerFichierMedia($data)
If ($result.success)
READ PICTURE FILE($result.fichier.platformPath; $image)
Form.photo:=$image
End if
This.IndexCatalogue:=String(This.indexMedia+1)+" / "+String(This.Album.Medias.length)
// ----------------------
// MARK: navigation
// -----------------------
Function PremierMedia()
This.indexMedia:=0
This.AfficherMedia()
Function MediaPrécédent()
If (This.indexMedia=0)
BEEP
Else
This.indexMedia:=This.indexMedia-1
This.AfficherMedia()
End if
Function MediaSuivant()
If (This.indexMedia=(This.Album.Medias.length-1))
BEEP
Else
This.indexMedia:=This.indexMedia+1
This.AfficherMedia()
End if
Function DernierMedia()
This.indexMedia:=This.Album.Medias.length-1
This.AfficherMedia()
Function AllerAMedia($index : Integer)
This.indexMedia:=$index
This.AfficherMedia()
⇧
[class]$pageWebAlbums - 06/02/2026 17:48:59
Class extends $pageWeb
Class constructor($url : Text)
Super($url)
// les paramètres sont récupérés
Function TraiterURL()->$result : cs._Trace
// traitement des url de la page albums
This.result.Initialiser(Current method name)
// 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 seConnecter()
// l'authentification est ok
This.Envoyer(Session.storage.ALB_Data.pageAccueilALB; "accueilAlbums")
Function ListerAlbums()
var $dossiers : Collection
// dossier des albums (v6.4.6 dans le dossier Web)
$dossiers:=This.document.getWEBalbumsFolder_Courant().folders()
This.Lister($dossiers)
Function Lister($dossiers : Collection)
var $result; $path : Text
var $album : Object
This.getListe($dossiers)
Case of
: (Session.storage.ALB_UserParams.Albums=Null)
// pas normal
$result:="<h2>"+Localized string("1010")+"</h2>"
: (Session.storage.ALB_UserParams.Albums.length=0)
// pb installation, ou utilisateur invité
$result:="<h2>"+Localized string("1009")+"</h2>"
Else
$result:=""
For each ($album; Session.storage.ALB_UserParams.Albums)
$path:=Session.storage.ALB_Data.urlOuvrirALB+"?"+$album.Identification_ID
$result:=$result+"<h2>"+"<a href="+Char(Double quote)+"/4DCGI"+$path+Char(Double quote)+">"+$album.Nom+"</a>"+"</h2>"
// contact
If (Session.storage.ALB_Data.avecContact)
$result:=$result+"<h3><spam>"+This.getContact($album)+"</spam></h3>"
End if
End for each
End case
This.result.resultat:=Char(1)+$result
Function getListe($dossiers : Collection)
// lister les albums disponibles sur le serveur Web et filtrer ceux autorisés par le WebUser
// peut être appeler par l'extérieur
var $dataTexte : Text
var $IDfamille : Integer
var $c : Collection
var $dossier; $fichier; $metaData : Object
// lire l'ID du groupe familial du WebUser
Case of
: (Not(Storage.System.estExecuteDansHote))
$IDfamille:=-1001
: (Storage.System.typeApplication=ALV Serveur HTTP)
// test avec 4D Serveur
$IDfamille:=-1001
: (Storage.System.typeApplication=ALV BDD mère)
// pour test
$IDfamille:=-1001
: (Session.isGuest())
$IDfamille:=-1
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Accueil albums [KO]"; Current method name; "Session invité, groupe familial "+String($IDfamille))
: (OB Is defined(Session.storage; "userInfo"))
// ok session mobile
$IDfamille:=Session.storage.userInfo.IDfamille
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Accueil albums [OK]"; Current method name; "Session Mobile, groupe familial "+String($IDfamille))
: (OB Is defined(Session.storage; "WebUser"))
// ok session Web
$IDfamille:=Session.storage.WebUser.leGroupe.IDfamille
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Accueil albums [OK]"; Current method name; "Session Web, groupe familial "+String($IDfamille))
Else
// c'est ko
$IDfamille:=0
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Accueil albums [KO]"; Current method name; "Aucune session, groupe familial "+String($IDfamille))
End case
$c:=New collection
Case of
: ($dossiers.length=0)
: ($IDfamille=0)
$c:=Null
Else
For each ($dossier; $dossiers)
// lire les droits de l'album $dossier
$fichier:=$dossier.file("Data_ALB.json")
// c'est bon
$dataTexte:=Document to text($fichier.platformPath; "UTF-8"; Document with LF)
$metaData:=JSON Parse($dataTexte; Is object)
Case of
: ($fichier=Null)
// les droits sont un objet avec NomGroupe, IDgroupe (familial) et Droits (vrai si la famille y a accès)
: ($metaData.Acces_Droits.query("IDgroupe = :1 AND Droits = :2"; $IDfamille; True).length=0)
Else
// le WebUser a acces à cet album
$c.push($metaData)
End case
End for each
$c:=$c.orderBy("Identification_Nom")
// mémoriser
sharedCollection($c; Session.storage.ALB_UserParams.Albums)
End case
Function OuvrirAlbum()
// ici on est authentifié; on ouvre un album
var $dataTexte : Text
var $sélection : Collection
// .paramsUrl[0] est l'ID de l'album
If (This.paramsUrl.length>0)
// lire les informations de l'album sélectionné
// adresse des données de l'album sur le site
This.rsc.SetVariable(Est Ressource ALB; "chemins/albums/URL"; Is text; ->$dataTexte)
Use (Session.storage.ALB_HTTPvars)
Session.storage.ALB_HTTPvars.wwwURLalbum:="/"+$dataTexte+"/"+This.paramsUrl[1]+"/"
End use
// récupérer les données de l'album
This.result.ErrorDescription:="ouverture de "+This.paramsUrl[0]+" : absence de catalogue"
$sélection:=Session.storage.ALB_UserParams.Albums.query("Identification_ID = :1"; This.paramsUrl[1])
Case of
: ($sélection=Null)
: ($sélection.length=0)
Else
Use (Session.storage.ALB_UserParams)
Session.storage.ALB_UserParams.Album:=$sélection[0]
End use
Use (Session.storage.ALB_HTTPvars)
// mémoriser le nombre de medias (sert dans la navigation)
Session.storage.ALB_HTTPvars.wwwNbrMedias:=$sélection[0].Medias.length
// initialiser la variable (mais on ne décide rien ici)
Session.storage.ALB_HTTPvars.wwwIndexMedia:="0"
End use
End case
// remarque : l'erreur est envoyée à l'hôte
// ouvrir l'album
This.Rediriger("/4DCGI"+Session.storage.ALB_Data.urlVisualiserALB)
Else
// retour à l'accueil
This.Rediriger("/4DCGI/Albums/seConnecter")
End if
Function VisualiserAlbum()
// ouvrir l'album initialisé par ailleurs
This.Envoyer(Session.storage.ALB_Data.pageVisuALB; "visualisationAlbum")
⇧
[class]_Trace - 29/05/2025 09:46:09
property cible : cs.xSDK.Traces
property success : Boolean
// propriétés spécifiques des functions appelantes
property Album : Object
property fichier : 4D.File
property resultat : Text
property params : Object
property racine : Text
singleton Class constructor()
This.cible:=cs.xSDK.Traces.new()
This.success:=False
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()
ErrorNum:=This.cible.Intercepter("ALB"; Error; Error method; Error line; Error formula)
Function Initialiser($nomMethode : Text)->$result : Object
This.cible.CréerErreur("ALB"; 0; $nomMethode; "")
$result:=This
Function Créer($Error : Integer; $nomMethode : Text; $ErrorDescription : Text)->$result : Object
This.cible.CréerErreur("ALB"; $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; "ALB"; $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; "ALB"; $libellé; $source; $description)
⇧
[class]$pageWebREQUETE - 20/01/2025 10:45:33
Class extends $pageWeb
Class constructor($url : Text)
Super($url)
// les paramètres sont récupérés
Function LireMedia()
var $path; $texte; $titre : Text
var $index; $largeur; $hauteur : Integer
// il faudrait tester le Type de media (image / video)
$index:=This.getIndexMedia()
// chemin du fichier media
$path:=This.getMediaData("nomFichier"; $index)
$path:=This.document.getWEBalbumMediasURL()+$path
$largeur:=Num(This.getMediaData("MED_DimensionX"; $index))
$hauteur:=Num(This.getMediaData("MED_DimensionY"; $index))
$titre:=This.getMediaData("MED_Nom"; $index)
$texte:="<a>"
$texte:=$texte+"<img src="+Char(Double quote)+$path+Char(Double quote)+" title="+Char(Double quote)+$titre+Char(Double quote)
// terminer la balise (format flex)
Case of
: ($largeur>=$hauteur)
$texte:=$texte+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: ($largeur<$hauteur)
$texte:=$texte+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$texte:=$texte+"</a>"
WEB SEND TEXT($texte; "texte/html")
Function LireMediaData()
// renvoyer la donnée du media
var $index : Integer
var $texte : Text
$index:=This.getIndexMedia()
$texte:=This.getMediaData(This.paramsUrl[1]; $index)
WEB SEND TEXT($texte; "texte/html")
Function LireMediaDate()
// renvoyer la date du media
var $index : Integer
var $texte : Text
$index:=This.getIndexMedia()
$texte:=This.getMediaData(This.paramsUrl[1]; $index)
$texte:=String(Date($texte); Internal date long)
WEB SEND TEXT($texte; "texte/html")
Function LireNumerotation()
var $texte : Text
$texte:=String(Num(This.paramsUrl[1])+1)+" / "+String(Session.storage.ALB_UserParams.Album.Medias.length)
WEB SEND TEXT($texte; "texte/html")
Function getMediaData($attribut : Text; $index : Integer)->$result : Text
// renvoyer la donnée du media
// attention on renvoie un texte ou un integer
var $variant : Variant
$result:="errMediaData"
Case of
: ($index<0)
: ($attribut="")
// il faut un nom de data
: (Not(OB Is defined(Session.storage.ALB_UserParams.Album.Medias[$index]; $attribut)))
Else
// c'est bon
$variant:=Session.storage.ALB_UserParams.Album.Medias[$index][$attribut]
If ((Value type($variant)=Is real) | (Value type($variant)=Is longint))
$result:=String($variant)
Else
$result:=$variant
End if
End case
Function getIndexMedia()->$result : Integer
// l'index est le dernier paramètre de l'url
$result:=-1
Case of
: (This.paramsUrl.length<1)
// il faut au moins 2 params
: (Num(This.paramsUrl[This.paramsUrl.length-1])>Session.storage.ALB_UserParams.Album.Medias.length)
Else
$result:=Num(This.paramsUrl[This.paramsUrl.length-1])
End case
⇧
[class]_sauvegarde - 22/10/2025 11:04:05
Class extends _albums
Class constructor()
Super()
Function Démarrer($params : Object)
// sauvegarder toutes les albums sur les disques désignés dans les préférences
var $numProgress; $i : Integer
var $pict : Picture
This.params.userIDfamille:=-1
// lister les albums
This.ListerAlbums()
// c'est parti pour une sauvegarde
$numProgress:=Progress New
Progress SET WINDOW VISIBLE(False; 40; Screen height-200)
READ PICTURE FILE(Folder(fk resources folder).folder("images").file("16005.gif").platformPath; $pict)
Progress SET ICON($numProgress; $pict)
Progress SET WINDOW VISIBLE(True; -1; -1; True)
Case of
: (Not(OB Is defined($params; "chemin")))
// il faut un chemin de disque !
: (Not(Folder($params.chemin; fk platform path).exists))
// disque de sauvegarde non monté, la BDD mère gère les erreurs
Progress SET TITLE($numProgress; Localized string("5115")+" '"+$params.chemin+"'"; 0; ""; False)
Waiting(60*10)
Else
// c'est ok, on a un dossier accessible
Progress SET TITLE($numProgress; Localized string("5116")+" '"+$params.chemin+"'"; 0; ""; False)
For ($i; 0; This.pathsAlbums.length-1)
Progress SET PROGRESS($numProgress; ($i)/This.pathsAlbums.length; Localized string("5132")+" '"+This.listeAlbums[$i]+"'"; True)
// créer le dossier de travail
This.CréerDossierDeTravail("ALB_sauvegarde_FTP")
This.SauvegarderAlbum(This.pathsAlbums[$i]; $params.chemin)
This.SupprimerDossierDeTravail()
End for
End case
Progress SET PROGRESS($numProgress; 1)
Waiting(60)
Progress QUIT($numProgress)
Function SauvegarderAlbum($url : Text; $cheminDossier : Text)
var $result; $data; $params : Object
var $i : Integer
// lister tous les documents de l'album
$data:=New object
$data.pathDossier:=$url
$data.pathsDocuments:=New collection
$data.listeDocuments:=New collection
$data.listeInfos:=New collection
// tous les documents de tous les dossiers
$data.Options:=0x0005
$result:=This.FTP.ListerLesDocuments($data)
Case of
: (Not($result.success))
: ($data.pathsDocuments.length=0)
: (Test path name($cheminDossier)#Is a folder)
Else
// on y va
$params:=New object
$params.dossier:=Folder($cheminDossier; fk platform path)
// au cas ou
$params.dossier.create()
For ($i; 0; $data.pathsDocuments.length-1)
$params.pathFichier:=$data.pathsDocuments[$i]
This.SauvegarderFichier($params; $data.listeInfos[$i])
End for
End case
Function SauvegarderFichier($params; $info : Object)
// créer / remplacer le fichier $url dans le dossier $dossier
// on remplace si le fichier a changé
var $fichier; $result : Object
var $c : Collection
var $nom : Text
$result:=New object
// nom / chemin du fichier
$c:=Split string($params.pathFichier; "/"; sk ignore empty strings)
// nom du fichier
$nom:=$c.pop()
// chemin du dossier du fichier
$fichier:=$params.dossier.folder($c.join("/"))
// au cas ou
$fichier.create()
// chemin du fichier
$fichier:=$fichier.file($nom)
$result.success:=True
Case of
// on n'a pas de dossier
: ($params.pathFichier="@ @")
// ici on n'aime pas les blancs (génère une erreur FTP)
$result.success:=False
: (Not($fichier.exists))
: ($fichier.modificationDate<$info.modificationDate)
: ($fichier.modificationDate>$info.modificationDate)
: ($fichier.modificationTime<$info.modificationTime)
Else
// fichier à jour
$result.success:=False
End case
If ($result.success)
// v10.6.12 : toujours télécharger en local puis copier sur le support externe
$params.cheminFichier:=This.dossierTravail.file("tempo_"+String(Random)).platformPath
$result:=This.FTP.TéléchargerFichier($params)
COPY DOCUMENT($params.cheminFichier; $fichier.platformPath)
End if
⇧
[class]$pageWebAlbum - 16/04/2025 19:11:59
Class extends $pageWebAlbums
Class constructor($url : Text)
Super($url)
// les paramètres sont récupérés
Function TraiterURL()->$result : cs._Trace
// traitement des url de la page albums
This.result.Initialiser(Current method name)
// 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
//----------------------------------
// MARK:Album
//----------------------------------
Function getInformation($attribut : Text)->$result : Text
// l'info peut ne pas exister !
$result:=""
Case of
: (Not(OB Is defined(Session.storage.ALB_UserParams; "Album")))
: (Not(OB Is defined(Session.storage.ALB_UserParams.Album; $attribut)))
Else
// renvoyer l'info
$result:=Session.storage.ALB_UserParams.Album[$attribut]
End case
//----------------------------------
// MARK:Element HTML
//----------------------------------
Function Information()
This.result.resultat:=""
Case of
: (This.paramsUrl.length<1)
Else
// renvoyer l'info
This.result.resultat:=This.getInformation(This.paramsUrl[1])
End case
This.result.resultat:=Char(1)+"<spam>"+This.result.resultat+"</spam>"
Function Contact()
This.result.resultat:=Char(1)+This.getContact(Session.storage.ALB_UserParams.Album)
Function Vignettes()
var $result; $url; $fichier; $texte : Text
var $mediaInformation : Object
var $i : Integer
// fixer l'URL du dossier des vignettes
$url:=This.document.getWEBalbumVignettesURL()
$result:=""
// // créer la page à partir du tableau NomsFichier
If (Session.storage.ALB_UserParams.Album.Medias.length>0)
// mettre les vignettes dans le flux HTML
For ($i; 1; Session.storage.ALB_UserParams.Album.Medias.length)
$mediaInformation:=Session.storage.ALB_UserParams.Album.Medias[$i-1]
$fichier:=$mediaInformation.nomFichier
$texte:=$mediaInformation["MED_Nom"]
// appel de la function javascript
// rappel : width et height sont fixés par CSS (nécessaire pour l'alignement des images)
$result:=$result+"<a onclick="+Char(Double quote)+"Visualiser('#openDiaporama','IndexMedia','"+String($i-1)+"')"+Char(Double quote)+">"
$result:=$result+"<img alt="+Char(Double quote)+$fichier+Char(Double quote)+" title="+Char(Double quote)+$texte+Char(Double quote)+" src="+Char(Double quote)+$url+This.fct.ConvertirPathVersURL($fichier; False; False; True)+Char(Double quote)
// terminer la balise (pour le format flex)
Case of
: ($mediaInformation["MED_DimensionX"]>=$mediaInformation["MED_DimensionY"])
$result:=$result+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: ($mediaInformation["MED_DimensionX"]<$mediaInformation["MED_DimensionY"])
$result:=$result+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$result:=$result+"</a>"
End for
End if
This.result.resultat:=Char(1)+$result
Function navDiaporama()
var $result; $dossier; $fichier; $texte : Text
var $mediaInformation : Object
var $i : Integer
// fixer l'URL du dossier des vignettes
$dossier:=This.document.getWEBalbumVignettesURL()
$result:=""
// créer le ruban de navigation
If (Session.storage.ALB_UserParams.Album.Medias.length>0)
$result:="<table><tbody><tr>"
// l'index varie entre 0 et taille - 1 (cf le traitement avascript)
For ($i; 1; Session.storage.ALB_UserParams.Album.Medias.length)
$mediaInformation:=Session.storage.ALB_UserParams.Album.Medias[$i-1]
$fichier:=$mediaInformation.nomFichier
$texte:=$mediaInformation["MED_Nom"]
$result:=$result+"<td><a onClick="+Char(Double quote)+"GotoMedia("+String($i-1)+")"+Char(Double quote)+">"
$result:=$result+"<img alt="+Char(Double quote)+$fichier+Char(Double quote)+" title="+Char(Double quote)+$texte+Char(Double quote)+" src="+Char(Double quote)+$dossier+This.fct.ConvertirPathVersURL($fichier; False; False; True)+Char(Double quote)
// terminer la balise (pour le format flex)
Case of
: ($mediaInformation["MED_DimensionX"]>=$mediaInformation["MED_DimensionY"])
$result:=$result+" width="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
: ($mediaInformation["MED_DimensionX"]<$mediaInformation["MED_DimensionY"])
$result:=$result+" height="+Char(Double quote)+"100%"+Char(Double quote)+"/>"
End case
$result:=$result+"</a>"
$result:=$result+"</td>"
End for
$result:=$result+"</tr></tbody></table>"
End if
This.result.resultat:=Char(1)+$result
⇧
[class]$albums - 20/02/2026 12:19:52
// points d'entrée base hote
Class constructor()
//---------------------
// MARK:Visualisations
//---------------------
Function ModifierVisualisations($params : Object)
var $result : cs._Trace
var $data : Object
var $numProc : Integer
// ici on est dans le process appelant
$result:=cs._Trace.me.Initialiser(Current method name)
$result.Error:=-15068
Case of
: (Not(OB Is defined($params; "Commande")))
$result.ErrorDescription:="Le paramètre 'Commande' est absent de $1"
: (Not(OB Is defined($params; "params")))
$result.ErrorDescription:="Le paramètre 'params' est absent de $1"
: (Not(OB Is defined($params.params; "userIDfamille")))
$result.ErrorDescription:="Le paramètre 'userIDfamille' est absent de $1.params"
: (Not(OB Is defined($params.params; "groupesFamiliaux")))
$result.ErrorDescription:="Le paramètre 'groupesFamiliaux' est absent de $1.params"
: (Not(OB Is defined($params.params; "CheminDossierFTP")))
$result.ErrorDescription:="Le paramètre 'CheminDossierFTP' est absent de $1.params"
Else
// c'est ok
$result.Error:=0
$data:=New object
$data.functionID:="_ModifierVisualisations_process"
$data.nomTache:="Visualisations"
$data.numProcessAppelant:=-1
$data.params:=$params
$numProc:=Exécuter Function Coopérative(cs.$albums; $data)
End case
$result.LeverException([msgk_event; msgk_log])
Function _ModifierVisualisations_process($params)
var $data : Object
// classe du Form :
$data:=cs[$params.params.Commande].new()
// récupérer les paramètres et méthodes hôte
$data.params:=$params.params
$data.$formulaire:=$params.$formulaire
// afficher le formulaire
$data.OuvrirFormulaire()
//---------------------
// MARK:Sauvegarde
//---------------------
Function DémarrerSauvegarde($params : Object)
cs._sauvegarde.new().Démarrer($params)
//---------------------
// MARK:Installation serveur Web
//---------------------
Function InstallerRessourcesSurServeur($dossierDestination : 4D.Folder)
// attention : function toujours appelée par le serveur Web concerné ; on doit donc recevoir le nom du serveur Web concerné
// => asynchrone de l'installation du composant lui-même
// placer les pages HTML et ressources Albums dans le dossier $dossierDestination du serveur $nomServeur
Case of
: (Not(Storage.System.estServeur))
// on n'est pas sur un serveur APP ou HTTP (4D serveur)
// filtrer ces contextes
: ($dossierDestination=Null)
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; "Installer Albums"; "InstallerRessourcesSurServeur [KO], le dossier d'installation est null")
: (Not($dossierDestination.exists))
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; "Installer Albums"; "InstallerRessourcesSurServeur [KO], le dossier d'installation '"+$dossierDestination.platformPath+"' n'existe pas")
Else
cs._Trace.me.EnvoyerMessages([msgk_event; msgk_log]; "Démarrage"; "Installer Albums"; "InstallerRessourcesSurServeur [OK] dans "+$dossierDestination.platformPath)
This.InstallerPagesDynamiques($dossierDestination)
This.InstallerRessources($dossierDestination)
End case
Function InstallerPagesDynamiques($dossierDestination : 4D.Folder)
var $c : Collection
var $fichier : Object
// Ajouter les pages dynamiques
$c:=Folder(fk resources folder).folder("TemplatesPagesWeb").files(fk ignore invisible)
For each ($fichier; $c)
COPY DOCUMENT($fichier.platformPath; $dossierDestination.platformPath; *)
End for each
Function InstallerRessources($dossierDestination : 4D.Folder)
var $dossier : Object
$dossier:=$dossierDestination.folder("ressourcesAlbums")
$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").platformPath; $dossier.platformPath; "js"; *)
⇧
[ ]U_Nav Albums - 01/12/2024 19:22:51
var $avancement : Integer
var $userMessageWnd : Text
Case of
: (Form event code=On Load)
Form.ListerAlbums()
// sélectionner le premier
Form.indexAlbum:=0
Form.OuvrirAlbum()
Form.InitFormulaire()
$avancement:=10
SET TIMER($avancement)
: (Form event code=On Timer) // MaJ des IHM
OBJECT SET VISIBLE(*; "AsynchroProgress"; Form.AsynchroProgress)
OBJECT SET VISIBLE(*; "avancement"; Form.AsynchroProgress)
If (Form.AsynchroProgress)
GOTO OBJECT(*; "EXIF_listeMedias")
GET PROCESS VARIABLE(Form.ProcInProgressNum; ProcInProgressEtat; $userMessageWnd; ProcInProgressTime; $avancement) //;ProcInProgressState;ProcInProgressState)
Form.userMessageWnd:=$userMessageWnd
Form.avancement:=$avancement
Else
Form.ProcInProgressNum:=-1
Form.userMessageWnd:=""
End if
Form.FixerNavigationClavier()
: (Form event code=On Getting Focus)
Form.saisieEnCours:=(OBJECT Get type(*; OBJECT Get name(Object with focus))=Object type text input)
: (Form event code=On Losing Focus)
Form.saisieEnCours:=False
: (Form event code=On Data Change)
Form.ModifierDonnée()
: (Form event code=On Unload)
// mémoriser les données
Form.FermerAlbum()
// on purge
CLEAR LIST(Form.listeMedias)
Else
End case
⇧
[ ]U_Nav Albums - objet grpBtnNavPreviousRecord - 18/11/2024 18:23:33
var $i : Integer
$i:=Selected list items(Form.listeMedias)
Form.rangMedia:=$i-(Num($i>1))
Form.AfficherMedia()
⇧
[ ]U_Nav Albums - objet grpBtnNavNextRecord - 18/11/2024 18:23:09
var $i : Integer
$i:=Selected list items(Form.listeMedias)
Form.rangMedia:=$i+Num($i<Count list items(Form.listeMedias))
Form.AfficherMedia()
⇧
[ ]U_Nav Albums - objet btnNavFirst - 06/05/2023 12:23:08
Form.rangMedia:=1
Form.AfficherMedia()
⇧
[ ]U_Nav Albums - objet btnNavLast - 06/05/2023 12:22:58
Form.rangMedia:=Count list items(Form.listeMedias)
Form.AfficherMedia()
⇧
[ ]U_Nav Albums - objet EXIF_listeMedias - 06/05/2023 12:28:11
Case of
: (Form event code=On Selection Change)
// récupérer le rang du média sélectionné
Form.rangMedia:=Selected list items(Form.listeMedias)
Form.AfficherMedia()
End case
⇧
[ ]U_Nav Albums - objet Sélection - 01/12/2024 19:24:12
Case of
: (Form event code=On Load)
// initialiser la liste
Form.selecteur:=New object
Form.selecteur.values:=New collection(OBJECT Get name(Object current))
Form.selecteur.index:=0
: (Form event code=On Data Change)
// changer d'album
Form.indexAlbum:=Form.selecteur.index
// forcer la mise à jour des medias de l'album ouvert
Form.FermerAlbum()
Form.OuvrirAlbum()
Form.InitFormulaire()
End case
⇧
[ ]U_Nav Albums - objet btnNavTrier - 06/05/2023 12:20:40
Form.ListerMedias()
⇧
[ ]U_Nav Albums - objet Domaine - 01/12/2024 19:51:35
Form.EditerRessourceComposant("ConnexionFTP/NomHost")
⇧
[ ]U_Nav Albums - objet Identifiant - 01/12/2024 19:54:27
Form.EditerRessourceComposant("ConnexionFTP/Identifiant")
⇧
[ ]U_Nav Albums - objet MotDePasse - 01/12/2024 19:54:22
Form.EditerRessourceComposant("ConnexionFTP/MotDePasse")
⇧
[ ]U_Nav Albums - objet hostURL - 01/12/2024 19:54:16
Form.EditerRessourceComposant("Hosting/URL")
⇧
[ ]U_Nav Albums - objet CheminFTP - 01/12/2024 19:54:08
Form.EditerRessourceComposant("chemins/FTP/Path")
⇧
[ ]Visualiser Album - 01/12/2024 19:12:27
// traitements génériques (traités par la base hôte)
Form.$formulaire.surEvenementFormulaire()
Case of
: (Form event code=On Load)
Form.ListerAlbums()
// sélectionner le premier
Form.indexAlbum:=0
: (Form event code=On Data Change)
// changer d'album
Form.indexAlbum:=Form.selecteur.index
End case
If ((Form event code=On Load) | (Form event code=On Data Change))
Form.OuvrirAlbum()
Form.InitFormulaire()
End if
⇧
[ ]Visualiser Album - objet Sélection - 01/12/2024 19:20:04
Case of
: (Form event code=On Load)
// initialiser la liste
Form.selecteur:=New object
Form.selecteur.values:=New collection(OBJECT Get name(Object current))
Form.selecteur.index:=0
End case
⇧
[ ]Visualiser Album - objet btnNavPreviousRecord - 03/05/2023 11:32:04
Form.MediaPrécédent()
⇧
[ ]Visualiser Album - objet btnNavNextRecord - 30/11/2023 14:55:48
Form.MediaSuivant()
⇧
[ ]Visualiser Album - objet btnNavFirst - 03/05/2023 11:31:31
Form.PremierMedia()
⇧
[ ]Visualiser Album - objet btnNavLast - 03/05/2023 11:31:55
Form.DernierMedia()
⇧
onStartup - 29/03/2025 17:14:17
// ne s'exécute pas dans une base hôte
ON ERR CALL(Formula(traceHandler).source; ek global)
cs._composant.new().InitVariablesALB()
// pour les tests hors base hôte, créer le worker de services (utile pour des process thread-safe)
CALL WORKER("WK_Composant_ALB"; Formula(InitProcess).source)
⇧
onExit - 01/04/2025 19:35:06
// 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 - 17/11/2024 12:50:29
Pas de code
⇧
onWebAuthentication - 17/11/2024 12:49:44
Pas de code
⇧
onSystemEvent - 07/12/2021 18:01:34
Pas de code
⇧
onHostDatabaseEvent - 06/02/2026 17:48:06
#DECLARE($numFormEvent : Integer)
// Méthode base sur événement base hôte
Case of
: ($numFormEvent=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().InitVariablesALB()
Use (Storage.System)
Storage.System.estExecuteDansHote:=True
End use
// déactiver les ASSERT si le composant est compilé (réactivable avec le bit 6 de <>composantStatus)
SET ASSERT ENABLED(Not(Is compiled mode))
CALL WORKER("WK_Composant_ALB"; Formula(InitProcess).source)
// remarque : le worker WK_services existe dans la base hôte
: ($numFormEvent=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()
: ($numFormEvent=On before host database exit)
// placer ici le code à exécuter avant le "Sur fermeture" de la base hôte
If (Storage.System.estServeur)
cs._maintenance.new().Arrêter()
End if
: ($numFormEvent=On after host database exit)
// placer ici le code à exécuter après le "Sur fermeture" de la base hôte
End case