PARSEUR XML

'Code source du parseur:
Sub Load_Xmlfile (fichier As String)
On Error GoTo ERREUR
XML_Max = 0: History_max = 0
erreur_type = 2

Set_Progressbar_to 0
max = Count_File_Lines(fichier): T = 0
filestr$ = ""
xf = Open_DosFile(fichier, "input")
 Do While Not EOF(xf)
   T = T + 1: p = 100 * T / max
   Set_Progressbar_to p
   Line Input #xf, txt$
   text$ = RTrim$(LTrim$(txt$))
   filestr$ = filestr$ + text$
   x = DoEvents()
  Loop
Close #xf
clipboard.SetText filestr$
filestr$ = "<@>" + filestr$ + "</@>"
'/////////////////////////////////////////////////////
XML_Parent(0) = 0
XML_NOM(0) = "@"
XML_Value(0) = ""
XML_Max = 1

ReDim A_Traiter(2000) As String
ReDim A_Traiter_id(2000) As Integer
ReDim A_Traiter_xmin(2000) As Integer
ReDim A_Traiter_xmax(2000) As Integer
A_Traiter_max = 1
A_Traiter(0) = "@"
A_Traiter_id(0) = 0
A_Traiter_xmin(0) = 1
A_Traiter_xmax(0) = Len(filestr$)
erreur_type = 1

Do While A_Traiter_max
 'Debug.Print "Traitement de " + A_Traiter(A_Traiter_max - 1)
   xmin = A_Traiter_xmin(A_Traiter_max - 1)
   xmax = A_Traiter_xmax(A_Traiter_max - 1)
   substr$ = Mid$(filestr$, xmin, xmax - xmin + 1)
 'Debug.Print substr$
   Traitn$ = A_Traiter(A_Traiter_max - 1)
   Trait = A_Traiter_id(A_Traiter_max - 1)
   li = Len(substr$): l = li
   Debut = xmin
   substr$ = Mid$(substr$, Len("<" + Traitn$ + ">") + 1)
   substr$ = Left$(substr$, Len(substr$) - Len("</" + Traitn$ + ">"))
 'Debug.Print "=>" + substr$
   inBalise = 0
    A_Traiter_max = A_Traiter_max - 1
    Started = 0
   pt = 0
   Do: pt = pt + 1
      x = DoEvents()
      If Len(substr$) = 0 Then Exit Do
      p = 100 * pt / Len(substr$)
      Set_Progressbar_to p
      next_balise = InStr(pt, substr$, "<")
      pt = next_balise: If pt = 0 Then Exit Do
      aflag = InStr(pt, substr$, "/>")
      renext_balise = InStr(pt + 1, substr$, "<")
      next_Anbalise = InStr(pt, substr$, "</")
      flag = 0
      If aflag > 0 And aflag < renext_balise Then
       flag = 1
      Else
      If next_balise = next_Anbalise Then inBalise = inBalise - 1 Else inBalise = inBalise + 1
      End If
      If inBalise = 1 And next_balise <> next_Anbalise Then
          
          next_finbalise = InStr(pt, substr$, ">")
          nom_balise$ = Mid$(substr$, next_balise + 1, next_finbalise - next_balise - 1)
          If flag = 0 And Right$(nom_balise$, 1) <> "/" Then
          onom_balise$ = Mid$(substr$, next_balise + 1, next_finbalise - next_balise - 1)
            
 'Debug.Print
 'Debug.Print "Ajout de la propriété " + nom_balise$ + " de " + Traitn$
             XML_Parent(XML_Max) = Trait
             XML_FILS(Trait) = XML_FILS(Trait) + Str$(XML_Max)
             XML_NOM(XML_Max) = nom_balise$
             next_oBalise = InStr(pt + 1, substr$, "<")
             valu$ = Mid$(substr$, next_finbalise + 1, next_oBalise - next_finbalise - 1)
 'Debug.Print "value=" + valu$
             XML_Value(XML_Max) = valu$
             A_Traiter_xmin(A_Traiter_max) = pt + Debut + Len("<" + Traitn$ + ">") - 1'+2
             pt1 = A_Traiter_xmin(A_Traiter_max)
             Started = 1
         ElseIf flag = 1 And Right$(nom_balise$, 1) = "/" Then
            
            trag$ = Left$(nom_balise$, Len(nom_balise$) - 1)
            XML_TAGS(XML_Max) = XML_TAGS(XML_Max) + trag$
 'Debug.Print "Ajout du tag " + trag$ + " à la propriété " + Traitn$
            nom_balise$ = onom_balise$
         End If
      ElseIf flag = 0 And inBalise = 0 And Started = 1 Then
          'Debug.Print pt
 'Debug.Print "Validation de la propriété " + nom_balise$ + " de " + Traitn$
          A_Traiter(A_Traiter_max) = nom_balise$
          A_Traiter_id(A_Traiter_max) = XML_Max
          A_Traiter_xmax(A_Traiter_max) = Debut + Len("<" + Traitn$ + ">") - 2 + pt + Len("</" + nom_balise$ + ">")
          XML_Max = XML_Max + 1
          A_Traiter_max = A_Traiter_max + 1
      Else
      End If
   Loop While pt >= 0 And pt <= Len(substr$) And InStr(pt, substr$, "<") > 0
Loop
      Set_Progressbar_to 110
      History_go 0
Exit Sub
ERREUR: If Err <> 0 Then tt = Err: Resume ERREUR
On Error GoTo 0
endl$ = Chr$(13) + Chr$(10)
message$ = "Une erreur de type" + Str$(erreur_type * 1000 + tt) + " (" + Error$(tt) + ") s'est produite." + endl$
message$ = message$ + "-----------" + endl$
Select Case erreur_type * 1000 + tt
Case 1014: message$ = message$ + "Ceci arrive fréquemment au traitement d'une balise trop volumineuse" + endl$
Case 1005: message$ = message$ + "Ceci arrive fréquemment au traitement d'un fichier XML foireux ou d'un fichier non-XML." + endl$
Case 1009: message$ = message$ + "Cette erreur à lieu quand on charge trop de balises (max:2000)" + endl$
Case Is > 2000: message$ = message$ + "Le fichier ne peut être chanrgé en mémoire" + endl$
Case Else: message$ = message$ + "Désolé, on ne peut pas vous en dire plus" + endl$
End Select: Reset
           message$ = message$ + "Fichier ouvert: " + fichier$ + endl$
           If A_Traiter_max <= 0 Then A_Traiter_max = 1
           message$ = message$ + "Balise en cours de traitement:" + A_Traiter(A_Traiter_max - 1) + endl$
           

die message$
End Sub

Télécharger le zip

04 janvier 2005 20:36:14 :