Boucle Tmemo si dossier alors Forcedir sinon... [Résolu]

Messages postés
73
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
12 mai 2013
- - Dernière réponse : f0xi
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
- 28 oct. 2012 à 16:37
Salut tout le monde,

J'ai un Tmemo avec un Bouton et si j'écrit par exemple:

css/img //dossier et sous dossier
styles.css //fichier
...


lorsque que je clique sur le bouton, j'aimerais pouvoir faire une boucle du style:

//si dans memo1 il y a un dossier alors
ForceDirectories(Memo1.Lines.Strings[i]) //sinon

//création du fichier
AssignFile(files,Memo1.Lines.Strings[i]);
ReWrite(files);
CloseFile(files);


Mon but et de pouvoir automatiser mais projet web, donc si vous aviez une idée je suis preneur...

Merci d'avance pour votre aide.
Afficher la suite 

11 réponses

Meilleure réponse
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
26
3
Merci
Salut,

Et bien comment dire, déjà tu ne semblais pas tester les lignes en entrée de Memo.

donc savoir, si l'on doit créer un dossier ou un fichier necessitait de savoir que ligne 1 un dossier et ligne 2 un fichier.

D'ou justement le besoin d'utiliser des tokens dans un script simplifié pour préciser à la procédure quoi faire.


Ensuite, dans ta routine tu ne faisait pas le distingo entre la ligne 1 et 2 forcedirectory sur 1 puis assignfile sur 1 également.
La encore, un problème pour faire interpréter à la routine, qu'est-ce qui est un dossier et qu'est-ce qui est un fichier ?

Ensuite, tu utilise une méthode un peu lourde (assignfile, rewrite, closefile) pour créer un simple fichier texte vide.
TStringList est plus simple, plus rapide et permet d'ajouter du texte prédéfini sans se prendre la tête grace à sa fonction Add()
SaveToFile() pour l'enregistré et hop. Pas besoin de géré un handle de fichier etc.

Pour finir, pas de code dans les gestionnaires d'evenements des objets (bouton, liste etc), les routines fonctionnel/de traitement, doivent être placé dans des unités et des fonctions propre, à part, aux fins d'être réutilisable, plus tard, dans d'autres programmes.
Dans un gestionnaire d'evenements on ne doit trouver que, les prés-traitement et l’appel aux fonctions de traitement :
function Traiter(aStr: string; aStrings: TStrings; out aFirst, aSecond: string): boolean;
var X: integer;
begin
  aFirst := EmptyStr;
  aSecond:= EmptyStr;
  result := false;
  for X := 0 to aStrings.Count-1 do
  begin
    if (aStrings[X] = aStr) and (aFirst = EmptyStr) then
      aFirst := aStrings[X]
    else
    if (aStrings[X] = aStr) and (aSecond = EmptyStr) then
    begin
      aSecond := aStrings[X];
      result := true;
      break;
    end;
  end;
end;

procedure TFormX.ObjectEvent(Sender: TObject);
var A, B: string;
begin
  if Traiter(Edit1.Text, Memo1.Lines, A, B) then
  begin
    Label1.caption := A;
    Label2.caption := B;
  end;
end;

L'exemple ci dessus est l'idéal à atteindre, il est réutilisable à souhait et n'est dépendant que de la classe TStrings.

L'exemple ci dessous n'est pas idéal et des dépendances par rapport au composant de l'interface.
procedure TFormX.ObjectEvent(Sender: TObject);
var A,B: string;
    X : integer;
begin
  A := '';
  B := '';
  for X := 0 to Memo1.Lines.Count-1 do
  begin
    if (Memo1.Lines[X] = Edit1.Text) and (A = '') then
      A := Memo1.Lines[X]
    else
    if (Memo1.Lines[X] = Edit1.Text) and (B = '') then
    begin
      B := Memo1.Lines[X];
      break;
    end;
  end;
  if (A <> '') and (B <> '') then
  begin
    Label1.Caption := A;
    Label2.Caption := B;
  end;
end;




________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 204 internautes nous ont dit merci ce mois-ci

Commenter la réponse de f0xi
Messages postés
248
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
0
Merci
Salut,
pour la boucle utilise For et le nombre de ligne du memo avec Lines.Count
utilise aussi DirectoryExists, FileExists etc...Voir(F1)
Un petit morceau de code avec tes essais...
@+
Commenter la réponse de cs_yanb
Messages postés
73
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
12 mai 2013
0
Merci
Salut yanb ,

j'ai essayer pour la boucle for mais comment pouvoir combiner les 2 actions exemple qui fonctionne pas:

for i := 0 to memo1.Lines.Count -1 do
  ForceDirectories(Memo1.Lines.Strings[i]);
  AssignFile(files,Memo1.Lines.Strings[i]); //pas bon sa!!
  ReWrite(files);
  CloseFile(files);
...
end;


la boucle ne fonctionne pas car c'est ou un ou l'autre dans la 2 et 3eme lignes, donc résultat des courses je me retrouve avec que des dossiers et

AssignFile n'es pas prit en compte.

j'ai penser a utiliser Pos genre :

if Pos('.',memo1.lines[i] ) > 0 then
   AssignFile(files,Memo1.Lines.Strings[i]) else
ForceDirectories(...);


le problème c'est que j'arrive pas a mettre en place la structure de la boucle donc je sèche...
Pouvez vous m'aider s'il vous plait?

Merci d'avance.
Commenter la réponse de shell13010
Messages postés
308
Date d'inscription
jeudi 29 septembre 2005
Statut
Membre
Dernière intervention
17 septembre 2013
1
0
Merci
boonsoir,

je pense que tu as oublié un begin après le for. Dans ton code original, il n'y a que la première instruction qui est dans la boucle (ForceDirectories...).

for i := 0 to memo1.Lines.Count -1 do
begin   //  <-- à ajouter
  ForceDirectories(Memo1.Lines.Strings[i]);
  AssignFile(files,Memo1.Lines.Strings[i]); //pas bon sa!!
  ReWrite(files);
  CloseFile(files);
...
end;


Luc
Commenter la réponse de beckerich
Messages postés
248
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
0
Merci
Salut,
alors si je reprend ton code il y a une structure au memo ?
1er ligne : les dossiers à créer ?
2eme ligne : le fichier à créer ?
3eme ligne : ???
Cette structure reste fixe ?
Ensuite dans ton exemple "css/img" c'est dans un répertoire par défaut ?
Dans ton code comme le dit beckerich il manque begin etc...
@+
Commenter la réponse de cs_yanb
Messages postés
248
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
0
Merci
Re,
Si tu répondais aux questions...
Ah tu regardais DirectoryExists, FileExists etc...Voir(F1)
Donc sans réponses...ton code retouché sans plus pour donner une base
for i := 0 to Memo1.Lines.Count -1 do
begin
  if Pos('.',Memo1.Lines.Strings[i]) = 0 then
    ForceDirectories(Memo1.Lines.Strings[i])
  else
  begin
    AssignFile(files,Memo1.Lines.Strings[i]); //pas bon sa!!
    ReWrite(files);
    CloseFile(files);
  end;
end;
@+
Commenter la réponse de cs_yanb
Messages postés
73
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
12 mai 2013
0
Merci
Bonsoir,

Heuu? désoler de travailler...

Mon code je les revue autrement et il fonctionne mais j'ai une erreur: Nom de Fichier Incorrect- %s

var
  Chemin: String;
  F: TextFile;
  i: Integer;
begin
  for i :=   0 to Memo1.Lines.Count - 1 do
  begin
    Chemin := IncludeTrailingPathDelimiter(Edit1.Text) + Memo1.Lines.Strings[i];
    if not DirectoryExists(extractfilepath(Chemin)) then
      ForceDirectories(extractfilepath(Chemin));
    // showmessage(extractfilepath(Chemin));
    if not FileExists(Chemin) then
    begin
      AssignFile(F, Chemin);
      // {$I-}
      ReWrite(F); Chemin Valeur Innacessible???
      Closefile(F);
    end;
  end;
end;


Et apparament après avoir débugger, il s'arrète sur Rewrite(F) ; une erreur de type EInOutError avec comme
valeur Local: Chemin = Valeur Innacessible...

Je voulais pas désactiver c'est erreur car je compte partager le projet une fois qu'il serait au point..

Une personne serait d'ou vient cette erreur?
Commenter la réponse de shell13010
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
26
0
Merci
Si je comprend bien, tu cherche à créer un générateur de fichiers et dossiers pour tes projets web


genre ça :

uses StrUtils, FileCtrl;

function CountFolder(aFolder: string): integer;
var X: integer;
begin
  result := 0;
  if length(aFolder) = 0 then
    exit;
  result := 1;
  for X := 1 to Length(aFolder) do
    if aFolder[X] = '\' then
      inc(result);
end;

{
  ## [comments]         : this line is a comment
  //[directory name]    : Create project directory
  ./[directory name/sub]: Create a sub directory (no depth limits)
  +i                    : Create an empty index file (php)
  +r                    : Create an empty robots file (txt)
  +s                    : Create an empty sitemap file (xml)
  +h                    : Create an empty htaccess file
  <<                    : Create a back to root index.php
  ||                    : Create a files locking htaccess
  [file name.extention] : Create the specified file in last created directory or project

  Sample script :

    ## SCRIPT BEGIN --------------------------------------------------
                    ## Create a new directory as project root dir
    //MyProject

                    ## Create empty defaults files in project root dir
    +i
    +r
    +s

                    ## Current dir set to //MyProject/css/
    ./css
                    ## Create empty custom file "styles.css" in "css" folder
    styles.css
                    ## Create a back to root index.php file in "css" folder
    <<

                    ## Current dir set to //MyProject/js/
    ./js
                    ## Create empty custom file "api.js" in "js" folder
    api.js
    <<

                    ## Create "img" and sub folders
    ./img
    <<
    ./img/preview
    <<
    ./img/preview/small
    <<
    ./img/preview/large
    <<

    ## SCRIPT END ---------------------------------------------------

}
procedure CreateProject(aScript: TStrings; const aDebug: boolean false; const aLogList: Tstrings nil);
var X,
    SubLevel : integer;
    EF : TStringList;
    C, T, E, F,
    RootDir,
    ProjectDir,
    CurrentDir : string;
begin
  if aDebug then
    assert(assigned(aLogList), 'Cannot set debug mode without log list.');

  if FileCtrl.SelectDirectory('Where you want to create your project ?','%%DESKTOP%%',RootDir) then
  begin
    if aDebug then
    begin
      aLogList.BeginUpdate;
      aLogList.Clear;
      aLogList.Add('START>>>');
      aLogList.Add('> Root dir set to : '+RootDir);
    end;

    EF := TStringList.Create;
    try
      projectDir := IncludeTrailingBackSlash(RootDir);
      currentDir := '';
      SubLevel   := 0;

      for x := 0 to aScript.Count - 1 do
      begin
        if length(aScript[X]) > 2 then
        begin
          C := trim(aScript[X]);
          T := copy(C, 1, 2);
          if T = '//' then // create or set project directory
          begin
            E := copy(C, 3, Length(C)-2);
            ProjectDir := IncludeTrailingBackSlash(RootDir) + IncludeTrailingBackSlash(E);
            CurrentDir := ProjectDir;
            if aDebug then
              aLogList.Add('> Project directory set to : '+ProjectDir)
            else
            if not directoryExists(ProjectDir) then
              createDir(ProjectDir);
          end
          else
          if T = './' then // create or set sub-dir of CurrentDir
          begin
            E := ReplaceStr(copy(C, 3, Length(C)-2),'/','\');
            CurrentDir := ProjectDir+IncludeTrailingBackSlash(E);
            SubLevel := countFolder(E);

            if aDebug then
            begin
              aLogList.Add('> Current directory set to : '+CurrentDir);
              aLogList.Add('  - Directory depth set to : '+intToStr(SubLevel));
            end
            else
            if not directoryExists(CurrentDir) then
              createDir(CurrentDir);
          end
          else
          if T = '||' then // create htaccess for lock all files access (forbiden access)
          begin
            F := '.htaccess';
            EF.Text := '<Files *>'#13#10+
                       '  Order Deny,Allow'#13#10+
                       '  Deny from all'#13#10+
                       '  Allow from localhost'#13#10+
                       '</Files>'#13#10#13#10;

            if aDebug then
              aLogList.Add('  - Creating files lock htaccess')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '<<' then // create index.php with back to root function
          begin
            F := 'index.php';
            EF.Text := '<?php'#13#10'header("location:'+strutils.DupeString('../', subLevel)+'");'#13#10'?>'#13#10;

            if aDebug then
              aLogList.Add('  - Creating back to root index.php')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '+i' then // create empty index.php
          begin
            F := 'index.php';
            EF.Text := '<?php'#13#10'?>'#13#10;

            if aDebug then
              aLogList.Add('  - Creating empty index file (php)')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '+r' then // create empty robots.txt
          begin
            F := 'robots.txt';
            EF.Text := #13#10#13#10;

            if aDebug then
              aLogList.Add('  - Creating empty robots file')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '+s' then // create empty sitemap.xml
          begin
            F := 'sitemap.xml';
            EF.Text := '<?xml version="1.0" standalone="yes"?>'#13#10;

            if aDebug then
              aLogList.Add('  - Creating empty sitemap file')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '+h' then // create empty htaccess file
          begin
            F := '.htaccess';
            EF.Text := #13#10#13#10;

            if aDebug then
              aLogList.Add('  - Creating empty htaccess file')
            else
              EF.SaveToFile(CurrentDir+F);
          end
          else
          if T = '##' then
          begin
            // ... comment ... //
          end
          else
          begin  // create defined file
            E := lowercase(extractFileExt(C));
            F := lowercase(extractFileName(C));
            if E = '.php' then
              EF.Text := '<?php'#13#10#13#10'?>'#13#10
            else
              EF.Text := #13#10#13#10;

            if aDebug then
              aLogList.Add('  - Creating empty custom file : '+F)
            else
              EF.SaveToFile(CurrentDir+F);
          end;
        end;
      end;
    finally
      EF.Free;
      if aDebug then
      begin
        aLogList.Add('<<<END');
        aLogList.EndUpdate;
      end;
    end;
  end;
end;


________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?
Commenter la réponse de f0xi
Messages postés
73
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
12 mai 2013
0
Merci
Bonsoir f0xi,

Merci pour ton exemple.

Oui c'est bien sa, mon projet consiste a créer une structure (fichier&dossier) pour des futur projet au lieu de le faire manuellement...

Ton code et très instructif,l'idée de tester les 2 premiers caractère prédéfini et top ,je n'y avais pas penser

par contre j'aurais aimer comprendre mon erreur dans le code car j'ai pas su trouver la solution , serait tu me dire ou j'ai foiré?
Commenter la réponse de shell13010
Messages postés
73
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
12 mai 2013
0
Merci
Bonsoir,

@Foxi :donc savoir, si l'on doit créer un dossier ou un fichier necessitait de savoir que ligne 1 un dossier et ligne 2 un fichier.

Merci de m'avoir souligner mais erreur, je comprend mieux se qu'il n'allais pas maintenant.

Tes fonction me font flipper (peut-être du a mon niveau par rapport au tiens) quand je les vois car j'ai remarquer que tu passes beaucoup de paramètre a tes fonctions alors que moi, dépassant 2 je suis a l'ouest..

Merci beaucoup pour tes exemples et ton aide détailler.
Commenter la réponse de shell13010
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
26
0
Merci
Bah c'est pas si terrible. plus tu t'entrainera à le faire, plus ça deviendra un reflexe.

c'est pas compliqué de faire par exemple :

function isInRange(aValue, aMin, aMax: integer; aInclusif: boolean): boolean;
begin
  if aInclusif then
    result := (aValue >= aMin) and (aValue <= aMax);
  else
    result := (aValue > aMin) and (aValue < aMax);  
end;


Le tout c'est de se poser les bonnes questions, par exemple :

Combien de paramètre me faut il au minimum ? 3 : la valeur, la borne mini et la borne maxi
Est-ce que je fait deux fonction, isInRange (inclusive) et isExclusiveInRange, ou je rend ma fonction souple ? oui, donc +1 parametre

ou faire des fonction multi retour :

function traiter(A, B, C: integer; out oA, oB, oC: integer): integer;

ici, les out ne sont pas justifié car de même type que A, B, C, donc c'est mieux de faire :

function traiter(var A, B, C: integer): integer;


aprés, si tu vas voir dans la plupart de mes codes sources, tu verra que souvent je note mes fonctions avec un petit commentaire sur le modèle de Microsoft, qui est très clair et précis :

{ nom_de_la_fonction
  description
   
  paramètres :
    nom_param1: [input/ouput], type, description parametre
    nom_param2: [input/ouput], type, description parametre

  retour
    type, condition/description de retour
}
function nom_de_la_fonction(nom_param1: type; nom_param2: type): type;


exemple :

{ Base64encode, Base64URLencode
  encode une donnée en base64 / Base64URL

  paramètres :
    Data     :[i] PAnsiChar, donnée à encoder
    DataSize :[i] Integer, taille de Data en octet 

  retour :
    renvois une chaine qui contient la représentation base64 de Data.
}
function Base64encode(const Data: PAnsiChar; const DataSize: integer): AnsiString;
function Base64URLencode(const Data: PAnsiChar; const DataSize: integer): AnsiString;



tu verra, ce n'est pas compliqué.


________________________________________________________
besoin de câbles audio, vidèo, informatique pas cher ?
Commenter la réponse de f0xi