Je suis de ceux qui sont lassés des pages d'accueil de navigateur qui nous présentent la météo et les dernières avanies de la starlette du moment au milieu d'un torrent de publicités pour des remèdes contre les hémorroïdes ou la chute des cheveux …
En outre, le contenu actif de ce type de page se paie cher en terme de temps d'affichage quand on ne dispose pas d'un très haut débit.
Alors, j'ai décidé de me faire ma page d'accueil "à moi", statique et rapide, avec les liens qui m'intéressent vraiment.
Tout "gratter" en html avec Notepad++ m'a pris un certain temps …, mais ça a marché.
Pour vous éviter un pareil labeur, jai donc rédigé un programme en PureBasic qui génère la page d'accueil html en y intégrant les liens que vous jugez utiles.
Une fois la page générée, il suffit de l'enregistrer sur le PC et d'indiquer son adresse à votre navigateur favori dans l'option "page de démarrage".
Sur le plan de la programmation, outre PureBasic, ce projet est assez didactique, car il mêle du code html et des requêtes vers une base de données SQLITE.
Un essai vaut sans doute mieux qu'un long discours.
Après réflexion, je me suis rendu compte que mon envoi initial n'était qu'un infâme brouillon :
- Pas de documentation ou d'aide explicite au cours du programme ;
- Ma page d'exemple avec une requête SQL à lancer soi-même, pas top !
- Oubli de préciser que SQLITE3 est nécessaire au fonctinnement ;
… plus deux ou trois bogues ça et là.
Voici donc une nouvelle version qui ne nécessite plus une requête SQL externe (elle figure en DataSection en fin de source).
Addendum :
Le programme a été testé sous win10, et il devrait être opérationnel avec les versions précédentes de cet environnement, sous réserve de la possibilité d'y installer Sqlite3, le gestionnaire de Base de Données.
Une version adaptée à Linux est en gestation, pour peu que mes activités de fraîchement retraité m'en laissent le loisir …
Le programme principal :
Code : Tout sélectionner
; -------------------------------------------------
; G E N H E L L O
; Générateur de Page d'Accueil pour Navigateur web
; -------------------------------------------------
;
Procedure.s _RepeteChaine(car$=" ",nb.i=1) ; Fabrique une chaîne contenant <nb> fois la chaîne passée en premier paramètre.
Res$="" : For k=1 To nb : Res$+car$ : Next k
ProcedureReturn Res$
EndProcedure
Procedure Afficheinfo() ; Utilisée pour fabriquer les messages affichés dans les fenêtres d'aide (texte en DataSection).
Tit$="" : Msg$=""
Read.s x$
While x$<>"<EOD>"
If Tit$=""
Tit$=x$
Else
If Msg$<>"" : Msg$+#CR$ : EndIf
Msg$+x$
EndIf
Read.s x$
Wend
MessageRequester(Tit$,Msg$,#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndProcedure
Procedure DeclarVar() ; Déclare les variables GLOBALES utilisées dans le corps du programme.
Global$ ResSQL$="" ; Contient le résultat (lignes séparées par <RC>) de la dernière requête SQL exécutée sur la BDD GenHello.sq3.
Global$ VarPage$="" ; Contient les valeurs (séparées par tabulation) du dernier enregistrement lu dans la Table <Pages> de la BDD GenHello.sq3.
Global$ VarLien$="" ; Contient les valeurs (séparées par tabulation) du dernier enregistrement lu dans la Table <Liens> de la BDD GenHello.sq3.
Global$ Req$="" ; Contient le texte de la requête SQL qui sera soumise au SGBD.
Global$ HTM$="" ; Contient le texte du fichier HTML résultat du programme ; il est construit à partir d'un en-tête(heading), d'un corps(body) et d'un en-pied(footing).
Global EntHTM$="" ; Contient l'en-tête du fichier HTML ; il définit notamment les styles utilisés dans le reste du document.
Global$ VarForm$="" ; Contenu de la balise <FORM> … </FORM> utilisée pour générer un lien hypertexte appelé par un Bouton.
Global$ PathFic$="", NomFic$="", ExtFic$="" ; Chemin, Nom de fichier et extension des fichiers externes utilisés.
Global.i PageAct=0, LienAct=0 ; IDs de la Page et du Lien en cours de traitement par le programme.
Global PosH.i=0 , PosV.i=0 ; Positions horizontale et verticale des gadgets utilisés dans les descriptions de fenêtre.
Global.i PolSaisie=0, PolTitre=0 ; Polices utilisées dans les gadgets (cf procedure InitPol).
Global.i FenPrinc=0, FenPage=100, FenLien=200, FenRubriques=300 ; ID des fenêtres du programme.
Global$ NomFenP$="GenHello", NomFenPg$="Page", NomFenL$="Lien", NomFenR$="Rubriques" ; Nom des Fenêtres du programme.
Global.i LargFenP=1125, HautFenP=960 ; dimensions de la fenêtre principale.
Global.i LargFenPg=400, HautFenPg=200 ; dimensions de la fenêtre <Page>.
Global.i LargFenL=500, HautFenL=400 ; dimensions de la fenêtre <Lien>.
Global.i LargFenR=480, HautFenR=500 ; dimensions de la fenêtre <Rubrique>.
Global.i i=0 ; Variable entière "à tout faire" utilisée dans les boucles.
Global$ x$="" ; Variable chaîne "à tout faire" utilisée un peu partout !
EndProcedure ;
; Chargement des Procédures de gestion de la Base de Données
IncludeFile("GestBDD.pb")
;
Procedure EcritHtm()
; ====================================
; Ecriture du Fichier HTML de la Page
; ====================================
NomFicHTM$=PathFic$+NomFic$+".htm"
If CreateFile(0, NomFicHTM$,#PB_File_NoBuffering | #PB_UTF8)
WriteStringN(0,HTM$)
CloseFile(0)
Else
MessageRequester("Information","Impossible de créer le fichier!")
EndIf
EndProcedure
Procedure ExplodePath(NF$="") ; Récupère dans 3 variables le chemin, le nom et l'extension d'un fichier.
PathFic$=GetPathPart(NF$) : NomFic$=GetFilePart(NF$,#PB_FileSystem_NoExtension) : ExtFic$=UCase(GetExtensionPart(NF$))
EndProcedure
Procedure.s FindExe(Exe$="") ; Recherche sur les Lecteurs du PC (C:\, D:\, E:\, F:\) le chemin de l'appli SQLITE3.EXE.
; Cette appli est requise pour générer le fichier Exemple lors de la première utilisation de GenHello ou en cas de suppression du fichier GenHello.sq3.
RepSQ3$=""
Lecteurs$="C:\"+#TAB$+"D:\"+#TAB$+"E:\"+#TAB$+"F:\"
For NumDisk=1 To 4
Disk$=StringField(Lecteurs$,NumDisk,#TAB$)
Cmd$="@ECHO Recherche dans le disque "+Disk$
Cmd$+Chr(13)+Chr(10)+"@ECHO =================================="
Cmd$+Chr(13)+Chr(10)+"DIR "+Disk$+Exe$+~".exe /s | find \"pertoire de \" > FindExe.TXT" ; Changer le motif si votre PC n'est pas en version française !
If OpenFile(0,GetCurrentDirectory()+"FindExe.bat",#PB_Ascii)
WriteStringN(0,Cmd$)
CloseFile(0)
Execution=RunProgram(GetCurrentDirectory()+"FindExe.bat"," ",GetCurrentDirectory(),#PB_Program_Wait)
If ReadFile(0,GetCurrentDirectory()+"FindExe.TXT")
While Eof(0) = 0 And RepSQ3$=""
RepSQ3$=ReadString(0)
RepSQ3$=StringField(RepSQ3$,2,"pertoire de") ; Changer le motif si votre PC n'est pas en version française !
Wend
CloseFile(0)
EndIf
EndIf
If RepSQ3$<>"" : Break : EndIf
Next NumDisk
ProcedureReturn RepSQ3$
EndProcedure
Procedure$ FormatLib(VarIn$="",Saut$="<br />") ; Formate le libellé des Boutons pour éviter une trop grande largeur.
VarOut$="" : Ligne$=""
Lig$=ReplaceString(VarIn$," "," ") : ; suppression des espaces multiples
j=1 : Mot$=StringField(Lig$,j," ")
While Mot$<>""
If (Len(Ligne$)+Len(Mot$))<10
If Ligne$<>"" : Ligne$+" " : EndIf
Ligne$+Mot$
Else
If VarOut$<>"" : VarOut$+Saut$ : EndIf
VarOut$+Ligne$ : Ligne$=Mot$
EndIf
j+1 : Mot$=StringField(Lig$,j," ")
Wend
If VarOut$<>"" : VarOut$+Saut$ : EndIf
VarOut$+Ligne$
ProcedureReturn VarOut$
EndProcedure
Procedure GenComboRub() ; Garnit (ou rafraîchit) la ComboBox des Rubriques disponibles (cf. procédure ModifLien).
ClearGadgetItems(207)
LitTable("Rubriques","ORDER BY ID")
j=-1 : i=1 : x$=Trim(StringField(ResSQL$,i,#CR$),#TAB$) : y$=Trim(StringField(VarLien$,3,#TAB$)," ")
While x$<>""
AddGadgetItem(207,-1,x$)
If y$=x$ : j=i-1 : EndIf
i+1 : x$=Trim(StringField(ResSQL$,i,#CR$),#TAB$)
Wend
SetGadgetState(207,j)
EndProcedure
Procedure RefreshRub()
ClearGadgetItems(303)
Req$="SELECT ID, (SELECT COUNT(*) FROM Liens WHERE Liens.IDRubrique=Rubriques.ID) AS 'Utilisations' FROM Rubriques ORDER BY ID"
LitSQL(Req$)
i=1 : x$=StringField(ResSQL$,i,#CR$)
While x$<>""
AddGadgetItem(303,-1,ReplaceString(x$,#TAB$,Chr(10)))
i+1 : x$=StringField(ResSQL$,i,#CR$)
Wend
AddGadgetItem(303,-1,"~Nouvelle~"+Chr(10)+"Zéro")
EndProcedure
Procedure GereRubriques() ; Fenêtre de gestion des Rubriques utilisables.
If OpenWindow(FenRubriques, 0, 0, LargFenR, HautFenR, NomFenR$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
PosH=5 : PosV=5 : TextGadget (301, PosH, PosV, LargFenR-10, 20, "Modification de Rubriques",#PB_Text_Center) : SetGadgetColor(301,#PB_Gadget_BackColor, $A0FFFF) : SetGadgetFont(301,PolTitre)
PosH=5 : PosV+30 : ButtonGadget(302, PosH, PosV, LargFenR-10, 30, "Recommandations IMPORTANTES", #PB_Text_Center)
PosH=5 : PosV+30 : ListIconGadget(303,PosH,PosV, LargFenR-10, HautFenR-117, "--- Rubriques ----",LargFenR-125,#PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
AddGadgetColumn(303, 1, "Utilisations" , 90)
RefreshRub()
NbLig=CountGadgetItems(303)
SetGadgetState(303,NbLig-1)
PosV=HautFenr-30 : PosH=(LargFenR/4)-35 : ButtonGadget(331, PosH,PosV, 70, 25, "Modifier")
PosH=(LargFenR/4)*2-35 : ButtonGadget(332, PosH,PosV, 70, 25, "Supprimer")
PosH=(LargFenR/4)*3-35 : ButtonGadget(333, PosH,PosV, 70, 25, "Terminé")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 302 : Restore AideRubriques : Afficheinfo()
Case 331
LigSel=GetGadgetState(303)
If LigSel>=0
LibAct$=GetGadgetItemText(303,LigSel,0)
x$=InputRequester("Modif Libellé de Rubrique", "(un Libellé VIDE annule la modification)", LibAct$)
x$=ReplaceString(x$," "," ") : x$=Trim(x$)
If x$<>""
If x$<>LibAct$
If LibAct$="~Nouvelle~"
Req$="INSERT INTO Rubriques (ID) VALUES ('"+x$+"')": MajSQL(Req$)
Else
Req$="UPDATE Rubriques SET ID='"+x$+"' WHERE ID = '"+LibAct$+"'" : MajSQL(Req$)
Req$="UPDATE Liens SET IDRubrique='"+x$+"' WHERE IDRubrique = '"+LibAct$+"'" : MajSQL(Req$)
EndIf
RefreshRub()
EndIf
EndIf
EndIf
Case 332
LigSel=GetGadgetState(303)
If LigSel>=0
LibAct$=GetGadgetItemText(303,LigSel,0) : NbUtil=Val(GetGadgetItemText(303,LigSel,1))
If LibAct$<>"~Nouvelle~" And NbUtil=0
If MessageRequester("ATTENTION","Vous CONFIRMEZ la SUPPRESSION de la Rubrique "+LibAct$+" ?",#PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_Yes
Req$="DELETE FROM Rubriques WHERE ID='"+LibAct$+"'"
MajSQL(Req$)
Else
MessageRequester("Opération Annulée","Suppression Abandonnée",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
RefreshRub()
Else
MessageRequester("Erreur","On ne peut supprimer une Rubrique actuellement utilisée ou <~Nouvelle~>",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndIf
Case 333 : Event = #PB_Event_CloseWindow
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CloseWindow(FenRubriques)
EndIf
EndProcedure
Procedure.i Htm2PbColor(cHTM$="") ; Convertit une couleur HTML (chaîne Hexa) en une couleur PureBasic (entier).
c=Val("$"+cHTM$)
Res=Val("$"+RSet(Hex(Red(c)),2,"0")+RSet(Hex(Green(c)),2,"0")+RSet(Hex(Blue(c)),2,"0"))
ProcedureReturn Res
EndProcedure
Procedure$ InitHtm() ; Crée la partie en-tête du document final
EntHTM$=~"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">"
EntHTM$+#CR$+~"<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"fr\">"
EntHTM$+#CR$+#TAB$+~"<head>"
EntHTM$+#CR$+_RepeteChaine(#TAB$,2)+~"<title>Menu Web</title>"
EntHTM$+#CR$+_RepeteChaine(#TAB$,2)+~"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\" />"
EntHTM$+#CR$+_RepeteChaine(#TAB$,2)+~"<meta name=\"author\" content=\"PK1157\">"
EntHTM$+#CR$+_RepeteChaine(#TAB$,2)+~"<style type=\"text/css\">"
EntHTM$+#CR$+_RepeteChaine(#TAB$,3)+~"h1 {text-align: center ;}"
EntHTM$+#CR$+_RepeteChaine(#TAB$,3)+~"table {white-space: nowrap ; width: 100% ; max-width: 1600px ; font-size : normal ; text-align :center ; vertical-align: middle ; border: 1px solid black ;}"
EntHTM$+#CR$+_RepeteChaine(#TAB$,3)+~"td {white-space: nowrap ; font-size: normal ; text-align: center ; vertical-align: middle ; border: 1px solid black ;}"
EntHTM$+#CR$+_RepeteChaine(#TAB$,3)+~"form {margin: auto ;}"
EntHTM$+#CR$+_RepeteChaine(#TAB$,3)+~"input {font-size: 100% ;}"
EntHTM$+#CR$+_RepeteChaine(#TAB$,2)+~"</style>"
EntHTM$+#CR$+#TAB$+~"</head>"
EntHTM$+#CR$+#TAB$+~"<body>"
CorpsHTM$=_RepeteChaine(#TAB$,2)+~"<h1><u>Menu Web</u></h1>"
PiedHTM$=#TAB$+~"</body>"+#CR$+~"</html>"
EndProcedure
Procedure InitPol() ; Polices utilisées par les fenêtres du programme
Fonte$="Liberation Sans Narrow" : If LoadFont(1, Fonte$, 11) : PolSaisie=FontID(1) : SetGadgetFont(#PB_Default, FontID(1)) : EndIf
Fonte$="Liberation Sans" : If LoadFont(2, Fonte$, 12,#PB_Font_Bold|#PB_Font_Italic) : PolTitre=FontID(2) : EndIf
EndProcedure
Procedure.s Pb2HtmColor(cPB.i=0) ; Convertit une couleur PureBasic (entier) en une couleur HTML (chaîne Hexa).
Res$=RSet(Hex(Red(cPB)),2,"0")+RSet(Hex(Green(cPB)),2,"0")+RSet(Hex(Blue(cPB)),2,"0")
ProcedureReturn Res$
EndProcedure
Procedure.i ProdCoulTxt(CoulFond$="FFFFFF") ; Détermine la couleur du Texte en fonction de la valeur calculée de la luminosité de la couleur de fond.
c.i=Val("$"+CoulFond$)
If ((Red(c)*299 + Green(c)*587 + Blue(c)*114)/1000)<125
CoulRes=RGB(255,239,191)
Else
CoulRes=RGB(95,15,0)
EndIf
ProcedureReturn CoulRes
EndProcedure
Procedure RemplitTable(NomTb$)
NumTb=0 : NbLig=0 : Sel$=""
Select NomTb$
Case "Pages"
NumTb=20
Case "Liens"
NumTb=30 : Sel$="WHERE IDPage="+PageAct+" ORDER BY IDRubrique, ID"
EndSelect
If NumTb>0
ClearGadgetItems(NumTb)
LitTable(NomTb$,Sel$)
i=1 : x$=StringField(ResSQL$,i,#CR$)
While x$<>""
AddGadgetItem(NumTb,-1,ReplaceString(x$,#TAB$,Chr(10)))
i+1 : x$=StringField(ResSQL$,i,#CR$)
Wend
NbLig=CountGadgetItems(NumTb)
SetGadgetState(NumTb,NbLig-1)
EndIf
Select NomTb$
Case "Pages"
For i=0 To CountGadgetItems(20)-1
c$=GetGadgetItemText(20,i,3) : SetGadgetItemColor(20,i,#PB_Gadget_BackColor,Htm2PbColor(c$),3)
SetGadgetItemColor(20,i,#PB_Gadget_FrontColor,ProdCoulTxt(c$),3)
Next i
PageAct=Val(GetGadgetItemText(20,GetGadgetState(20),0))
RemplitTable("Liens")
Case "Liens"
LienAct=Val(GetGadgetItemText(30,GetGadgetState(30),0))
EndSelect
EndProcedure
Procedure DuplicLien() ; Duplique le Lien sélectionné ; le nouveau Lien peut être modifié à loisir.
If PageAct>1
PageNouv=0
Req$="INSERT INTO Liens (IDPage, IDRubrique, Nom, URL, ParamGet, Bouton, InfoLogin, InfoPwd, Identifiant, MotDePasse)"
Req$+" SELECT IDPage, IDRubrique, Nom, URL, ParamGet, Bouton, InfoLogin, InfoPwd, Identifiant, MotDePasse FROM Liens WHERE ID="+LienAct
MajSQL(Req$)
RemplitTable("Liens")
Else
MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndProcedure
Procedure DuplicPage() ; Duplique la Page en cours et les Liens qui la composent ; idéal pour fabriquer une nouvelle page sans partir de zéro !
PageNouv=0
Req$="INSERT INTO Pages (Nom, Utilisateur) SELECT Nom, Utilisateur FROM Pages WHERE ID="+PageAct : MajSQL(Req$)
Req$="SELECT MAX(ID) FROM Pages" : LitSQL(Req$) : PageNouv=Val(ResSQL$)
Req$="INSERT INTO Liens (IDPage, IDRubrique, Nom, URL, ParamGet, Bouton, InfoLogin, InfoPwd, Identifiant, MotDePasse)"
Req$+" SELECT "+PageNouv+", IDRubrique, Nom, URL, ParamGet, Bouton, InfoLogin, InfoPwd, Identifiant, MotDePasse FROM Liens WHERE IDPage="+PageAct
MajSQL(Req$)
RemplitTable("Pages")
EndProcedure
Procedure ModifLien() ; Ouverture d'une fenêtre de mise à jour du Lien en cours.
If PageAct>1
VarLien$=LitFiche("Liens","WHERE ID="+LienAct)
If OpenWindow(FenLien, 0, 0, LargFenL, HautFenL, NomFenL$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
PosH=5 : PosV=5 : TextGadget (201, PosH, PosV, LargFenL-10, 20, "Modification de Lien",#PB_Text_Center) : SetGadgetColor(201,#PB_Gadget_BackColor, $A0FFFF) : SetGadgetFont(201,PolTitre)
PosH=5 : PosV+30 : TextGadget(202,PosH, PosV,65,20,"ID Lien :") : SetGadgetColor(202,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(203,PosH, PosV,65,20,StringField(VarLien$,1,#TAB$),#PB_String_ReadOnly)
GadgetToolTip(203,"Non Modifiable, géré par le SGBD")
PosH=5 : PosV+30 : TextGadget(204,PosH, PosV,65,20,"ID Page :") : SetGadgetColor(204,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(205,PosH, PosV,65,20,StringField(VarLien$,2,#TAB$),#PB_String_ReadOnly)
GadgetToolTip(205,"Non Modifiable, géré par le SGBD")
PosH=5 : PosV+30 : TextGadget(206,PosH, PosV,65,20,"Rubrique :") : SetGadgetColor(206,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : ComboBoxGadget(207,PosH, PosV,LargFenL-posh-40,20,#PB_ComboBox_Editable)
GadgetToolTip(207,"(Bouton [*] pour Ajouter, Modifier ou Supprimer une nouvelle Rubrique)") : GenComboRub()
PosH=LargFenL-35 : ButtonGadget(208, PosH, PosV-5, 30, 30, "*")
PosH=5 : PosV+30 : TextGadget(209,PosH,PosV,65,20,"Nom Lien :") : SetGadgetColor(209,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(210,PosH,PosV,LargFenL-posh-40,20,StringField(VarLien$,4,#TAB$))
GadgetToolTip(210,"Nom d'usage : Google, Youtube, etc., sans le www ou http.")
PosH=5 : PosV+30 : TextGadget(211,PosH,PosV,65,20,"URL :") : SetGadgetColor(211,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(212,PosH,PosV,LargFenL-posh-40,20,StringField(VarLien$,5,#TAB$))
PosH=LargFenL-35 : ButtonGadget(213, PosH, PosV-5, 30, 30, "?")
GadgetToolTip(212,"Cliquer sur le bouton [?] à droite pour l'aide sur URL.")
PosH=5 : PosV+30 : TextGadget(214,PosH,PosV,65,20,"ParamGet :") : SetGadgetColor(214,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(215,PosH,PosV,LargFenL-posh-40,20,StringField(VarLien$,6,#TAB$))
PosH=LargFenL-35 : ButtonGadget(216, PosH,PosV-5, 30, 30, "?")
GadgetToolTip(215,"Cliquer sur le bouton [?] à droite pour l'aide sur ParamGet.")
PosH=5 : PosV+30 : TextGadget(217, PosH,PosV, 65, 20, "Bouton :") : SetGadgetColor(217,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : CheckBoxGadget(218, PosH,PosV, LargFenL-PosH-5, 20, "(Afficher un Bouton au lieu d'un Lien Hypertexte standard)") : SetGadgetState(218, Val(StringField(VarLien$,7,#TAB$)))
PosH=5 : PosV+30 : TextGadget(219, PosH,PosV, 65, 20, "InfoLogin :") : SetGadgetColor(219,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : CheckBoxGadget(220, PosH,PosV, LargFenL-PosH-5, 20, "(Cocher pour afficher une Infobulle de l'Identifiant)") : SetGadgetState(220, Val(StringField(VarLien$,8,#TAB$)))
PosH=5 : PosV+30 : TextGadget(221, PosH,PosV, 65, 20, "InfoPwd :") : SetGadgetColor(221,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : CheckBoxGadget(222, PosH,PosV, LargFenL-PosH-5, 20, "(Cocher pour afficher une Infobulle du Mot de Passe)") : SetGadgetState(222, Val(StringField(VarLien$,9,#TAB$)))
PosH=5 : PosV+30 : TextGadget(223, PosH,PosV, 65, 20, "Login :") : SetGadgetColor(223,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(224,PosH,PosV,LargFenL-posh-40,20,StringField(VarLien$,10,#TAB$))
GadgetToolTip(224,"Ce n'est pas très prudent de laisser cette info en clair …")
PosH=5 : PosV+30 : TextGadget(225, PosH,PosV, 65, 20, "PassWd :") : SetGadgetColor(225,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(226,PosH,PosV,LargFenL-posh-40,20,StringField(VarLien$,10,#TAB$))
GadgetToolTip(226,"C'est très imprudent de laisser cette info en clair …")
PosH=LargFenL/5-40 : PosV=HautFenL-30 : ButtonGadget(230, PosH,PosV, 80, 25, "Valider")
PosH=LargFenL/5*4-40 : ButtonGadget(231, PosH,PosV, 80, 25, "Annuler")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 208
GereRubriques() : GenComboRub()
Case 213
Restore AideURL : AfficheInfo()
Case 216
Restore AideParamGET : AfficheInfo()
Case 230
VarLien$=GetGadgetText(203)+#TAB$+GetGadgetText(205)+#TAB$+GetGadgetText(207)+#TAB$+GetGadgetText(210)+#TAB$+GetGadgetText(212)+#TAB$+GetGadgetText(215)
VarLien$+#TAB$+GetGadgetState(218)+#TAB$+GetGadgetState(220)+#TAB$+GetGadgetState(222)+#TAB$+GetGadgetText(224)+#TAB$+GetGadgetText(226)
If StringField(VarLien$,3,#TAB$)<>"" And StringField(VarLien$,4,#TAB$)<>"" And StringField(VarLien$,5,#TAB$)<>""
Req$="UPDATE Liens SET IDPage='"+StringField(VarLien$,2,#TAB$)+"', IDRubrique='"+StringField(VarLien$,3,#TAB$)+"'"
Req$+", Nom='"+StringField(VarLien$,4,#TAB$)+"', URL='"+StringField(VarLien$,5,#TAB$)+"'"
Req$+", ParamGet='"+StringField(VarLien$,6,#TAB$)+"', Bouton='"+StringField(VarLien$,7,#TAB$)+"'"
Req$+", Infologin='"+StringField(VarLien$,8,#TAB$)+"', InfoPwd='"+StringField(VarLien$,9,#TAB$)+"'"
Req$+", Identifiant='"+StringField(VarLien$,10,#TAB$)+"', MotDePasse='"+StringField(VarLien$,11,#TAB$)+"'"
Req$+" WHERE ID="+StringField(VarLien$,1,#TAB$)
MajSQL(Req$)
RemplitTable("Pages")
Event = #PB_Event_CloseWindow
Else
MessageRequester("Données Incomplètes","La Rubrique, le Nom et l'URL DOIVENT être renseignés.",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
Case 231
Event = #PB_Event_CloseWindow
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CloseWindow(FenLien)
EndIf
Else
MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndProcedure
Procedure ModifPage() ; Ouverture d'une fenêtre de mise à jour de la Page en cours.
VarPage$=LitFiche("Pages","WHERE ID="+PageAct)
If PageAct>1
If OpenWindow(FenPage, 0, 0, LargFenPg, HautFenPg, NomFenPg$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
PosH=5 : PosV=5 : TextGadget (101, PosH, PosV, LargFenPg-10, 20, "Modification de Page d'Accueil",#PB_Text_Center) : SetGadgetColor(101,#PB_Gadget_BackColor, $A0FFFF) : SetGadgetFont(101,PolTitre)
PosH=5 : PosV+30 : TextGadget(102,PosH,PosV,65,20,"ID Page : ") : SetGadgetColor(2,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(103,PosH,PosV,65,20,StringField(VarPage$,1,#TAB$),#PB_String_ReadOnly) : GadgetToolTip(103,"Non Modifiable, géré par le SGBD")
PosH=5 : PosV+30 : TextGadget(104,PosH,PosV,65,20,"Nom Page : ") : SetGadgetColor(104,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(105,PosH,PosV,LargFenPg-PosH-5,20,StringField(VarPage$,2,#TAB$)) : GadgetToolTip(105,"Hello, Bonjour ou Accueil sont très bien ...")
PosH=5 : PosV+30 : TextGadget(106,PosH,PosV,65,20,"Utilisateur : ") : SetGadgetColor(106,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(107,PosH,PosV,LargFenPg-PosH-5,20,StringField(VarPage$,3,#TAB$)) : GadgetToolTip(107,"Moi ou le nom de l'ami(e) qui en utilisera le résultat (la page HTML).")
c$=StringField(VarPage$,4,#TAB$) : c=Htm2PbColor(c$)
PosH=5 : PosV+30 : TextGadget(108,PosH,PosV,65,20,"Fond : ") : SetGadgetColor(108,#PB_Gadget_BackColor, $A0FFA0)
PosH=75 : StringGadget(109,PosH,PosV,80,20,c$,#PB_String_ReadOnly) : SetGadgetColor(109,#PB_Gadget_BackColor, Htm2PbColor(c$)) : SetGadgetColor(109,#PB_Gadget_FrontColor,ProdCoulTxt(c$)) : GadgetToolTip(109,"Utiliser le bouton <Changer> pour choisir la couleur.")
PosH=160 : ButtonGadget(110, PosH, PosV-5, 80, 30, "Changer")
PosH=LargFenPg/5-40 : PosV=HautFenPg-30 : ButtonGadget(111, PosH, PosV, 80, 20, "Valider")
PosH=LargFenPg/5*4-40 : ButtonGadget(112, PosH, PosV, 80, 20, "Annuler")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
Case 110
c=ColorRequester(c)
If c>=0
c$=Pb2HtmColor(c) : SetGadgetText(109,Pb2HtmColor(c)) : SetGadgetColor(109,#PB_Gadget_BackColor, Htm2PbColor(c$)) : SetGadgetColor(109,#PB_Gadget_FrontColor,ProdCoulTxt(c$))
EndIf
Case 111
VarPage$=GetGadgetText(103)+#TAB$+GetGadgetText(105)+#TAB$+GetGadgetText(107)+#TAB$+GetGadgetText(109)
Req$="UPDATE Pages SET Nom='"+StringField(VarPage$,2,#TAB$)+"', Utilisateur='"+StringField(VarPage$,3,#TAB$)+"', Fond='"+StringField(VarPage$,4,#TAB$)+"' WHERE ID="+PageAct
MajSQL(Req$)
RemplitTable("Pages")
Event = #PB_Event_CloseWindow
Case 112 : Event = #PB_Event_CloseWindow
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CloseWindow(FenPage)
EndIf
Else
MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndProcedure
Procedure NouvLien() ; Crée un nouveau Lien dans la Page en cours.
Req$="INSERT INTO Liens (IDPage) SELECT '"+PageAct+"'" : MajSQL(Req$)
RemplitTable("Liens")
EndProcedure
Procedure NouvPage() ; Crée une nouvelle Page (vide de Liens).
Req$="INSERT INTO Pages (Nom, Utilisateur) SELECT 'Hello', 'Inconnu'" : MajSQL(Req$)
RemplitTable("Pages")
EndProcedure
Procedure SupprLien() ; Suppression du Lien en cours !
If MessageRequester("ATTENTION","Vous CONFIRMEZ la SUPPRESSION du Lien "+LienAct+" ?",#PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_Yes
Req$="DELETE FROM Liens WHERE ID="+LienAct
MajSQL(Req$)
RemplitTable("Liens")
Else
MessageRequester("Opération Annulée","Suppression Abandonnée",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndProcedure
Procedure SupprPage() ; Suppression de la Page en cours et de TOUS les Liens qui la composent.
If MessageRequester("ATTENTION","Vous CONFIRMEZ la SUPPRESSION de la Page "+PageAct+" ?",#PB_MessageRequester_YesNo | #PB_MessageRequester_Warning) = #PB_MessageRequester_Yes
Req$="DELETE FROM Liens WHERE IDPage="+PageAct : MajSQL(Req$)
Req$="DELETE FROM Pages WHERE ID="+PageAct : MajSQL(Req$)
RemplitTable("Pages")
Else
MessageRequester("Opération Annulée","Suppression Abandonnée",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndProcedure
Procedure GetParams(VarIn$="") ; Analyse le contenu de ParamGET pour ventiler les variables du formulaire HTML.
VarOut$=ReplaceString(VarIn$,"?","") : VarOut$=ReplaceString(VarOut$,"&",#CR$) : VarOut$=ReplaceString(VarOut$,"=",#TAB$) : VarOut$=ReplaceString(VarOut$," "," ")
VarOut$=ReplaceString(VarOut$,"\n"," ")
iPrm.i=1 : xPrm$=StringField(VarOut$,iPrm,#CR$)
While xPrm$<>""
VarForm$+#CR$+_RepeteChaine(#TAB$,6)+~"<input type=\"hidden\" id=\""+StringField(xPrm$,1,#TAB$)+~"\" name=\""+StringField(xPrm$,1,#TAB$)+~"\" value=\""+StringField(xPrm$,2,#TAB$)+~"\">"
iPrm+1 : xPrm$=StringField(VarOut$,iPrm,#CR$)
Wend
EndProcedure
Procedure$ GenCorps() ; Fabrication du corps (body) de la page HTML.
Body$="" : VRub$=""
ValRub$="" : ValNom$="" : ValURL$="" : ValParamGet$="" : ValBouton.i=0 : ValInfoLogin.i=0 : ValInfoPwd.i=0 : ValIdentifiant$="" : ValMotDePasse$=""
LitTable("Liens","WHERE IDPage="+PageAct+" ORDER BY IDRubrique, Nom")
i=1 : x$=StringField(ResSQL$,i,#CR$)
While x$<>""
ValRub$=FormatLib(StringField(x$,3,#TAB$),"<br />")
ValNom$=FormatLib(StringField(x$,4,#TAB$),"
") : ValURL$=StringField(x$,5,#TAB$) : ValParamGet$=StringField(x$,6,#TAB$)
ValBouton=Val(StringField(x$,7,#TAB$)) : ValInfoLogin=Val(StringField(x$,8,#TAB$)) : ValInfoPwd=Val(StringField(x$,9,#TAB$))
ValIdentifiant$=StringField(x$,10,#TAB$) : ValMotDePasse$=StringField(x$,11,#TAB$)
If ValRub$<>VRub$
If VRub$<>"" : Body$+#CR$+_RepeteChaine(#TAB$,3)+"</tr>" : EndIf
VRub$=ValRub$
Body$+#CR$+_RepeteChaine(#TAB$,3)+"<tr>"+#CR$+_RepeteChaine(#TAB$,4)+~"<td style=\"font-size : 150% ;\">"+VRub$+"</strong></td>"
EndIf
Info$=""
If ValInfoLogin>0 And ValIdentifiant$<>"" : Info$="Login: "+ValIdentifiant$ : EndIf
If ValInfoPwd>0 And ValMotDePasse$<>"" : If Info$<>"" : Info$+"
" : EndIf : Info$+"Pwd: "+ValMotDePasse$ : EndIf
If ValParamGet$<>""
If Left(ValParamGet$,1)="?"
VarForm$="" : GetParams(ValParamGet$)
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"<td>"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"<form action=\""+ValURL$+~"\">"+VarForm$
Body$+#CR$+_RepeteChaine(#TAB$,6)+~"<input type=\"submit\" value=\""+ValNom$+~"\">"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"</form>"
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"</td>"
Else
ValURL$+ValParamGet$
If Info$<>"" : Info$+"
" : EndIf : Info$+"Compléter l'URL dans la barre d'adresse par "+ValParamGet$
If ValBouton
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"<td>"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"<form action=\""+ValURL$+~"\">"
Body$+#CR$+_RepeteChaine(#TAB$,6)+~"<input type=\"submit\""
If Info$<>"" : Body$+~" title=\""+Info$+~"\"" : EndIf
Body$+~" value=\""+ValNom$+~"\" />"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"</form>"
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"</td>"
Else
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"<td><a href=\""+ValURL$+~"\""
If Info$<>"" : Body$+~" title=\""+Info$+~"\"" : EndIf
Body$+">"+ValNom$+"</a></td>"
EndIf
EndIf
Else
If ValBouton
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"<td>"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"<form action=\""+ValURL$+~"\">"
Body$+#CR$+_RepeteChaine(#TAB$,6)+~"<input type=\"submit\""
If Info$<>"" : Body$+~" title=\""+Info$+~"\"" : EndIf
Body$+~" value=\""+ValNom$+~"\">"
Body$+#CR$+_RepeteChaine(#TAB$,5)+~"</form>"
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"</td>"
Else
Body$+#CR$+_RepeteChaine(#TAB$,4)+~"<td><a href=\""+ValURL$+~"\""
If Info$<>"" : Body$+~" title=\""+Info$+~"\"" : EndIf
Body$+">"+ValNom$+"</a></td>"
EndIf
EndIf
i+1 : x$=StringField(ResSQL$,i,#CR$)
Wend
If Body$<>""
EntTable$=_RepeteChaine(#TAB$,2)+"<table>"
EntTable$+#CR$+_RepeteChaine(#TAB$,3)+"<tr>"
EntTable$+#CR$+_RepeteChaine(#TAB$,4)+"<th><h2>Rubriques</h2></th><th><h2>Liens</h2></th>"
EntTable$+#CR$+_RepeteChaine(#TAB$,3)+"</tr>"
Body$=EntTable$+#CR$+Body$
Body$+#CR$+_RepeteChaine(#TAB$,3)+"</tr>"
Body$+#CR$+_RepeteChaine(#TAB$,2)+"</table>"
EndIf
ProcedureReturn Body$
EndProcedure
; -------------------
; Programme Principal
; -------------------
DeclarVar() : InitPol() : InitHtm()
If TestBDD()>0
If OpenWindow(FenPrinc, 0, 0, LargFenP, HautFenP, NomFenP$, #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If CreateMenu(0, WindowID(0))
MenuTitle("Utilitaires")
MenuItem(1, "&Rafraîchir Tables"+Chr(9)+"Ctrl+R") : AddKeyboardShortcut(0, #PB_Shortcut_Control | #PB_Shortcut_R, 1) ; Utile dans le cas d'une modification concurrente de la BDD (par SQLSTUDIO, par exemple).
MenuItem(2, "Re&Numéroter Tables"+Chr(9)+"Ctrl+N") : AddKeyboardShortcut(0, #PB_Shortcut_Control | #PB_Shortcut_N, 2); Réinitialise les IDs des Pages et des Liens après des suppressions dans la BDD (accessoire).
MenuItem(9, "Quitter"+Chr(9)+"Escape") : AddKeyboardShortcut(0, #PB_Shortcut_Escape, 9) ; Commenter serait superflu !
EndIf
TextGadget (1, 5, 5, LargFenP-10, 20, "Générateur de Page d'Accueil pour Navigateur internet",#PB_Text_Center) : SetGadgetColor(1,#PB_Gadget_BackColor, $A0FFFF) : SetGadgetFont(1,PolTitre)
; Pages
TextGadget (2, 5, 35, 322, 20, "Pages",#PB_Text_Center) : SetGadgetColor(2,#PB_Gadget_BackColor, $A0FFA0)
ListIconGadget(20, 5, 60, 321, 28+10*21, "IDPage", 55, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection)
AddGadgetColumn(20, 1, "Nom de Page" , 100) : AddGadgetColumn(20, 2, "Utilisateur" , 100) : AddGadgetColumn(20, 3, "Fond" , 62)
ButtonGadget(21,5,300,70,25,"Nouvelle") : ButtonGadget(22,80,300,70,25,"Dupliquer") : ButtonGadget(23,155,300,70,25,"Modifier") : ButtonGadget(24,257,300,70,25,"Supprimer")
; Liens
TextGadget (3, 335, 35, 785, 20, "Liens",#PB_Text_Center) : SetGadgetColor(3,#PB_Gadget_BackColor, $FFFFA0)
ListIconGadget(30, 335, 60, 785, 28+10*21, "Lien", 40, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection)
AddGadgetColumn(30, 1, "Page" , 45) : AddGadgetColumn(30, 2, "Rubrique" , 140) : AddGadgetColumn(30, 3, "Nom" , 150) : AddGadgetColumn(30, 4, "URL" , 180)
AddGadgetColumn(30, 5, "ParamGet" , 145) : AddGadgetColumn(30, 6, "Bouton" , 70)
AddGadgetColumn(30, 7, "InfoLogin" , 70) : AddGadgetColumn(30, 8, "InfoPwd" , 70)
AddGadgetColumn(30, 9, "Identifiant" , 145) : AddGadgetColumn(30, 10, "MotPasse" , 145)
ButtonGadget(31,385,300,70,25,"Nouveau") : ButtonGadget(32,460,300,70,25,"Dupliquer") : ButtonGadget(33,535,300,70,25,"Modifier") : ButtonGadget(34,650,300,70,25,"Supprimer")
ButtonGadget(35,800,300,70,25,"Visualiser") : ButtonGadget(36,960,300,140,25,"Enregistrer la Page Html")
WebGadget(40, 5, 330, LargFenP-10, HautFenP-335, "")
RemplitTable("Pages")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
; -----------
; Table Pages
; -----------
Case 20
If EventType()=#PB_EventType_Change
PageAct=Val(GetGadgetItemText(20,GetGadgetState(20),0)) : VarPage$=LitFiche("Pages","WHERE ID="+PageAct) : RemplitTable("Liens")
Else
If EventType()=#PB_EventType_LeftDoubleClick
PageAct=Val(GetGadgetItemText(20,GetGadgetState(20),0)) : VarPage$=LitFiche("Pages","WHERE ID="+PageAct) : RemplitTable("Liens")
ModifPage()
EndIf
EndIf
Case 21
NouvPage() ; Nouvelle Page
Case 22
DuplicPage() ; Dupliquer Page
Case 23
If PageAct>1
ModifPage() ; Modification Page
Else
MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
Case 24
If PageAct>1
SupprPage() ; Suppression Page
Else
MessageRequester("Opération Interdite","La page Exemple ne peut être Supprimée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
; -----------
; Table Liens
; -----------
Case 30
If EventType()=#PB_EventType_Change
LienAct=Val(GetGadgetItemText(30,GetGadgetState(30),0))
Else
If EventType()=#PB_EventType_LeftDoubleClick
LienAct=Val(GetGadgetItemText(30,GetGadgetState(30),0))
If PageAct>1 : ModifLien() : Else : MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info) : EndIf
EndIf
EndIf
Case 31
; Nouveau Lien
If PageAct>1 : NouvLien() : Else : MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info) : EndIf
Case 32
; Dupliquer Lien
DuplicLien()
Case 33
; Modification Lien
If PageAct>1 : ModifLien() : Else : MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info) : EndIf
Case 34
; Suppression Lien
If PageAct>1 : SupprLien() : Else : MessageRequester("Opération Interdite","La page Exemple ne peut être Modifiée.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info) : EndIf
; -------------
; Visualisation
; -------------
Case 35
If EventType()=#PB_EventType_LeftClick
VarPage$=LitFiche("Pages","WHERE ID="+PageAct)
NomPage$=StringField(VarPage$,2,#TAB$)
c$=StringField(VarPage$,4,#TAB$) : CouleurPage$=c$ : CouleurTexte$=Pb2HtmColor(ProdCoulTxt(c$))
StylePage$=~"<body style=\"background-color : #"+CouleurPage$+" ; color : #"+CouleurTexte$+~";\">"
HTM$=ReplaceString(EntHTM$,"black","#"+CouleurTexte$)
HTM$+#CR$+CorpsHTM$+#CR$+GenCorps()+#CR$+PiedHTM$
HTM$=ReplaceString(HTM$,"Menu Web",NomPage$)
HTM$=ReplaceString(HTM$,"<body>",StylePage$)
SetGadgetItemText(40,#PB_Web_HtmlCode,HTM$)
EndIf
; ----------------------------------
; Enregistrement de la Page-Résultat
; ----------------------------------
Case 36
If EventType()=#PB_EventType_LeftClick
If HTM$<>""
NomFicHTM$=SaveFileRequester("Sélectionnez un fichier", PathFic$+NomPage$+".htm", "HyperTextMarkupLanguage(*.htm)|*.htm", 0)
If NomFicHTM$<>""
ExplodePath(NomFicHTM$)
If FileSize(PathFic$+NomFic$+".htm")>0
If MessageRequester("Ce fichier existe déjà !","Vous confirmez l'écrasement ?",#PB_MessageRequester_YesNoCancel) = #PB_MessageRequester_Yes
EcritHtm()
EndIf
Else
EcritHtm()
EndIf
Else
MessageRequester("Annulation.", "Sauvegarde HTM Annulée", #PB_MessageRequester_Ok)
EndIf
Else
MessageRequester("Opération Inutile, Page VIDE !","Visualisez la page avant de l'enregistrer.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndIf
EndSelect
Case #PB_Event_Menu
Select EventMenu()
Case 1 : RemplitTable("Pages")
Case 2 : ReNumID("Pages") : ReNumID("Liens") : RemplitTable("Pages")
Case 9 : End
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
CloseWindow(FenPrinc)
EndIf
Else
; Séquence exécutée lors de la premier utilisation du logiciel GenHello ou après une suppression (involontaire ?) du fichier de la BDD (GenHello.sq3).
If MessageRequester("Base GenHello.sq3 inaccessible","Voulez-vous la créer ?",#PB_MessageRequester_Warning | #PB_MessageRequester_YesNo)=#PB_MessageRequester_Yes
If OpenFile(0,GetCurrentDirectory()+"GenHello.sql",#PB_UTF8)
Restore Exemple
Read.s Cmd$
While Cmd$<>"<EOD>"
WriteStringN(0,Cmd$)
Read.s Cmd$
Wend
CloseFile(0)
DirSQ3$=FindExe("sqlite3")
If DirSQ3$<>""
DirSQ3$+"\"
Cmd$=GetCurrentDirectory()+"GenHello.sq3 < "+GetCurrentDirectory()+"GenHello.sql"
Cmd$=ReplaceString(Cmd$,"\","/")
cmd$=DirSQ3$+"sqlite3 "+Cmd$
If OpenFile(0,GetCurrentDirectory()+"RestGenHello.bat",#PB_Ascii)
WriteStringN(0,Cmd$)
CloseFile(0)
Execution=RunProgram(GetCurrentDirectory()+"RestGenHello.bat"," ",GetCurrentDirectory(),#PB_Program_Wait)
If OpenDatabase(0,"GenHello.sq3","","")
CloseDatabase(0)
MessageRequester("La base est générée.","Veuillez relancer le programme.",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
Else
MessageRequester("Erreur","Impossible d'ouvrir la base GenHello.sq3",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
Else
MessageRequester("Erreur","Impossible de créer le fichier RestGenHello.bat",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
Else
MessageRequester("Erreur","Sqlite3.exe introuvable"+#CR$+"Vous pouvez le télécharger ici :"+#CR$+"https://www.sqlite.org/download.html",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
Else
MessageRequester("Erreur","Impossible de créer le fichier GenHello.sql",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
Else
MessageRequester("Dommage !","Peut-être une prochaine fois …",#PB_MessageRequester_Ok | #PB_MessageRequester_Info)
EndIf
EndIf
; ----------------------------------------------------------------------------------------------
; Données pour la fabrication du fichier GenHello.sql initial (Exemples) et des fenêtres d'Aide
; ----------------------------------------------------------------------------------------------
; Chaque série se termine par la chaîne <EOD> (End Of Data) pour signifier qu'il n'y a plus rien à lire dans la série concernée.
DataSection
Exemple:
Data.s ~"PRAGMA foreign_keys=OFF;"
Data.s ~"BEGIN TRANSACTION;"
Data.s ~"CREATE TABLE Rubriques (ID TEXT NOT NULL ON CONFLICT ROLLBACK PRIMARY KEY ON CONFLICT ROLLBACK UNIQUE ON CONFLICT ROLLBACK COLLATE RTRIM);"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('Autres');"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('Encyclopédies');"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('<i>Fouineurs</i>');"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('Horaires');"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('Utilitaires');"
Data.s ~"INSERT INTO \"Rubriques\" VALUES('Cartes et Plans');"
Data.s ~"CREATE TABLE Pages (ID INTEGER NOT NULL PRIMARY KEY ON CONFLICT ROLLBACK AUTOINCREMENT UNIQUE, Nom TEXT NOT NULL COLLATE RTRIM DEFAULT Hello, Utilisateur TEXT NOT NULL COLLATE RTRIM DEFAULT Moi, Fond TEXT COLLATE RTRIM DEFAULT FFFFCF NOT NULL ON CONFLICT ROLLBACK);"
Data.s ~"INSERT INTO \"Pages\" VALUES(1,'Hello','Exemple','FFFFDF');"
Data.s ~"CREATE TABLE Liens (ID INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT UNIQUE, IDPage INTEGER REFERENCES Pages (ID) ON DELETE CASCADE ON UPDATE CASCADE MATCH FULL NOT NULL ON CONFLICT ROLLBACK, IDRubrique TEXT NOT NULL ON CONFLICT ROLLBACK COLLATE RTRIM REFERENCES Rubriques (ID) ON DELETE CASCADE ON UPDATE CASCADE MATCH FULL DEFAULT ZZZ, Nom TEXT DEFAULT ('<--Nouveau-->') NOT NULL ON CONFLICT ROLLBACK COLLATE RTRIM, URL TEXT NOT NULL ON CONFLICT ROLLBACK DEFAULT ('www.quelquechose.truc') COLLATE RTRIM, ParamGet TEXT COLLATE RTRIM, Bouton BOOLEAN, InfoLogin BOOLEAN NOT NULL DEFAULT (0), InfoPwd BOOLEAN NOT NULL DEFAULT (0), Identifiant TEXT COLLATE RTRIM, MotDePasse TEXT COLLATE RTRIM);"
Data.s ~"INSERT INTO \"Liens\" VALUES(1,1,'Encyclopédies','Meilleur Dico (Atilf)','http://atilf.atilf.fr/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(2,1,'<i>Fouineurs</i>','Annuaire Téléphonique','https://www.pagesjaunes.fr/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(3,1,'<i>Fouineurs</i>','Bing','https://www.bing.com/',NULL,0,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(4,1,'<i>Fouineurs</i>','Ecosia','https://www.ecosia.org',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(5,1,'<i>Fouineurs</i>','Google','https://www.google.fr',NULL,0,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(6,1,'Horaires','Autocars Pyrénées-Orientales','http://www.asperi.fr',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(7,1,'Utilitaires','Mon IP Publique','http://www.asperi.fr','?REQ=IP',1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(8,1,'Cartes et Plans','Cadastre','https://www.cadastre.gouv.fr',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(9,1,'Cartes et Plans','Google Maps','https://www.google.fr/maps',NULL,0,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(10,1,'Cartes et Plans','Open Street Map (OSM)','https://www.openstreetmap.org',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(11,1,'Cartes et Plans','I.G.N.','https://www.geoportail.gouv.fr/',NULL,0,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(12,1,'Cartes et Plans','Aiguille Etretat (OSM)','https://www.openstreetmap.org/search','?zoom=18&lat=49.70703&lon=0.19264',0,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(13,1,'Utilitaires','Mon Débit internet','http://www.speedzilla.net/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(14,1,'Encyclopédies','Tout sur tout (Wikipedia)','https://fr.wikipedia.org/wiki/Wikip%C3%A9dia:Accueil_principal',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(15,1,'Horaires','Heure Actuelle','https://time.is/fr/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(16,1,'Utilitaires','Codage Image Base64','https://www.base64decode.org/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(17,1,'Autres','Forum PureBasic','https://www.purebasic.fr/french/',NULL,1,0,0,NULL,NULL);"
Data.s ~"INSERT INTO \"Liens\" VALUES(18,1,'Autres','Un petit mot pour l''auteur !','mailto://pk1157@laposte.net','?subject=GenHello&body=Merci, c''est pratique\n(ou pas !)\n…',1,0,0,NULL,NULL);"
Data.s ~"DELETE FROM sqlite_sequence;"
Data.s ~"INSERT INTO \"sqlite_sequence\" VALUES('Pages',1);"
Data.s ~"INSERT INTO \"sqlite_sequence\" VALUES('Liens',17);"
Data.s ~"COMMIT;"
Data.s ~"<EOD>"
AideURL:
Data.s ~"Format de l'URL d'un lien"
Data.s ~"<PROTOCOLE><ADRESSE>[PORT] où :"
Data.s ~"- PROTOCOLE="
Data.s ~" http:// | https://"
Data.s ~" ou file://"
Data.s ~" ou mailto:"
Data.s ~" ou [user[pwd]@]ftp://"
Data.s ~"- ADRESSE=[www.]sitecible.<fr|com|org|…>[/machin/truc]"
Data.s ~"- PORT=vide si standard"
Data.s ~" ou deux points(:), suivis du n° de port"
Data.s #CR$
Data.s ~"EXEMPLES : "
Data.s ~"- http://127.0.0.1"
Data.s ~"- http://localhost:80"
Data.s ~"- http://monimprimante:1234"
Data.s ~"- https://www.google.fr"
Data.s ~"- file://C:/windows"
Data.s ~"- ftp://ftp.uni-bayreuth.de/pub/math/"
Data.s ~"- mailto://pk1157@laposte.net"
Data.s ~"<EOD>"
AideParamGET:
Data.s ~"Paramètre(s) transmis par méthode GET"
Data.s ~"?<VARIABLE>=<VALEUR>[&<VARIABLE>=<VALEUR>[&<VARIABLE>=<VALEUR>]] où :"
Data.s ~"- le premier paramètre (couple <VARIABLE>=<VALEUR>) est précédé par un point d'interrogation <?> ;"
Data.s ~"- le(s) paramètre(s) suivant(s) par une esperluette <&>."
Data.s #CR$
Data.s ~"Note : si un ou plusieurs paramètres sont transmis par la méthode GET, le lien sera affiché par un bouton, même si cette option n'est pas cochée."
Data.s ~"<EOD>"
AideRubriques:
Data.s ~"Mise à Jour d'un libellé de Rubrique"
Data.s ~"- La MODIFICATION d'une Rubrique existante se propagera sur TOUS les Liens qui l'utilisent !"
Data.s ~" (même si le Lien se réfère à une autre Page que celle en cours)."
Data.s #CR$
Data.s ~"- La SUPPRESSION d'une Rubrique existante sera bloquée si un Lien existant l'utilise,"
Data.s ~" (même si le Lien se réfère à une autre Page que celle en cours)."
Data.s #CR$
Data.s ~"- La CREATION d'une Rubrique ne peut conduire à deux Rubriques au libellé identique."
Data.s ~" (Ce serait inutile ou absurde, mais, on ne sait jamais …)."
Data.s #CR$
Data.s ~"- Pour AJOUTER une Rubrique, sélectionner la Rubrique ~Nouvelle~ et cliquer sur [Modifier]."
Data.s #CR$
Data.s ~"NOTE : On peut \"injecter\" des entités HTML ( ou … par exemple) pour mettre en forme le Libellé de la Rubrique."
Data.s ~"<EOD>"
EndDataSection
Code : Tout sélectionner
; +====================+
; | GestBDD |
; +====================+
;
; Lecture de la Base de Données SQLITE3 : GenHello.sq3
; Initialisation des Données du programme.
UseSQLiteDatabase()
Global DBName$="GenHello", DBUser$="", DBPassWord$="", IDDB=0
Procedure TestBDD()
Res=0
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
If IDDB>0
CloseDatabase(IDDB)
Res=1
EndIf
ProcedureReturn Res
EndProcedure
Procedure.s LitFiche(TbName$="",CritSel$="")
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
LigSQL$=""
If IDDB>0
If DatabaseQuery(IDDB, "SELECT * FROM "+TbName$+" "+CritSel$)
While NextDatabaseRow(IDDB)
LigSQL$=""
For i=0 To DatabaseColumns(IDDB)
If LigSQL$<>"" : LigSQL$+#TAB$ : EndIf
LigSQL$+GetDatabaseString(IDDB, i)
Next i
Wend
FinishDatabaseQuery(IDDB)
EndIf
CloseDatabase(IDDB)
Else
MessageRequester("Abandon","Connection Impossible à la Base de Données: "+DatabaseError())
EndIf
ProcedureReturn LigSQL$
EndProcedure
Procedure LitTable(TbName$="",CritSel$="")
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
ResSQL$=""
If IDDB>0
If DatabaseQuery(IDDB, "SELECT * FROM "+TbName$+" "+CritSel$)
While NextDatabaseRow(IDDB)
LigSQL$=""
For i=0 To DatabaseColumns(IDDB)
If LigSQL$<>"" : LigSQL$+#TAB$ : EndIf
LigSQL$+GetDatabaseString(IDDB, i)
Next i
If ResSQL$<>"" : ResSQL$+#CR$ : EndIf
ResSQL$+LigSQL$
Wend
FinishDatabaseQuery(IDDB)
EndIf
CloseDatabase(IDDB)
Else
MessageRequester("Abandon","Connection Impossible à la Base de Données: "+DatabaseError())
EndIf
EndProcedure
Procedure LitSQL(Req$="")
ResSQL$=""
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
If IDDB>0
If DatabaseQuery(IDDB, Req$)
While NextDatabaseRow(IDDB)
LigSQL$=""
For i=0 To DatabaseColumns(IDDB)
If LigSQL$<>"" : LigSQL$+#TAB$ : EndIf
LigSQL$+GetDatabaseString(IDDB, i)
Next i
If ResSQL$<>"" : ResSQL$+#CR$ : EndIf
ResSQL$+LigSQL$
Wend
FinishDatabaseQuery(IDDB)
EndIf
CloseDatabase(IDDB)
Else
MessageRequester("Abandon","Connection Impossible à la Base de Données: "+DatabaseError())
EndIf
EndProcedure
Procedure MajSQL(Req$="")
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
If IDDB>0
If DatabaseUpdate(IDDB, Req$)
FinishDatabaseQuery(IDDB)
EndIf
CloseDatabase(IDDB)
Else
MessageRequester("Abandon","Connection Impossible à la Base de Données: "+DatabaseError())
EndIf
EndProcedure
Procedure ReNumID(NomTab$="")
ResSQL$=""
IDDB=OpenDatabase(#PB_Any, DBName$+".sq3", DBUser$, DBPassWord$, #PB_Database_SQLite)
If IDDB>0
If NomTab$<>""
Req$="SELECT ID FROM "+NomTab$+" ORDER BY ID"
If DatabaseQuery(IDDB, Req$)
While NextDatabaseRow(IDDB)
LigSQL$=GetDatabaseString(IDDB, 0)
If ResSQL$<>"" : ResSQL$+#CR$ : EndIf
ResSQL$+LigSQL$
Wend
FinishDatabaseQuery(IDDB)
EndIf
; Debug ResSQL$
i=1 : j=Val(StringField(ResSQL$,i,#CR$))
While j>=i
If j>i
If DatabaseUpdate(IDDB, "UPDATE "+NomTab$+" SET ID="+Str(i)+" WHERE ID="+Str(j))
FinishDatabaseQuery(IDDB)
EndIf
EndIf
If NomTab$="Pages"
If DatabaseUpdate(IDDB, "UPDATE Liens SET IDPage="+Str(i)+" WHERE IDPage="+Str(j))
FinishDatabaseQuery(IDDB)
EndIf
EndIf
i+1 : j=Val(StringField(ResSQL$,i,#CR$))
Wend
If DatabaseUpdate(IDDB, "UPDATE SQLITE_SEQUENCE SET seq=(SELECT MAX(ID) FROM "+NomTab$+") WHERE name='"+NomTab$+"'")
FinishDatabaseQuery(IDDB)
EndIf
EndIf
CloseDatabase(IDDB)
Else
MessageRequester("Abandon","Connection Impossible à la Base de Données: "+DatabaseError())
EndIf
EndProcedure
