C'est une procédure (ExML(NomDeFichier.S) ) qui charge un fichier à balises dans une liste, fait un petit tri et l'affiche dans un Tree.
ça permet de visionner la hiérarchie d'un ML. Eventuellement, ça permet de rendre propre un fichier ML. Je ne garantis rien quant à sa fiabilité.
La vitesse de traitement est de l'ordre de 8ko/s donc ne pas s'inquiéter si le sablier vous laisse le temps de gratter une grille et d'appeler Brenda.
Code : Tout sélectionner
Structure OBJET
Win.L
Gad.L
*Create
EndStructure
Global BrowseFlag.L
BrowseFlag = #True
Global *Arb.OBJET
Global NewList Txt.S()
Global NewList KWord.S()
Global NewList TxtD.S()
Global NewList KWPath.S()
Global NewList KWStack.S()
Procedure NavigationCallback(Gadget, Url$)
ProcedureReturn BrowseFlag
EndProcedure
Procedure ExML(FileName.S)
Protected FileNo.L
Protected LineI.S
Protected LineF.S
Protected i.L
Protected j.L
Protected LLine.L
Protected CharCode.L
Protected Char.S
Protected Level.L
Protected EndOfLine.S
Protected InnerMarkup.S
Protected CloseMarkFlag.L
Protected UnknownMark.L
Protected MarkupTitle.S
Protected TBodyFlag.L
Level = 1
FileNo = ReadFile(-1, FileName)
;- On fait un 1er «trimage» de chq ligne
;- (Tabulations remplacées par des espaces)
;- (Et on charge dans une liste chaînée)
ClearList(Txt() )
ClearList(TxtD() )
ClearList(KWord() )
ClearList(KWPath() )
ClearList(KWStack() )
Repeat
LineI = ReadString(FileNo)
LLine = Len(LineI)
LineF = ""
For i = 1 To LLine
Char = Mid(LineI, i, 1)
CharCode = Asc(Char)
If CharCode = 9
CharCode = 32
EndIf
LineF = LineF + Chr(CharCode)
Next i
LineF = Trim(LineF)
If LineF <> ""
AddElement(Txt() )
Txt() = LineF
EndIf
Until Eof(FileNo)
CloseFile(FileNo)
;- Sépare les balises du reste du code
;- Complète les marquages « > » manquants
BF.L = 0
Transi.S = ""
ClosingB = 0
ForEach Txt()
LLine = Len(Txt() )
; Compte les blocs (balises et non-balises)
BlocQ = 1
Start = 1
For i = 1 To LLine
Char = Mid(Txt(), i, 1)
If Char = "<"
BF = 1
If i > 1
If Mid(Txt(), i - 1, 1) <> ">"
AddElement(TxtD() )
TxtD() = Mid(Txt(), Start, i - Start)
Start = i
BlocQ + 1
EndIf
EndIf
If i < LLine
If Mid(Txt(), i + 1, 1) = "/"
ClosingB = 1
EndIf
EndIf
EndIf
If Char = ">" Or ((i = LLine) And (ClosingB = 1) )
If i <= LLine
AddElement(TxtD() )
If BF = 1
TxtD() = Transi + " "
Transi = ""
BF = 0
EndIf
TxtD() = TxtD() + Mid(Txt(), Start, (i - Start) + 1)
Start = i + 1
BlocQ + 1
If Char <> ">" And ((i = LLine) And (ClosingB = 1) )
TxtD() = TxtD() + ">"
EndIf
EndIf
ClosingB = 0
EndIf
Next i
If BF = 1
Transi = Transi + Mid(Txt(), Start, (LLine - Start) + 1) + " "
Else
If BlocQ = 1
AddElement(TxtD() )
TxtD() = Txt()
EndIf
EndIf
Next
;- Supprime les lignes vides (+trimage)
ClearList(Txt() )
ForEach TxtD()
TxtD() = Trim(TxtD() )
If TxtD() <> ""
AddElement(Txt() )
Txt() = TxtD()
EndIf
Next
;- Dans la volée, récupère les mots-clé usuels
ForEach Txt()
If Left(Txt(), 2) = "</"
LineI = Trim(UCase(Mid(Txt(), 3, Len(Txt() ) - 3) ) )
New = 1
ForEach KWord()
If KWord() = LineI
New = 0
EndIf
Next
If New
AddElement(KWord() )
KWord() = LineI
EndIf
EndIf
Next
;- Complète les balises </TBODY> </TD>
ClearList(KWStack() )
Level = 1
ForEach Txt()
If Left(Txt(), 1) = "<"
; Il y a une balise...
InnerMarkup = UCase(Trim(Mid(Txt(), 2, Len(Txt() ) - 2) ) )
CloseMarkFlag = (Left(InnerMarkup, 1) = "/")
If CloseMarkFlag = 0
; Ouverture
UnknownMark = 1
; Extrait le titre de la balise
MarkupTitle = UCase(Trim(StringField(InnerMarkup, 1, " ") ) )
; Vérifie si ce titre est un mot-clé
ForEach KWord()
If KWord() = MarkupTitle
UnknownMark = 0
Break
EndIf
Next
If UnknownMark = 0
; OUVERTURE VALIDE
;******************
AddElement(KWStack() )
KWStack() = MarkupTitle
If MarkupTitle = "TBODY"
TBodyFlag + 1
EndIf
If MarkupTitle = "TD"
TDFlag + 1
EndIf
Level + 1
EndIf
Else
; FERMETURE VALIDE
;******************
If Right(InnerMarkup, Len(InnerMarkup) - 1) = "TBODY"
TBodyFlag - 1
EndIf
If Right(InnerMarkup, Len(InnerMarkup) - 1) = "TD"
TDFlag - 1
EndIf
If Right(InnerMarkup, Len(InnerMarkup) - 1) = "TABLE"
If KWStack() = "TBODY"
If TBodyFlag > 0
TBodyFlag - 1
InsertElement(Txt() )
Txt() = "</TBODY>"
EndIf
EndIf
EndIf
If Right(InnerMarkup, Len(InnerMarkup) - 1) = "TR"
If KWStack() = "TD"
If TDFlag > 0
TDFlag - 1
InsertElement(Txt() )
Txt() = "</TD>"
EndIf
EndIf
EndIf
DeleteElement(KWStack() )
Level - 1
EndIf
EndIf
Next
;- Ajuste la hiérarchie
ClearList(KWStack() )
Level = 1
ForEach(Txt() )
If Left(Txt(), 1) = "<"
; Il y a une balise...
InnerMarkup = UCase(Trim(Mid(Txt(), 2, Len(Txt() ) - 2) ) )
CloseMarkFlag = (Left(InnerMarkup, 1) = "/")
If CloseMarkFlag = 0
; Ouverture
UnknownMark = 1
; Extrait le titre de la balise
MarkupTitle = UCase(Trim(StringField(InnerMarkup, 1, " ") ) )
; Vérifie si ce titre est un mot-clé
ForEach KWord()
If KWord() = MarkupTitle
UnknownMark = 0
Break
EndIf
Next
If UnknownMark = 0
; OUVERTURE VALIDE
;******************
AddElement(KWStack() )
KWStack() = MarkupTitle
Level + 1
EndIf
Else
; FERMETURE VALIDE
;******************
LineI = Trim(Right(InnerMarkup, Len(InnerMarkup) - 1) )
If KWStack() = LineI
DeleteElement(KWStack() )
Level - 1
Else
LineI = Txt()
DeleteElement(Txt(), 1)
NextElement(Txt() )
NextElement(Txt() )
InsertElement(Txt() )
Txt() = LineI
PreviousElement(Txt() )
PreviousElement(Txt() )
EndIf
EndIf
EndIf
Delay(5)
Next
EndProcedure
Procedure SaveList(FileName.S)
Protected FileHnd.L
; Ecrase le fichier spécifié s'il existe déjà
FileHnd = CreateFile(-1, FileName)
ForEach(Txt() )
WriteStringN(FileHnd, Txt() )
Next
CloseFile(FileHnd)
EndProcedure
Procedure List2Tree(*A.OBJET)
;- Introduit la liste dans l'arbre
Protected Level.L
Protected InnerMarkup.S
Protected CloseMarkFlag.L
Protected UnknownMark.L
Protected MarkupTitle.S
Level = 1
ForEach Txt()
AddGadgetItem(*A\Gad, -1, Txt(), 0, Level)
If Left(Txt(), 1) = "<"
InnerMarkup = Trim(Mid(Txt(), 2, Len(Txt() ) - 2) )
CloseMarkFlag = (Left(InnerMarkup, 1) = "/") ; Or ((Right(InnerMarkup, 1) = "/") )
If CloseMarkFlag = 0
; Ouverture...
UnknownMark = 1
; Extrait le titre de la balise
MarkupTitle = UCase(Trim(StringField(InnerMarkup, 1, " ") ) )
; Vérifie si ce titre est un mot-clé
ForEach KWord()
If KWord() = MarkupTitle
UnknownMark = 0
Break
EndIf
Next
If UnknownMark = 0
Level + 1
EndIf
Else
; Fermeture
Level - 1
EndIf
EndIf
Next
EndProcedure
Procedure ExpandTree(*A.OBJET)
Protected i.L
;- On déploie les branches
For i = 0 To CountGadgetItems(*A\Gad)
SetGadgetItemState(*A\Gad, i, #PB_Tree_Expanded)
Next i
EndProcedure
Procedure MaProcedureCallback(WindowID, Message, wParam, lParam)
Resultat = #PB_ProcessPureBasicEvents
ProcedureReturn Resultat
EndProcedure
Procedure Obj(*A.OBJET)
Protected i.L
Protected MLName.S
*A\Win = OpenWindow(-1, 0, 0, 800, 600, "", $CF0001)
GW = WindowWidth(*A\Win)
GH = WindowHeight(*A\Win)
CreateGadgetList(WindowID(*A\Win) )
*A\Gad = TreeGadget(-1, 0, 0, 0, 0)
AddGadgetItem(*A\Gad, -1, "Root", 0, 0)
MLName = OpenFileRequester("Ouvrir", "", "HTML|*.HTM;Tous|*.*", 0)
ExML(MLName)
List2Tree(*A)
ExpandTree(*A)
SetWindowCallback(@MaProcedureCallback() )
n = 1
Level = 1
SetGadgetItemState(*A\Gad, 0, #PB_Tree_Expanded | #PB_Tree_Selected)
Repeat
EndDelay = ElapsedMilliseconds() + 1000
Repeat
Event = WindowEvent()
Delay(5)
Select Event
Case #PB_Event_SizeWindow
GW = WindowWidth(*A\Win)
GH = WindowHeight(*A\Win)
ResizeGadget(*A\Gad, 0, 0, GW, GH)
Case 16
Break
EndSelect
Until ElapsedMilliseconds() > EndDelay
SetActiveWindow(*A\Win)
SetActiveGadget(*A\Gad)
Until Event = 16
CloseWindow(*A\Win)
EndProcedure
*Arb = AllocateMemory(SizeOf(OBJET) )
Obj(*Arb)
End
