IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Delphi Discussion :

Lecture d'un fichier texte et exécution de commandes - Structure if else


Sujet :

Delphi

  1. #21
    Membre à l'essai
    Inscrit en
    Avril 2003
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : Avril 2003
    Messages : 14
    Points : 23
    Points
    23
    Par défaut
    Les arbres binaires.... j'aurai préféré m'en passer mais on dirait que j'ai pas trop le choix...

    Donc pour commencer, j'essaie d'implémenter la déclaration de tout ce petit monde dans mon code (TNode, TArbre, TNoeud) via le code donné précédemment et les problèmes commencent :

    je me perds complètement entre les TNode et les TNoeud, à quel moment les utiliser....

    Le code ne compile pas (UArbreBinaire):
    - type noeud introuvable (je pense que je devrais utiliser TNode de Unodes ? ou TNoeud ??)
    - déclarations différentes entre la déclaration et l'implementation (TNoeud.create, ajouter, etc... ) et je me perds complètement entre les TNode et les TNoeud, et donc lequel il faut utiliser pour déjà permettre au code de compiler correctement.

    Et j'en suis pas encore à l'implantation de l'arbre à partir de mon fichier...

    Nodes
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
     
    unit Nodes;
     
    interface
    uses classes;
     
    Type
      Tnode = Class
        Name : String;
        Constructor Create(aName : String);
      End;
      TnodeClass = Class of  Tnode;
     
      TnodeIf = Class(Tnode)
      End;
      TnodeThen = Class(Tnode)
      End;
      TnodeVar = Class(Tnode)
      End;
     
      procedure registerNodeByName(classe: TnodeClass);
      function getNodeByName(nom: string): TnodeClass;
     
      var
        NodesByName : TStringList;
     
     implementation
     
    // Enregistrer une classe
    procedure registerNodeByName(classe: TnodeClass);
    begin
      // Ajout de la classe si elle n'est pas déjà référencée
      if (NodesByName.IndexOf(classe.ClassName) = -1) then
      begin
        NodesByName.AddObject(classe.ClassName,TObject(classe));
      end;
    end;
     
    // Obtenir une classe par son nom
    function getNodeByName(nom: string): TnodeClass;
    var
      i : integer;
    begin
      // Recherche dans la liste des classByName
      i := NodesByName.IndexOf(nom);
      // si pas trouvé, on renvoie nil
      if (i = -1) then
      begin
        result := nil;
      end
      // si trouvé, on renvoie la classe associée
      else
      begin
        result := TnodeClass(NodesByName.objects[i]);
      end
    end;
     
      Constructor Tnode.Create(aName : String);
      Begin
        Name     := aName;
      End;
     
    { // Au début de l'application, enregistrer les classes  :
    NodesByName := TStringList.Create;
    registerNodeByName(MaClasse1);
    // Utilisation :
    ...
    getNodeByName(NomReCherche).Name
    ...
    // Fin d'application, libérer classByName
    NodesByName.Free;
    }
    end.
    ArbreBinaire
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
     
    Unit ArbreBinaire;
     
    Interface
      uses Nodes, Math;
     
    Type
      Tnoeud = class
      private
        Node : TNode ;
        gauche,droite : TNoeud ;
        constructor create(aNode : TNode) ;
        destructor  destroy ;
        procedure   ajoutGauche(aNode : Tnoeud) ;
        procedure   ajoutdroite(aNode : Tnoeud) ;
        function    egal_a(noeud2 : Tnoeud) : boolean ;
      end ;
     
      Tarbre = class
      private
         tete,courant : TNoeud;
      public
        constructor create(aNode : TNode) ;
        destructor  destroy ;
        procedure   ajouter(aName : TNoeud;G : Boolean) ;
        function    compter_noeuds(posit : TNoeud) : integer ;
        function    compter_niveaux(posit : TNoeud) : integer ;
        function    egal_a(arbre2 : Tarbre) : boolean ;
     
      end ;
     var
       Arbre : Tarbre;
       Noeud : TNoeud;
     
    implementation
      //////////////////////////////////////////////
      constructor Tnoeud.create(aNode : TNode) ;
      begin
        //Name:=aName ;
        gauche:=nil ;droite:=nil ;
      end ;
     
      destructor Tnoeud.destroy ;
      begin
        Node.free;
        if gauche<>nil then
          gauche.free;
        if droite<>nil then
          droite.free;
      end ;
     
      procedure Tnoeud.ajoutGauche(aNode : TNoeud) ;
      begin
       if gauche<>nil then
         gauche.ajoutGauche(aNode)
       else
         gauche:=Tnoeud.create(aNode) ;
      end;
     
      procedure Tnoeud.ajoutDroite(aNode : TNoeud) ;
      begin
       if droite<>nil then
         droite.ajoutDroite(aNode)
       else
         droite:=Tnoeud.create(aNode) ;
      end;
     
     function Tnoeud.egal_a(noeud2 : Tnoeud) : boolean ;
     begin
      if (self=nil) and (noeud2=nil) then
         egal_a:=true
      else
      if ((self<>nil) and (noeud2=nil)) or
         ((self=nil) and (noeud2<>nil)) or
         (Node.name<>noeud2.Node.name) then
           egal_a:=false
      else
        egal_a:=gauche.egal_a(noeud2.gauche) and droite.egal_a(noeud2.droite) ;
     end ;
     //////////////////////////////////////////////
    constructor Tarbre.create(aNode : TNode) ;
    begin
      tete:= Tnoeud.create(aNode) ;
      courant:=tete ;
    end ;
     
    destructor Tarbre.destroy ;
    begin
      courant:=nil ;
      tete.free ;
    end ;
     
     
    procedure Tarbre.ajouter(aName : TNoeud;G : Boolean) ;
    begin
      if G Then
        tete.ajoutGauche(aName)
      else
        tete.ajoutDroite(aName)  ;
    end ;
     
    function Tarbre.compter_noeuds(posit : TNoeud) : integer ;
    begin
    if posit=nil then compter_noeuds:=0
    else
       compter_noeuds:=1+compter_noeuds(posit.gauche)+compter_noeuds(posit.droite) ;
    end ;
     
    function Tarbre.compter_niveaux(posit : TNoeud) : integer ;
    var ng,nd : integer ;
    begin
     if posit=nil then
       compter_niveaux:=0
     else
       begin
         ng:=1+compter_niveaux(posit.gauche) ;
         nd:=1+compter_niveaux(posit.droite) ;
         compter_niveaux:=max(ng,nd) ;
       end ;
    end ;
     
    function Tarbre.egal_a(arbre2 : Tarbre) : boolean ;
    begin
      if (self=nil) and (arbre2=nil) then
        egal_a:=true
      else
      if (self=nil) and (arbre2<>nil) then
        egal_a:=false
      else
      if (self<>nil) and (arbre2=nil) then
        egal_a:=false
      else
        egal_a:=tete.egal_a(arbre2.tete) ;
    end ;
     
    end.

  2. #22
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Mai 2002
    Messages
    3 410
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Mai 2002
    Messages : 3 410
    Points : 5 801
    Points
    5 801
    Par défaut
    salut

    je l'ai fait a la sauvage ... c’était juste a titre d'exemple
    l’implémentation n'est pas total ni final

    normalement tu n'utilise que le Tarbre et les tnode
    les Tnoeud sont en interne pour l'arbre

    bon effectivement je devais etre fatigué quand j'ai envoyer le code ^^

    Pour les Tnoeud voici quelques corrections
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
     constructor Tnoeud.create(aNode : TNode)) ;
      begin
        Node := aNode ;
        gauche:=nil ;droite:=nil ;
      end ;
    
    
    procedure Tnoeud.ajoutDroite(aNode : TNode) ;
    begin
       if droite<>nil then
         droite.ajoutDroite(aNode)
       else
         droite:=Tnoeud.create(aNode) ;
    end;
    
     procedure Tnoeud.ajoutGauche(aNode : TNode) ;
      begin
       if gauche<>nil then
         gauche.ajoutGauche(aNode)
       else
         gauche:=Tnoeud.create(aNode) ;
      end;
    pour l'arbre
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
     Tarbre = class
      private
         tete,courant : Tnoeud ;
      public
        constructor create(aNode : TNode) ;
        destructor  destroy ;
        procedure   ajouter(aNode : TNode;G : Boolean) ;
        function    compter_noeuds(posit : Tnoeud) : integer ;
        function    compter_niveaux(posit : Tnoeud) : integer ;
        function    egal_a(arbre2 : Tarbre) : boolean ;
      end ;
    donc dans le source tu utilise l'arbre

    arbre := TArbre.create(TVideNode.create);
    ... ensuite selon le cas il te faudra faire
    arbre.ajouter(TNodeTruc.create(...),True)
    ou
    arbre.ajouter(TNodeTruc.create(...),False)
    selon que tu veuille le mettre à droite ou à gauche

    il Faut implémenter la recherche du IF parent lorsque l'on arrive a l'instruction END_IF

    il te reste beaucoup de boulot ... un interpréteur de script n'est pas quelque chose d'anodin
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  3. #23
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Bonsoir ! J'ai retravaillé mon code et je pense avoir trouvé une solution qui fonctionne. Le code pourrait probablement être bien mieux écrit mais pour l'algorithme je crois qu'il est bon.

    Je parcours une première fois le script en relevant, pour chaque condition, les informations qui vont servir par la suite. Je déclare un tableau de booléens, de même longueur que le script : ce sont les lignes à ignorer. Le tableau est initialisé à FALSE. Je parcours le script une deuxième fois, pour traiter les lignes. Quand je rencontre un "IF", j'évalue la condition et, en me servant des informations récoltées précédemment, je marque les lignes à ignorer.

    Voici le script que j'ai utilisé comme exemple :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "ExePath"
    $PATH %VAR%
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version"
    $VAR2 %VAR%
    GET "%HOST%/MONAPPLI.exe" "%TMP_PATH%"
    IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe"
    GET_FILE_VERSION "%TMP_PATH%\truc.exe"
    $UPDATE %VAR%
    IFNOT IS_EQUAL %VAR2% %UPDATE%
    PRINT "Versions différentes"
    IF IS_RUNNING "MonAppli.exe"
    KILL "MonAppli.exe"
    IF_END
    DELETE "%PATH%\MonAppli.exe"
    MOVE "%TMP_PATH%\MonAppli.exe" "%PATH%\Monappli.exe"
    SET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version" %UPDATE%
    PRINT "Enregistrement dans le registre effectué"
    PRINT "L'application a correctement été mise à jour !"
    ELSE
    PRINT "Versions à jour"
    CLOSE
    IF_END
    ELSE
    PRINT "Fichier MonAppli.exe introuvable"
    IF_END

    Et voici le résultat, c'est-à-dire les lignes traitées.

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "ExePath"
    $PATH %VAR%
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version"
    $VAR2 %VAR%
    GET "%HOST%/MONAPPLI.exe" "%TMP_PATH%"
    IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe"
    GET_FILE_VERSION "%TMP_PATH%\truc.exe"
    $UPDATE %VAR%
    IFNOT IS_EQUAL %VAR2% %UPDATE%
    PRINT "Versions différentes"
    IF IS_RUNNING "MonAppli.exe"
    KILL "MonAppli.exe"
    DELETE "%PATH%\MonAppli.exe"
    MOVE "%TMP_PATH%\MonAppli.exe" "%PATH%\Monappli.exe"
    SET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version" %UPDATE%
    PRINT "Enregistrement dans le registre effectué"
    PRINT "L'application a correctement été mise à jour !"

    Ce qui m'a donné du fil à retordre, c'est de gérer les conditions juxtaposées. Dans l'exemple, il n'y en a pas mais s'il y en avait elles seraient correctement gérées (enfin j'espère).

    Toutes les suggestions sont les bienvenues pour la réécriture plus professionnelle du code.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  4. #24
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Citation Envoyé par Roland Chastain Voir le message
    Ce qui m'a donné du fil à retordre, c'est de gérer les conditions juxtaposées. Dans l'exemple, il n'y en a pas mais s'il y en avait elles seraient correctement gérées (enfin j'espère).
    Non, je pense qu'il y a encore un problème à cet endroit.

    J'ai cru que je m'en sortirais mieux en remplaçant mon tableau de données par une liste, mais ça ne résout pas mon problème. Je bute toujours sur la même difficulté, à savoir lier à chaque enregistrement l'index de l'enregistrement correspondant à la condition enveloppante (en espérant que je me fasse comprendre ). Dans le code suivant, l'enregistrement est lié à l'enregistrement précédent, ce qui fonctionne par chance parce que le script est simple.

    Si j'aurais su, j'aurais pas venu.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  5. #25
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    J'ai repris le problème du début. Pour parcourir le code, j'ai finalement opté pour une fonction récursive. Voici mon code. La valeur des conditions n'est pas encore gérée mais le plus dur est fait.

    Voici le fichier de départ ("002.txt") :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    01
    if 02
      03
      04
      if 05
        if 06
          07
        else 08
          09
          10
        end 11
        12
      else 13
        14
      end 15
      if 16
        17
      else 18
        19
      end 20
    else 21
      if 22
        23
      else 24
        25
      end 26
      if 27
        28
      else 29
        if 30
          31
        else 32
          33
        end 34
        35
        36
      end 37
    end 38
    39
    40
    41
    if 42
      43
    else 44
      45
    end 46
    if 47
      48
    else 49
      if 50
        51
      else 52
        53
      end 54
      55
    end 56
    57
    58

    Et le résultat :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    i =  0 ; if =  5 ; else =  7 ; end = 10
    i =  1 ; if =  4 ; else = 12 ; end = 14
    i =  2 ; if = 15 ; else = 17 ; end = 19
    i =  3 ; if = 21 ; else = 23 ; end = 25
    i =  4 ; if = 29 ; else = 31 ; end = 33
    i =  5 ; if = 26 ; else = 28 ; end = 36
    i =  6 ; if =  1 ; else = 20 ; end = 37
    i =  7 ; if = 41 ; else = 43 ; end = 45
    i =  8 ; if = 49 ; else = 51 ; end = 53
    i =  9 ; if = 46 ; else = 48 ; end = 55

    Attention la numérotation des lignes commence à zéro !

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    program Interpreter1;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    uses
      System.SysUtils, System.Classes;
     
    function Match(const s, substr: string): boolean;
    begin
      result := Pos(substr, s) > 0;
    end;
     
    type
      PData = ^TData;
      TData = record
        iIf,
        iElse,
        iEnd: integer;
      end;
     
    var
      script, debug: TStringList;
      data: TList;
      line: integer;
     
    function FindData(const aLine: integer): integer;
    var
      l: integer;
      p: PData;
    begin
      New(p);
     
      p^.iIf := aLine;
      p^.iElse := 0;
      p^.iEnd := 0;
     
      l := aLine + 1;
     
      while not Match(script.Strings[l], 'end') do
        if Match(script.Strings[l], 'if') then
        begin
          l := FindData(l); (* Appel récursif *)
        end else
        begin
          if Match(script.Strings[l], 'else') then
            p^.iElse := l
          else
            debug.Add(script.Strings[l]);
          Inc(l);
        end;
     
      p^.iEnd := l;
      data.Add(p);
     
      result := l + 1;
    end;
     
    var
      i: integer;
     
    begin
      script := TStringList.Create;
      debug := TStringList.Create;
      data := TList.Create;
     
      script.LoadFromFile('002.txt');
     
      line := 0;
      while line < script.Count do
      begin
        if Match(script.Strings[line], 'if') then
        begin
          line := FindData(line);
        end else
        begin
          debug.Add(script.Strings[line]);
          Inc(line);
        end;
      end;
     
      debug.SaveToFile('003.txt');
     
      debug.Clear;
     
      for i := 0 to data.Count - 1 do
        with PData(data.Items[i])^ do
          debug.Add(Format(
            'i = %2d ; if = %2d ; else = %2d ; end = %2d',
            [i, iIf, iElse, iEnd]
          ));
     
      debug.SaveToFile('004.txt');
     
      script.Free;
      debug.Free;
      data.Free;
    end.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  6. #26
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Et voici la même avec la gestion de la valeur des conditions. Finalement les informations recueillies ne sont pas utilisées : les lignes sont exécutées sur le champ.
    Donc le code relatif à la liste et à son contenu peut être supprimé.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    program Interpreter2;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    uses
      System.SysUtils, System.Classes;
     
    function Match(const s, substr: string): boolean;
    begin
      result := Pos(substr, s) > 0;
    end;
     
    function Eval(aLine: string): boolean;
    begin
      result := TRUE;
    end;
     
    type
      PData = ^TData;
      TData = record
        iIf,
        iElse,
        iEnd: integer;
      end;
     
    var
      script, debug: TStringList;
      data: TList;
      line: integer;
     
    procedure Execute(const aLine: string);
    begin
      debug.Add(aLine);
    end;
     
    function FindData(const aLine: integer; aInherited: boolean): integer;
    var
      l: integer;
      p: PData;
      v: boolean;
    begin
      New(p);
     
      p^.iIf := aLine;
      p^.iElse := 0;
      p^.iEnd := 0;
     
      v := aInherited and Eval(script.Strings[aLine]);
     
      l := aLine + 1;
     
      while not Match(script.Strings[l], 'end') do
        if Match(script.Strings[l], 'if') then
        begin
          l := FindData(l, v);
        end else
        begin
          if Match(script.Strings[l], 'else') then
          begin
            p^.iElse := l;
            v := aInherited and not v;
          end else
            if v then
              Execute(script.Strings[l]);
          Inc(l);
        end;
     
      p^.iEnd := l;
      data.Add(p);
     
      result := l + 1;
    end;
     
    var
      i: integer;
     
    begin
      script := TStringList.Create;
      debug := TStringList.Create;
      data := TList.Create;
     
      script.LoadFromFile('002.txt');
     
      line := 0;
      while line < script.Count do
      begin
        if Match(script.Strings[line], 'if') then
        begin
          line := FindData(line, TRUE);
        end else
        begin
          Execute(script.Strings[line]);
          Inc(line);
        end;
      end;
      debug.SaveToFile('003.txt');
     
      script.Free;
      debug.Free;
      data.Free;
    end.
    Le fichier de départ est le même que pour le programme précédent. Voici le résultat, c'est-à-dire les lignes qui seraient exécutées si toutes les conditions étaient vraies :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    01
      03
      04
          07
        12
        17
    39
    40
    41
      43
      48
    57
    58

    P.-S. En pièce jointe la version courte (sans le code de débogage).
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  7. #27
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Mai 2002
    Messages
    3 410
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Mai 2002
    Messages : 3 410
    Points : 5 801
    Points
    5 801
    Par défaut
    salut

    effectivement tu gère parfaitement le if même avec les différent level sauf que tu as fait une toutes petite coquille dans ton code


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    program PrjInterpreter;
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    uses
      System.SysUtils,
      System.Classes,
      System.Math;
    
    type
      TData = record
        iIf,
        iElse,
        iEnd,
        iLevel,
        iLastIndex,
        iIndex : integer;
      end;
    
    var
      list1, list2: TStringList;
      data: TList;
      pdata: ^TData;
      index, maxindex: integer;
      level, maxlevel: integer;
      i, j, k: integer;
    
    begin
      list1 := TStringList.Create;
      list2 := TStringList.Create;
    
      list1.LoadFromFile('script.txt');
    
      data := TList.Create;
      (*
        Un boolean pour chaque ligne du script, initialisé à FALSE (c'est-à-dire
        qu'a priori on traitera toutes les lignes.
      *)
      index := -1;
      maxindex := 0;
      level := 0;
      maxlevel := 0;
    
      New(pdata);
      pdata^.iIf    := 0;
      pdata^.iElse  := 0;
      pdata^.iEnd   := 0;
      pdata^.iLevel := level;
      pdata^.iLastIndex := index;
      index := data.Add(pdata);
      TData(data.Items[index]^).iIndex := index;
    
     for i := 0 to list1.Count - 1 do
     begin
        if      (Pos('IF'    ,trim(list1.Strings[i])) > 0)
        and not (Pos('IF_END',trim(list1.Strings[i])) > 0) then
        begin
          Inc(level);
          maxlevel := Max(level, maxlevel);
          New(pdata);
          pdata^.iIf := i;
          pdata^.iElse := 0;
          pdata^.iEnd := 0;
          pdata^.iLevel := level;
          pdata^.iLastIndex := index;
          index := data.Add(pdata);
          TData(data.Items[index]^).iIndex := index;
        end;
    
        if Pos('ELSE', trim(list1.Strings[i])) > 0 then
        begin
          TData(data.Items[index]^).iElse := i;
        end;
    
        if Pos('IF_END', trim(list1.Strings[i])) > 0 then
        begin
       //   pdata^.iEnd := i; ton erreur été ici 
          TData(data.Items[index]^).iEnd := i;
          index := TData(data.Items[index]^).iLastIndex;
          Dec(level);
        end;
         list2.Add(list1.Strings[i]+Format(' %d',[TData(data.Items[index]^).ilevel]));
      end;
    
      for i := 0 to data.Count - 1 do
      begin
        pdata := data.Items[i];
        with pdata^ do
        list2.Add(Format(
          '%2d %2d %2d %2d %2d %2d',
          [iIndex,iLastIndex,iLevel,iIf,iElse,iEnd ]
        ));
      end;
    
      list2.SaveToFile('list2.txt');
    
      list1.Free;
      list2.Free;
    end.
    voici le resultat que j'obtiens
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "ExePath" 0
    $PATH %VAR% 0
    GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version" 0
    $VAR2 %VAR% 0
    GET "%HOST%/MONAPPLI.exe" "%TMP_PATH%" 0
    IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe" 1
    GET_FILE_VERSION "%TMP_PATH%\truc.exe" 1
    $UPDATE %VAR% 1
    IFNOT IS_EQUAL %VAR2% %UPDATE% 2
    PRINT "Versions différentes" 2
    IF IS_RUNNING "MonAppli.exe" 3
    KILL "MonAppli.exe" 3
    IF_END 2
    IF IS_RUNNING "MonAppli.exe" 3
    KILL "MonAppli.exe" 3
    ELSE 3
    KILL "MonAppli.exe" 3
    IF_END 2
    DELETE "%PATH%\MonAppli.exe" 2
    MOVE "%TMP_PATH%\MonAppli.exe" "%PATH%\Monappli.exe" 2
    SET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version" %UPDATE% 2
    PRINT "Enregistrement dans le registre effectué" 2
    PRINT "L'application a correctement été mise à jour !" 2
    ELSE 2
    PRINT "Versions à jour" 2
    CLOSE 2
    IF_END 1
    ELSE 1
    PRINT "Fichier MonAppli.exe introuvable" 1
    IF_END 0
    0 -1 0 0 0 0
    1 0 1 5 27 29
    2 1 2 8 23 26
    3 2 3 10 0 12
    4 2 3 13 15 17
    PS je viens de voir tes nouvelle publication je regarde ça après
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  8. #28
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    @anapurna

    Merci pour le test et les corrections.

    Je crois que cette version du code n'aurait pas géré correctement un script plus compliqué, alors que la dernière version que j'ai postée le fait, semble-t-il, et avec un code plus simple.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  9. #29
    Invité
    Invité(e)
    Par défaut
    Bonjour,

    IF 1, IF 2... C'est effectivement une approche fonctionnelle originale
    Autres pistes :
    • Si les indirections étaient possibles en Delphi, on pourrait en effet utiliser facilement (avec une seule déclaration) IF_X. Mais elles ne le sont pas
    • Sinon, une approche linéaire (une lecteur séquentielle) ligne par ligne des instructions (notamment des IF ELSE) ne me paraît pas indiquée du tout.
    • Je préconiserais plutôt l'utilisation des RegEx pour détecter et traiter les imbrications alors écrites naturellement (IF IF ELSE ENDIF ELSE ENDIF)... J'ai procédé ainsi pour ma méthode HTMLtoRTF où on rencontre une forte concentration d'imbrications. Cependant pour éviter tout blocage, il faut vérifier en premier traitement la structure du document et si possible corriger automatiquement les erreurs... et cela me laisse perplexe. En HTML, c'est simple. Mais là
      OK
      Autorisé ou pas ?
      Bref, c'est la syntaxe (sa permissivité) qui décide... Il faut évidemment déclarer votre jeu de mots clé (comme dans tout langage). Le reste est des variables à interpréter (commandes DOS, noms de fichiers...). En résumé, on perd du temps certainement au départ mais une fois ceci fait, le traitement devient sommaire et facile.

    C'est un excellent sujet d'étude : la création d'un pseudo-langage. Mon emploi du temps ne me permet pas de participer plus que cela, malheureusement... Mais oui, c'est vraiment un bon sujet. Bonne continuation.
    Cordialement. Gilles
    Dernière modification par Invité ; 01/03/2015 à 11h13.

  10. #30
    Membre averti Avatar de pascalCH
    Homme Profil pro
    Formateur en informatique
    Inscrit en
    Juillet 2006
    Messages
    187
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 66
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Formateur en informatique
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Juillet 2006
    Messages : 187
    Points : 369
    Points
    369
    Par défaut
    Citation Envoyé par cedr Voir le message
    Le problème est que le programme actuel utilise déjà cette syntaxe pour son fichier script (programme dont je n'ai pas les sources et qui ne fonctionne pas sous Win 2008) donc je dois faire avec...

    Le but n'est pas de remplacer tous les programmes de mises à jour que j'utilise dans tous les environnements mais uniquement dans les environnements qui posent problème (en tout cas dans un premier temps) et donc en gardant le même fichier de définition du script.
    Je vais mettre les pieds dans le plat mais ....

    Pourquoi ne pas utiliser PowerShell et créer un WSH qui embarque toutes les possibilités nécessaires (et bien d'autres) ?

    Ce qui n'enlève rien - au contraire - à l'intérêt du sujet !!
    La nature fait des choses extraordinaires, observons la et restons humble, on ne nous demande pas de refaire le monde mais juste de reproduire virtuellement des choses existantes ....

    et n'oubliez pas si vous aimez et quand vous avez la réponse

  11. #31
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Comme Gilles le suggère, on pourrait utiliser des expressions régulières. Les utiliser pour repérer les imbrications, je n'y avais pas pensé. Ce serait amusant d'essayer. En attendant voici un très simple exemple qui montre comment une expression régulière peut servir à distinguer un "IF" d'un "IFNOT" ou d'un "IF_END".

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    program InterpreterUtils1;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    {$ASSERTIONS ON}
     
    uses
      System.SysUtils, System.RegularExpressions;
     
    var
      e: TRegEx;
     
    begin
      e := TRegEx.Create('IF\s');
     
      Assert(e.IsMatch('IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe"'));
      Assert(not e.IsMatch('IFNOT IS_EQUAL %VAR2% %UPDATE%'));
      Assert(not e.IsMatch('IF_END'));
    end.
    @cedr

    Quelle est ta version de Delphi ?
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  12. #32
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Un autre exemple plus sophistiqué :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
     
    program InterpreterUtils2;
    {$APPTYPE CONSOLE}
     
    uses
      SysUtils, Classes, RegularExpressions;
     
    function FileToStr(const aFileName: string): string;
    var
      s: utf8string;
    begin
      with TFileStream.Create(aFileName, fmOpenRead) do
      begin
        SetLength(s, Size);
        Read(s[1], Length(s));
        Free;
      end;
      result := string(s);
    end;
     
    var
      gList: TStringList;
     
    procedure TestRegEx(const aSubject, aRegEx: string);
    var
      regexpr: TRegEx;
      match: TMatch;
      i: integer;
    begin
      regexpr := TRegEx.Create(aRegEx, []);
      match := regexpr.Match(aSubject);
      while match.Success do
      begin
        gList.Add('Match : [' + match.Value + ']');
        for i := {0} 1 to match.Groups.Count - 1 do
          gList.Add('Group[' + IntToStr(i) + '] : [' + match.Groups.Item[i].Value + ']');
        match := match.NextMatch;
      end;
    end;
     
    const
      X = '([a-zA-Z0-9_"%\\\.]*)';
      A = '\h' + X;
      B = '\h?' + X;
      IF_PATTERN = 'IF(NOT)?' + A + A + B;
    var
      s: string;
     
    begin
      s := FileToStr('script.txt');
      gList := TStringList.Create;
      TestRegEx(s, IF_PATTERN);
      gList.SaveToFile('output.txt');
      gList.Free;
    end.
    Résultat :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Match : [IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe"]
    Group[1] : []
    Group[2] : [FILE_EXIST]
    Group[3] : ["%TMP_PATH%\MONAPPLI.exe"]
    Group[4] : []
    Match : [IFNOT IS_EQUAL %VAR2% %UPDATE%]
    Group[1] : [NOT]
    Group[2] : [IS_EQUAL]
    Group[3] : [%VAR2%]
    Group[4] : [%UPDATE%]
    Match : [IF IS_RUNNING "MonAppli.exe"]
    Group[1] : []
    Group[2] : [IS_RUNNING]
    Group[3] : ["MonAppli.exe"]
    Group[4] : []
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  13. #33
    Invité
    Invité(e)
    Par défaut
    Bonjour Roland,
    Il y en a au moins un qui s'éclate-là

    De manière anecdotique et pour info :
    Dans mes méthodes de conversions de texte enrichi, j'ai panaché l'utilisation de matches lazy/greedy compte tenu de leur différence de mode de fonctionnement.

    Le plus fonctionnel -le plus respectueux- est (encore) le C++/Qt... alors que j'en avais pas besoin car en Qt, on peut travailler intégralement en HTML (Memos<->Grid<->Blob->Print) sans être obligé de passer par du RTF. Mais comme je découvre toujours Qt/C++, qu'il m'a séduit, tout ce qui me tombe sous la main, je teste... avant de prendre une décision.

    Les Grids en Windev n'affichent que du RTF alors que tout le reste peut fonctionner nativement en HTML. Donc la conversion est obligatoire si on prend comme référence le HTML. En Delphi, c'est également obligatoire mais même avec les RegEx, ce n'est "qu'en devenir" avec TMS (on va être gentil aujourd'hui) et il y a un format supplémentaire, propriétaire, le "RTE". Enfin en Lazarus, rien n'existe en Grid sauf un ersatz perso et pas de print concluant (ou en devenir -peut-être- l'arlésienne future version Lazarus de FastReport).

    Delphi au niveau des RegEx s'en tire également bien mais n'est pas aussi respectueux des règles et jusqu'à récemment buggé mais peu gênant car le bug n'était pas "usité"... Idem pour la dernière lib Lazarus parce que la première... beurk...

    Et Windev, mon 3ème (par ordre alphabétique) environnement de développement, est "particulier" au niveau de la gestion des expressions régulières... Mais comme d'habitude, il s'en sort autrement. Il dispose de 2 procédures HTMLVersRTF et RTFVersHTML assez fonctionnelles dont l'une est légèrement bugée, mais j'ai réalisé un correctif d'abord avec une Dll lazarus que j'avais sous la main puis ensuite directement en WLangage.

    Alors re bonne continuation et bonne fin de WE.
    Dernière modification par Invité ; 01/03/2015 à 17h33.

  14. #34
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    Bonsoir Gilles !

    Les choses dont tu parles me dépassent un peu... Mais si tu as des exemples de code en Pascal basé sur les expressions régulières, n'hésite pas à l'occasion à les partager avec nous.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  15. #35
    Membre expert
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    Décembre 2006
    Messages
    2 339
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : Décembre 2006
    Messages : 2 339
    Points : 3 107
    Points
    3 107
    Par défaut
    Bonjour,
    intéressé comme Roland par ce post, j'ai écrit aussi un petit programme qui décode les if imbriqués et donne la liste des instructions à exécuter en séquence.

    Je ne sais pas si c'est la même méthode que celle de Roland : Je charge le script (Bouton1), puis je liste les IF, IFNOT, ELSE et IF_END, avec leur niveau d'imbrication (bouton 2). Puis j'utilise un booléen pour chaque instruction que je mets à False si l'instruction ne doit pas être exécutée. Il suffit alors de lister les seules instructions qui sont à True (Bouton 3).

    Comme je ne peux pas évaluer les conditions des IF ou IFNOT, un radioButton permet de les mettre toutes à True ou False.

    Voici le code qui est évidement perfectible ...

    Script.zip

    A+

    Charly

  16. #36
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    @Charly910

    Il y a pas de mal de choses intéressantes dans ton code (comme des exemples d'utilisation de certaines fonctions).

    Autrement, oui, pour la méthode, c'est la même, si ce n'est que finalement je parcours le code une seule fois, au lieu de séparer les étapes comme j'avais fait au début.

    Voici la synthèse de mes exemples précédents.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    program Interpreter3;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    uses
      System.SysUtils, System.Classes, System.RegularExpressions;
     
    const
      PATTERN1 =
        '([a-zA-Z0-9_"%$\\\.]*)' + '\h?' +
        '([a-zA-Z0-9_"%$\\\.]*)' + '\h?' +
        '([a-zA-Z0-9_"%$\\\.]*)' + '\h?' +
        '([a-zA-Z0-9_"%$\\\.]*)';
      PATTERN2 =
        'PRINT (".*")';
     
    var
      script, debug: TStringList;
     
    function Eval(aLine: string): boolean;
    var
      r: TRegEx;
      m: TMatch;
      i: integer;
    begin
      WriteLn('EVAL ', aLine);
     
      r := TRegEx.Create(PATTERN1, []);
     
      m := r.Match(aLine);
     
      while m.Success do
      begin
        debug.Add('EVAL [' + m.Value + ']');
        for i := 1 to m.Groups.Count - 1 do
          debug.Add('  [' + IntToStr(i) + '][' + m.Groups.Item[i].Value + ']');
        m := m.NextMatch;
      end;
     
      (* à compléter *)
      result := TRUE;
    end;
     
    procedure Execute(const aLine: string);
    var
      r: TRegEx;
      m: TMatch;
      i: integer;
    begin
      WriteLn('EXEC ', aLine);
     
      if TRegex.IsMatch(aLine, 'PRINT') then
        r := TRegEx.Create(PATTERN2, [])
      else
        r := TRegEx.Create(PATTERN1, []);
     
      m := r.Match(aLine);
     
      while m.Success do
      begin
        debug.Add('EXEC [' + m.Value + ']');
        for i := 1 to m.Groups.Count - 1 do
          debug.Add('  [' + IntToStr(i) + '][' + m.Groups.Item[i].Value + ']');
        m := m.NextMatch;
      end;
     
      (* à compléter *)
    end;
     
    function Evaluate_And_Execute(const aLine: integer; aInherited: boolean): integer;
    var
      l: integer;
      v: boolean;
    begin
      l := aLine + 1;
     
      v := aInherited and Eval(script.Strings[aLine]);
     
      while not TRegEx.IsMatch(script.Strings[l], 'IF_END') do
        if TRegEx.IsMatch(script.Strings[l], 'IF') then
        begin
          l := Evaluate_And_Execute(l, v);
        end else
        begin
          if TRegEx.IsMatch(script.Strings[l], 'ELSE') then
            v := aInherited and not v
          else
            if v then
              Execute(script.Strings[l]);
          Inc(l);
        end;
     
      result := l + 1;
    end;
     
    var
      i: integer;
     
    begin
      script := TStringList.Create;
      debug := TStringList.Create;
     
      script.LoadFromFile('script.txt');
     
      i := 0;
      while i < script.Count do
      begin
        if TRegEx.IsMatch(script.Strings[i], 'IF[N\h]') then
        begin
          i := Evaluate_And_Execute(i, TRUE);
        end else
        begin
          Execute(script.Strings[i]);
          Inc(i);
        end;
      end;
     
      debug.SaveToFile('debug.txt');
     
      script.Free;
      debug.Free;
     
      ReadLn;
    end.
    Voici le résultat :

    Code X : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    EXEC [GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "ExePath"]
      [1][GET_REG_KEY]
      [2]["HKEY_CURRENT_USER\SOFTWARE\MONAPPLI"]
      [3]["ExePath"]
      [4][]
    EXEC [$PATH %VAR%]
      [1][$PATH]
      [2][%VAR%]
      [3][]
      [4][]
    EXEC [GET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version"]
      [1][GET_REG_KEY]
      [2]["HKEY_CURRENT_USER\SOFTWARE\MONAPPLI"]
      [3]["Version"]
      [4][]
    EXEC [$VAR2 %VAR%]
      [1][$VAR2]
      [2][%VAR%]
      [3][]
      [4][]
    EXEC [GET "%HOST%]
      [1][GET]
      [2]["%HOST%]
      [3][]
      [4][]
    EXEC [MONAPPLI.exe" "%TMP_PATH%"]
      [1][MONAPPLI.exe"]
      [2]["%TMP_PATH%"]
      [3][]
      [4][]
    EVAL [IF FILE_EXIST "%TMP_PATH%\MONAPPLI.exe"]
      [1][IF]
      [2][FILE_EXIST]
      [3]["%TMP_PATH%\MONAPPLI.exe"]
      [4][]
    EXEC [GET_FILE_VERSION "%TMP_PATH%\truc.exe"]
      [1][GET_FILE_VERSION]
      [2]["%TMP_PATH%\truc.exe"]
      [3][]
      [4][]
    EXEC [$UPDATE %VAR%]
      [1][$UPDATE]
      [2][%VAR%]
      [3][]
      [4][]
    EVAL [IFNOT IS_EQUAL %VAR2% %UPDATE%]
      [1][IFNOT]
      [2][IS_EQUAL]
      [3][%VAR2%]
      [4][%UPDATE%]
    EXEC [PRINT "Versions différentes"]
      [1]["Versions différentes"]
    EVAL [IF IS_RUNNING "MonAppli.exe"]
      [1][IF]
      [2][IS_RUNNING]
      [3]["MonAppli.exe"]
      [4][]
    EXEC [KILL "MonAppli.exe"]
      [1][KILL]
      [2]["MonAppli.exe"]
      [3][]
      [4][]
    EXEC [DELETE "%PATH%\MonAppli.exe"]
      [1][DELETE]
      [2]["%PATH%\MonAppli.exe"]
      [3][]
      [4][]
    EXEC [MOVE "%TMP_PATH%\MonAppli.exe" "%PATH%\Monappli.exe"]
      [1][MOVE]
      [2]["%TMP_PATH%\MonAppli.exe"]
      [3]["%PATH%\Monappli.exe"]
      [4][]
    EXEC [SET_REG_KEY "HKEY_CURRENT_USER\SOFTWARE\MONAPPLI" "Version" %UPDATE%]
      [1][SET_REG_KEY]
      [2]["HKEY_CURRENT_USER\SOFTWARE\MONAPPLI"]
      [3]["Version"]
      [4][%UPDATE%]
    EXEC [PRINT "Enregistrement dans le registre effectué"]
      [1]["Enregistrement dans le registre effectué"]
    EXEC [PRINT "L'application a correctement été mise à jour !"]
      [1]["L'application a correctement été mise à jour !"]

    A noter : j'ai utilisé l'unité RegularExpressions qui n'est disponible qu'à partir de Delphi XE.

    P.-S. En pièce jointe, le script qui a servi au test.
    Fichiers attachés Fichiers attachés
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  17. #37
    Membre expert
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    Décembre 2006
    Messages
    2 339
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : Décembre 2006
    Messages : 2 339
    Points : 3 107
    Points
    3 107
    Par défaut
    Bonjour,

    voici une version un peu améliorée (élimination des commentaires et des lignes vides dans le résultat, choix du script par Opendialog, affichage des conditions des IF et IFNOT, quelques blindages ...)

    Script2.zip

    Pour aller un peu plus loin, il faudrait définir la syntaxe des conditions IF et IFNOT

    A+

    Charly

  18. #38
    Membre à l'essai
    Inscrit en
    Avril 2003
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : Avril 2003
    Messages : 14
    Points : 23
    Points
    23
    Par défaut
    Bonjour et merci pour l'intérêt porté à ce sujet!

    Alors ma version de Delphi : Delphi XE

    Je n'ai pas pu me résoudre à construire un arbre binaire, j'ai donc travaillé aussi sur mon problème, et le traite de cette manière :

    Classe TIF
    type
    TIF = class(TObject)
    num : integer;
    doitExecThen : Boolean;
    doitExec : Boolean;
    doitAnalyser : Boolean;
    end;

    numniveaudeif : integer;
    l_if : TList<TIF>

    numniveaudeif := 0;

    - Création d'un objet TIF au niveau if 0 avec doitanalyser et doittraiter à true + ajout à la liste
    - Pour chaque ligne du fichier
    - Si non vide / pas de commentaires / Commande ou variable définie
    - Chargement du TIF correspondant à numniveaudeif
    - TraiteVariable pour affectation des valeurs aux variables
    - TraiteCommande(paramètre objet TIF)
    - Si commande non conditionnelle et TIF.doitExec : exécution de celle-ci
    - Si commande IF ou IFNOT (inversée pour les conditions) :
    - inc niveaudeif
    - Création nouveau TIF pour ce niveau de IF
    - Evaluation de la condition
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
     
                             inc(niveauDeIf);
     
                             IIF_loc := TIF.Create;
                             IIF_loc.num := niveauDeIf;
                             IIF_loc.doitAnalyser := false;
                             IIF_loc.doitExec := false;
     
                             if IIF.doitAnalyser AND IIF.doitExec then
                            begin
                                IIF_loc.doitAnalyser := true;
                                if TraiteCommande(param1, param2, param3) = true then
                                begin
                                    // Le test est vrai -> on exécute jusqu'au else ou end_if (le premier des deux)
                                    IIF_loc.doitExecThen := true;
                                    IIF_loc.doitExec := true;                
                                end
                                else
                                begin
                                   IIF_loc.doitExecThen := false;
                                   IIF_loc.doitExec := false;
                                   //IIF_loc.doitAnalyser := false;
                                end;
                            end;
     
                            l_IF.Add(IIF_loc);
    - Commande ELSE :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
     
                           if IIF.doitAnalyser then
                           begin
                             if not IIF.doitExecThen  then
                             begin
                                IIF.doitExec := true;
                             end
                             else
                                IIF.doitExec := false;
                            l_IF[niveauDeIf] := IIF;
                            end;
    - Commande IF_END :
    - On supprime l'objet TIF correspondant et décrémente le niveaudeif
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
                                  l_IF.Delete(niveauDeIf);
                                  dec(niveauDeIf);

    Je continue mes tests mais ça a l'air de passer pour l'instant...
    Avantage : un seul parcours du fichier / Devrait pouvoir gérer autant de conditions imbriquées que voulu

    Mais je lis avec attention vos codes !

  19. #39
    Rédacteur/Modérateur

    Avatar de Roland Chastain
    Homme Profil pro
    Enseignant
    Inscrit en
    Décembre 2011
    Messages
    4 062
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Moselle (Lorraine)

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Décembre 2011
    Messages : 4 062
    Points : 15 353
    Points
    15 353
    Billets dans le blog
    9
    Par défaut
    @cedr

    Je vois que tu utilises du code spécifique aux dernières versions de Delphi. Quand tu l'auras terminé, je serais curieux de voir ton programme complet (même si tu laisses en blanc le corps des procédures que l'interpréteur lance).

    @Charly910

    J'aime bien ta fonction ExtractStrings2(). J'ai cherché à résoudre ce problème de mon côté : je l'ai résolu en trichant un peu (si la ligne commence par PRINT, j'emploie une expression régulière spéciale).

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    var
      l: TStrings;
      s: string;
     
    begin
      l := TStringList.Create;
      s := 'PRINT "L''application a correctement été mise à jour !"';
     
      ExtractStrings2([' '], [' ', #09], PChar(s), l);
     
      l.SaveToFile('debug.txt');
      l.Free;
     
      //PRINT
      //"L'application a correctement été mise à jour !"
    end.
    Le problème dont je parle, c'est de faire la différence entre les espaces dans une chaîne littérale et les espaces comme séparateurs des différentes parties de la ligne. Autrement dit, il s'agit de ne pas tronçonner les chaînes littérales.
    Mon site personnel consacré à MSEide+MSEgui : msegui.net

  20. #40
    Membre à l'essai
    Inscrit en
    Avril 2003
    Messages
    14
    Détails du profil
    Informations forums :
    Inscription : Avril 2003
    Messages : 14
    Points : 23
    Points
    23
    Par défaut
    Concernant les fonctions des dernières versions de Delphi, parles-tu de l_if : TList<TIF> ?

    J'ai fait une petite fonction permettant de supprimer les caractères spéciaux de chaque ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
     
    function StripCharsInSet(S: string): string;
    var
      i, j: Integer;
      c: Set of Char;
    begin
      c := [#0 .. #9, #11, #12, #14 .. #31, #127];
      SetLength(Result, Length(S));
      j := 0;
      for i := 1 to Length(S) do
        if not(S[i] in c) then
        begin
          inc(j);
          Result[j] := S[i];
        end;
      SetLength(Result, j);
    end;
    et ensuite pour chaque ligne du fichier j'appelle la fonction explode suivante :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
     
    { * -----------------------------------------------------------------------------
      la fonction Explode retourne un tableau de chaînes. Ce sont les sous-chaînes, extraites de S, en utilisant le séparateur Separator.
      @param S Chaine à découper
      @param A Tableau de Chaine qui recevra la découpe
      @param Separators Caractères qui délimitent une chaine pour la découpe
      @param ExcludeEmpty Si True, les Chaines vides ne sont pas insérés dans le Tableau
      @param Quotes Caractères qui délimitent une chaine pour la découpe contenant des Separators, n'importe quel séparateur peut commencer et terminé une chaine, une quote doublée est considéré comme valeur un quote dans la chaine
      @param KeepSeparators Si True, A contient les chaines et les séparateurs mais pas les Quotes, sinon (par défaut) A ne contient que les Chaines.
      @param KeepTextAfterQuote Si True, le Texte entre une quote terminale d'un texte et un séparateur est conservée, la Quote comprise, sinon (par défaut) le Texte entre une quote terminale d'un texte et un séparateur est ignorées
      @return Nombre de Séparateur Trouvé (peut-être différent du nombre de chaine dans A !)
      ------------------------------------------------------------------------------ }
    function Explode(const S: string; out A: Types.TStringDynArray;
      const Separators: string; ExcludeEmpty: Boolean = False;
      const Quotes: string = ''; KeepSeparators: Boolean = False;
      KeepTextAfterQuote: Boolean = False): Integer;
    var
      iLesSep: Integer;
      iLesQuote: Integer;
     
      function IsSeparator(c: Char): Integer;
      begin
        for Result := 1 to iLesSep do
          if c = Separators[Result] then
            Exit;
     
        Result := -1;
      end;
     
      function IsQuote(c: Char): Integer;
      begin
        for Result := 1 to iLesQuote do
          if c = Quotes[Result] then
            Exit;
     
        Result := -1;
      end;
     
    var
      iStr: Integer;
      iQuote: Integer;
      iLenS: Integer;
      iLenSS: Integer;
      iLenA: Integer;
      iAdded: Integer;
      iBegin: Integer;
      Quoted: Boolean;
      DoubleQuoted: Boolean;
      AlreadyDQ: Boolean;
      QuoteConcat: string;
      iOffQuote: Integer;
      LastIsSep: Boolean;
      LastIsQ: Boolean;
      ContinueToNextSeparator: Boolean;
    begin
      iLenS := Length(S);
      iLesSep := Length(Separators);
     
      if (iLenS = 0) or (iLesSep = 0) then
      begin
        SetLength(A, 1);
        Result := 0;
        A[Result] := '';
        Exit;
      end;
     
      iLesQuote := Length(Quotes);
      for iQuote := 1 to iLesQuote do
        if IsSeparator(Quotes[iQuote]) > 0 then
          raise EParserError.CreateFmt
            ('le Délimiteur "%s" ne peut pas être un Séparateur !',
            [Quotes[iQuote]]);
     
      Result := 0;
      iQuote := 0;
      for iStr := 1 to Length(S) do
      begin
        if IsSeparator(S[iStr]) > 0 then
          inc(Result)
        else if IsQuote(S[iStr]) > 0 then
          inc(iQuote);
      end;
     
      if Odd(iQuote) then
        raise EParserError.CreateFmt('Nombre de Délimiteur Incorrect : "%d" !',
          [iQuote]);
     
      LastIsSep := IsSeparator(S[iLenS]) > 0;
      LastIsQ := IsQuote(S[iLenS]) > 0;
     
      if KeepSeparators then
        iLenA := Result * 2 + 1
      else
        iLenA := Result + 1;
      SetLength(A, iLenA);
      iLenSS := 0;
      iAdded := 0;
      Quoted := False;
      iOffQuote := 0;
      QuoteConcat := '';
      AlreadyDQ := False;
      iBegin := 1;
      if IsSeparator(S[1]) > 0 then
      begin
        if KeepSeparators then
        begin
          iBegin := 2;
          A[iAdded] := S[1];
          inc(iAdded);
        end;
      end;
     
      ContinueToNextSeparator := False;
      for iStr := iBegin to iLenS do
      begin
        if ContinueToNextSeparator and (IsSeparator(S[iStr]) <= 0) then
          Continue;
        ContinueToNextSeparator := False;
     
        if not Quoted and (IsSeparator(S[iStr]) > 0) then
        begin
          if ExcludeEmpty and (iLenSS = 0) then
          begin
            if KeepSeparators then
            begin
              A[iAdded] := S[iStr];
              inc(iAdded);
            end;
            iBegin := iStr + 1;
          end
          else
          begin
            if AlreadyDQ then
              A[iAdded] := QuoteConcat
            else
              A[iAdded] := Copy(S, iBegin, iLenSS);
     
            AlreadyDQ := False;
            inc(iAdded);
     
            if KeepSeparators and (iBegin > 0) then
            begin
              A[iAdded] := S[iStr];
              inc(iAdded);
            end
            else
            begin
              if LastIsSep and KeepSeparators and (iStr = iLenS) then
              begin
                A[iAdded] := S[iStr];
                inc(iAdded);
              end;
            end;
            iBegin := iStr + 1;
            iLenSS := 0;
          end;
        end
        else
        begin
          if IsQuote(S[iStr]) > 0 then
          begin
            if Quoted then
            begin
              Quoted := False;
              if iStr < iLenS then
              begin
                DoubleQuoted := IsQuote(S[iStr + 1]) > 0;
                if not KeepTextAfterQuote and not DoubleQuoted and
                  (IsSeparator(S[iStr + 1]) <= 0) then
                begin
                  ContinueToNextSeparator := True;
                  iQuote := iStr;
                end;
                if AlreadyDQ then
                  QuoteConcat := QuoteConcat + Copy(S, iBegin, iLenSS) +
                    IfThen(DoubleQuoted, S[iStr + 1], '')
                else
                  QuoteConcat := Copy(S, iBegin, iLenSS) +
                    IfThen(DoubleQuoted, S[iStr + 1], '');
                AlreadyDQ := AlreadyDQ or DoubleQuoted;
              end;
            end
            else
            begin
              Quoted := True;
              iBegin := iStr + 1;
              iLenSS := 0;
            end;
          end
          else
          begin
            if Quoted and (IsSeparator(S[iStr]) > 0) then
              inc(iOffQuote);
            inc(iLenSS);
          end;
        end;
      end;
     
      if iBegin <= iLenS then
      begin
        if ContinueToNextSeparator then
          A[iAdded] := Copy(S, iBegin, iQuote - iBegin)
        else if LastIsQ then
          A[iAdded] := Copy(S, iBegin, iLenS - iBegin)
        else
          A[iAdded] := Copy(S, iBegin, MaxInt);
        inc(iAdded);
     
        if LastIsSep and KeepSeparators then
        begin
          A[iAdded] := S[iLenS];
          inc(iAdded);
        end;
      end;
     
      if LastIsSep and not ExcludeEmpty then
        inc(iAdded);
     
      if iAdded < iLenA then
        A := Copy(A, 0, iAdded);
     
      Result := Result - iOffQuote;
    end;
    et enfin je transforme le TStringDynArray renvoyé en TStringList pour que ce soit plus simple à gérer...

Discussions similaires

  1. lecture d'un fichier texte vers un tableau de structure
    Par syki.mail dans le forum MATLAB
    Réponses: 2
    Dernier message: 12/06/2012, 21h38
  2. lecture d'un fichier texte
    Par benahpets dans le forum MFC
    Réponses: 5
    Dernier message: 22/06/2005, 12h50
  3. [C#] Lecture d'un fichier texte (farfelu)
    Par choas dans le forum Windows Forms
    Réponses: 3
    Dernier message: 11/04/2005, 15h33
  4. Lecture d'un fichier Texte
    Par jcharles dans le forum Bases de données
    Réponses: 8
    Dernier message: 27/10/2004, 15h58
  5. Stockage de données & lecture d'un fichier texte
    Par petitours dans le forum C++Builder
    Réponses: 6
    Dernier message: 13/03/2004, 15h05

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo