Recherche fonction split

Version imprimable

04/03/2016, 11h44
joreveur

Recherche fonction split

Bonjour,

je cherche une fonction Split pour découper une chaine de caractères selon un délimiteur

merci

Yop

Quelque chose comme ça ? :
Code:

1 2 3 4 5 6 7 procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings); begin Assert(Assigned(Strings)) ; Strings.Clear; Strings.Delimiter := Delimiter; Strings.DelimitedText := Input; end;
usage :

Code:

Split(' ', ledRsyncCmd.Text, Fcmd);

Fcmd est la TStringList de destination, ledRsyncCmd est le TLabeledEdit dont on va splitter la propriété "text".

04/03/2016, 14h51
joreveur

Bonjour et merci de la réponse.

Oui une procédure de ce genre m’intéresserait, mais cependant je n'ai pas réussi à l'utiliser.

Je voulais le faire dans un programme console sans composants.

Cordialement.

salut

le fait que ce soit une appli console ne veut pas dire que tu ne peut pas utiliser de classe ni de composant
par exemple le TStringList n'est pas un composant visuel et donc dans ton cas peut très bien être utilisé

mais si tu ne veut absolument pas de composant tu peut tres bien utiliser
une boucle et remplir un array of string
Code:

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 Type TArrayStr = Array Of string; implementation function SplitString(Text: String,Delimiter : char): TArrayStr; var intIdx: Integer; intIdxOutput: Integer; begin intIdxOutput := 0; SetLength(Result, 1); Result[intIdxOutput] := ''; for intIdx := 1 to Length(Text) do begin if Text[intIdx] = Delimiter then begin intIdxOutput := intIdxOutput + 1; SetLength(Result, Length(Result) + 1); end else Result[intIdxOutput] := Result[intIdxOutput] + Text[intIdx]; end; end;

Bonjour,

Sinon, tu as l'unité StrUtils et les fonctions :

Code:

1
2
3
4
5
6
7
8
9
10
11
 
Type
  TSysCharSet = Set of AnsiChar;
  PSysCharSet = ^TSysCharSet;
 
function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
function ExtractWord(N: Integer; const S: string;  const WordDelims: TSysCharSet): string;inline;
function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
function ExtractDelimited(N: Integer; const S: string;  const Delims: TSysCharSet): string;
function ExtractSubstr(const S: string; var Pos: Integer;  const Delims: TSysCharSet): string;

Une des innombrables versions de split

Une des innombrables manières d'implémenter un split:

Code:

1
2
3
 
NB_FIELDS = 69; // nombre arbitraire de champs
type TStringArray = array[0 .. NB_FIELDS] of string;

Str: chaîne à découper
Sep: Séparateur. Pour la tabulation, utiliser #9
Retourne: Un TStringArray

Code:

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
 
function Split(const Str: string; const Sep: string):TStringArray;
var
  pn   : integer;
  ps   : integer;
  S    : string;
 
begin
  for pn:=0 to High(Result) do Result[pn]:='';
  S:=Str;
  ps:=0;
  try
    pn:=0;
    repeat
     if pn>High(Result) then Break;
     ps:=Pos(Sep, S);
     //s:=Copy(s,0, ps-1);
     Result[pn]:=Trim(Copy(s,0, ps-1));
     Inc(pn);
     s:=Copy(s, 1+ps, Length(s));
    until ps=0;
    Result[pn-1]:=Trim(s);
  except
  end;
end;

Exemple d'utilisation:

Code:

1
2
3
4
5
6
 
EWE := Split('Ta mère en short', ' ');
 
WU := EWE[1];
 
writeln(WU); // affiche 'mère'

16/03/2016, 15h07
joreveur

Bonjour et merci de ces réponses
en réalité je n'ai que fpc 3.0.0 d'installé. (Lazarus n'est pas installé)
et les bouts de programmes ne semblent pas fonctionner.
Bien à vous tous

Très basique (n'utilise que des fonctions et des types de l'unité System) :

Code:

1
2
3
4
5
6
7
8
9
10
Function Split(Const SubStr, Source: String; var HeadStr, TailStr: String):Boolean;
Var P:Integer;
Begin
   p := Pos(SubStr, Source);
   Result := P > 0;
   If Result Then Begin
     HeadStr := Copy(Source, 1, P-1);
     TailStr := Copy(Source, P + Length(Substr), Length(Source))
   end;
End;

Bonjour. Je m'excuse pour cette réponse tardive, mais j'étais "Off-Line" depuis quelques jours.

Par ailleurs, ce n'est pas une bonne idée d'avoir relancé par message privé. Il peut y avoir d'autres observateurs qui s'intéressent à ce sujet et ce n'est pas sympa d'interrompre le fil de cette discussion et les laisser sur leur faim!

Citation:

Envoyé par joreveur (Par MP)

bonjour @DomDA91

merci de m'avoir répondu :)

désolé mais je n’arrive pas à faire fonctionner ta fonction...

je voudrais découper la chaine 'bonjour;tout;va bien' comment fais-tu ?avec ta méthode ?

je pensais faire writeln(split(';','bonjour;tout;va bien'));
et stocker le résultat dans un tableau
x[1] contiendrai 'bonjour'
x[2] contiendrai 'tout'
x[3] contiendrai 'va bien'

merci.
bien cordialement

Nous comprenons bien que tu rencontre des difficultés et nous ne demandons pas mieux que de t'aider mais il faudrait que tu sois plus explicite sur la nature de ces difficultés :

Ça ne compile pas, quel message d'erreur ?
Ça compile mais il y a une erreur à l'exécution, ici aussi quel message ?
Ça compile, ça ne plante pas, mais le résultat n'est pas celui atttendu.
... etc.

Les sugestions présentés plus haut par Jipété, anpurna, TheFreeBerga, JP Cassou et moi-même sont toutes viables mais certaines formes syntaxiques ou certaines fontionnalités ne sont utilisables qu'avec certains modes de compilation de FPC. Ce ne sont donc que des pistes devant être adaptées à ton propre contexte d'utilisation.

Il serait judicieux que tu nous communique un extrait, limité mais significatif, de code que tu aurais écris, et notamment :

Usage d'une directive {$MODE ...}, (autorise ou non certaines formes syntaxiques du Pascal)
Bibliothèques utilisés (clause Uses)

Citation:

Envoyé par joreveur

je pensais faire writeln(split(';','bonjour;tout;va bien'));

Ça ne peut pas marcher comme ça.

Le problème avec une fonction telle que Split est qu'elle doit renvoyer plusieurs valeurs en retour (les différentes parties de chaîne après séparation) alors que fondamentalement en Pascal une fonction ne renvoie qu'un seul résultat. Pour contourner cette difficulté, deux solutions sont utilisables :

La fonction renvoie un type structuré (Tableau, record, object ou class) duquel on peut ensuite extraire les différents éléments de résultat (solutions proposées par Jipété, anapurna , JP Cassou).
Les résultats, outre le premier (résultat principal), sont renvoyés dans autant de paramètres Var supplémentaires qui devront correspondre à des variables string déclarées (c'est la soution que je t'ai proposée).

L'inconvénient commun de ces deux solutions est que la fonction ne peut pas être utilisée directement comme argument d'une instruction Write ou WriteLn (sortie console ou fichier Text).

En effet, dans ce cas, Write(Ln) n'admet pas que ses arguments soient de type structurés (solution 1) et dans le cas de la solution 2 ne pourra afficher que le résultat principal de la fonction, ceux renvoyés via les paramètres Var devront l'être par des arguments ou instructions Write(Ln) séparés.

Compte tenu de ce que tu indique dans ton dernier message, je pense que la meilleure solution serait celle proposée par anpurna. Elle permet de gérer des chaines comportant un nombre N quelconque de séparateurs, générant un nombre N+1 de sous-chaînes.
Voici un petit programme de démo qui met en oeuvre la fonction SplitString d'anapurna. Tu peux constater que c'est vraiment très simple.
Code:

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 program SplitDemo; {$mode fpc} {uses ; tout est dans l'unité System!!} Type TArrayStr = Array Of string; function SplitString(Text: String; Delimiter : char): TArrayStr; var intIdx: Integer; intIdxOutput: Integer; // en $MODE fpc, Result n'est pas reconnu comme mot réservé Result: TArrayStr; // Result est ici une variable locale ordinaire begin intIdxOutput := 0; SetLength(Result, 1); Result[intIdxOutput] := ''; for intIdx := 1 to Length(Text) do begin if Text[intIdx] = Delimiter then begin intIdxOutput := intIdxOutput + 1; SetLength(Result, Length(Result) + 1); end else Result[intIdxOutput] := Result[intIdxOutput] + Text[intIdx]; end; // affecte la valeur de Result au résultat de la fonction SplitString := Result end; Var Strlst: TArrayStr; I : Integer; Txt: String; begin WriteLn('Bonjour!'); Write('Saisissez un texte (separateur : '';'' : '); ReadLn(Txt); Strlst := SplitString(Txt, ';'); For I := 0 To Length(Strlst) -1 Do WriteLn(I+1,' = ', Strlst[I]); Readln end.

Salut,

Citation:

Envoyé par DomDA91

Compte tenu de ce que tu indique dans ton dernier message, je pense que la meilleure solution serait celle proposée par anpurna. Elle permet de gérer des chaines comportant un nombre N quelconque de séparateurs, générant un nombre N+1 de sous-chaînes.
Voici un petit programme de démo qui met en oeuvre la fonction SplitString d'anapurna. Tu peux constater que c'est vraiment très simple.

Je n'ai rien contre la solution d'Anapurna, mais la mienne fonctionne également en mode console, je viens de tester sous FreePascal pur et dur dans un nouveau projet :
Code:

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 program test1; uses Classes; procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings); begin Assert(Assigned(Strings)) ; Strings.Clear; Strings.Delimiter := Delimiter; Strings.DelimitedText := Input; end; var I : Integer; Txt: String; List: TStringList; begin WriteLn('Bonjour!'); Write('Saisissez un texte (separateur : '';'') : '); ReadLn(Txt); List := TStringList.Create; Split(';', Txt, List); for i := 0 to List.Count-1 do WriteLn(I+1,' = ', List[i]); Readln(); List.Free; end;
Code:

1 2 3 4 5 6 7 # ./test1 Bonjour! Saisissez un texte (separateur : ';') : toto;titi;tata;turlututu 1 = toto 2 = titi 3 = tata 4 = turlututu

Bonjour

Citation:

Envoyé par DomDA91

Bonjour. Je m'excuse pour cette réponse tardive, mais j'étais "Off-Line" depuis quelques jours.

Par ailleurs, ce n'est pas une bonne idée d'avoir relancé par message privé. Il peut y avoir d'autres observateurs qui s'intéressent à ce sujet et ce n'est pas sympa d'interrompre le fil de cette discussion et les laisser sur leur faim!

Nous comprenons bien que tu rencontre des difficultés et nous ne demandons pas mieux que de t'aider mais il faudrait que tu sois plus explicite sur la nature de ces difficultés :

Ça ne compile pas, quel message d'erreur ?
Ça compile mais il y a une erreur à l'exécution, ici aussi quel message ?
Ça compile, ça ne plante pas, mais le résultat n'est pas celui atttendu.
... etc.

Les sugestions présentés plus haut par Jipété, anpurna, TheFreeBerga, JP Cassou et moi-même sont toutes viables mais certaines formes syntaxiques ou certaines fontionnalités ne sont utilisables qu'avec certains modes de compilation de FPC. Ce ne sont donc que des pistes devant être adaptées à ton propre contexte d'utilisation.

Il serait judicieux que tu nous communique un extrait, limité mais significatif, de code que tu aurais écris,[..]

Bonjour @DomDA91
merci pour tes remarques...
voici mon code mais je ne passais pas par une fonction je compile par fpc split1.pas
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 program split1; const sep=';'; var p,i:integer; c:array[1..100] of string; a:string; begin write('chaine ? '); readln(a); i:=0; repeat inc(i); p:=pos(sep,a); c[i]:=copy(a,1,p-1); a:=copy(a,p+1,length(a)-p); if p=0 then c[i]:=a; writeln(c[i]); until p=0; writeln; writeln('Enter pour quitter'); readln; end.
Concernant les autres points des autres utilisateurs je vais regarder cela et répondre plus tard. (plus trop de temps là)
cordialement.

22/03/2016, 10h55
DomDA91

Citation:

Envoyé par Jipété

Je n'ai rien contre la solution d'Anapurna, mais la mienne fonctionne également en mode console, je viens de tester sous FreePascal pur et dur dans un nouveau projet :

J'avais également fait ce test de ta solution. Mais si j'ai choisi d'illustrer celle d'Anapurna c'est parce-qu'elle ne dépend d'aucune unité autre que System. Elle fonctionne même avec des environnement d'exécution aussi simplifié que celui de MyPascal.
22/03/2016, 12h28
Jipété

Citation:

Envoyé par DomDA91

J'avais également fait ce test de ta solution. Mais si j'ai choisi d'illustrer celle d'Anapurna c'est parce-qu'elle ne dépend d'aucune unité autre que System.

Cette remarque m'ayant mis la puce à l'oreille, je viens de refaire un essai, et en fait mon test ne dépend que de Classes; (du coup j'édite mon post d'hier).
Le .o généré par ppc386 test1 pèse 5,3 ko (ridicule !), le binaire (suis sous Linux) presque 500 ko (quand même, hein !)

Bonjour
merci de tous ces exemples.
j'ai essayé d'écrire cette procédure. Pouvez-vous me donner votre avis ?

Bien cordialement.

Code:

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
program split3;
const sep=';';
var a:string;
nbr,i:integer;
c:array[1..100] of string;
 
procedure split(a:string);
var p:integer;
begin
  nbr:=0;
  repeat
    inc(nbr);
    p:=pos(sep,a);
    c[nbr]:=copy(a,1,p-1);
    a:=copy(a,p+1,length(a)-p);
    if p=0 then c[nbr]:=a;
  until p=0;
end;
 
begin
  write('chaine  ? ');
  readln(a); 
  split(a);
  for i:=1 to nbr do
    writeln(c[i]);
  writeln;
  writeln('Enter pour quitter');
  readln;
end.

salut

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
procedure split(a:string);
var p:integer;
begin
  nbr:=0;
  repeat
    inc(nbr);
    p := pos(sep,a);
    if p > 0 Then  
    Begin 
    
      c[nbr] := copy(a,1,p-1) ;<=== J'ai un gros doute ici si p = 0  
      a := copy(a,p+1,length(a)-p);
       
    end 
    else 
      c[nbr]:=a;
   
    
         if p=0 then 
            c[nbr]:=a;
    
  until p=0;
end;

voila je pense que cela fonctionnera mieux surtout pour le dernier item

Bonjour @anapurna,
oui tu as raison ! malgré mes essais où je ne constatai pas d'erreurs, le mieux est de ne pas permettre au programme de rentrer dans du code hasardeux !
Merci pour "tes gros doutes" que tu as levés.
Bien cordialement !
Citation:
Envoyé par anapurna
salut
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 procedure split(a:string); var p:integer; begin nbr:=0; repeat inc(nbr); p := pos(sep,a); if p > 0 Then Begin c[nbr] := copy(a,1,p-1) ;<=== J'ai un gros doute ici si p = 0 a := copy(a,p+1,length(a)-p); end else c[nbr]:=a; if p=0 then c[nbr]:=a; until p=0; end;
voila je pense que cela fonctionnera mieux surtout pour le dernier item
__________________________

bonjour @jpété
merci de ton code. oui ça fonctionne bien. en effet c'est une bonne solution même si elle fait intervenir l'unité Classes.
pour info compilé sur windows10 avec fpc 3.0 j'arrive à 164 ko
(ce que j'avais fais au dessus j'étais à 34 ko)
mais je ne pense plus que ça soit un problème de nos jours.
Bien cordialement.

Citation:

Envoyé par Jipété

Cette remarque m'ayant mis la puce à l'oreille, je viens de refaire un essai, et en fait mon test ne dépend que de Classes; (du coup j'édite mon post d'hier).
Le .o généré par ppc386 test1 pèse 5,3 ko (ridicule !), le binaire (suis sous Linux) presque 500 ko (quand même, hein !)