Explode Split strings

Explode,Split
decouper une chaine recuperer en plusieurs éléments
Extraire les mots d'une chaine..

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
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
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
unit UExplode;
{------------------------------------------------------------------------}
{ Montor                                                                 }
{ Info sur la class TStrExplode :                                        }
{ Pour accélérer le traitement on remplace les séparateurs par  #0       }
{ texte avant :                                                          }
{              Text:=  'txt1,txt2,txt3,txt4,txt5'                        }
{ texte après :                                                          }
{              Text:=  'txt1#0 txt2#0 txt3#0 txt4#0 txt5#0'              }
{            PList :    *ptr0  *ptr1  *ptr2  *ptr3  *ptr4                }
{------------------------------------------------------------------------}
interface
uses SysUtils,Classes;
type
  ETStrSplit = class(Exception);
 
  TBoolTab = array[Ansichar]of boolean;{un peu Plus rapide que Set of char...}
  TBasicSplit=class
  private
    FDelimiters,           {Liste des delimiteurs }
    FSeparators,           {Liste des séparateurs }
    FChars     : TBoolTab; {Liste des séparateurs + delimiteurs}
    FLimit     : integer;  {Nombre maximal des éléments à trouvés }
    FSkipEmpty : boolean;  {ignorer les elements vides}
    function SetToArray(const St:TSysCharSet):TBoolTab;
    function ArrayToSet(const Ar:TBoolTab):TSysCharSet;
    function Get_Dl: TSysCharSet;
    function Get_Sp: TSysCharSet;
    procedure Set_Dl(const Value: TSysCharSet);
    procedure Set_Sp(const Value: TSysCharSet);
    procedure SetLimit(const Value: integer);
    procedure SetData(const Value: PAnsichar);
    procedure SetLen(const Value: Cardinal);
    procedure SetPosition(const Value: Cardinal);
 protected
    FCount     : integer;
    FPosition  : Cardinal;   {position de début de l'opération}
    FLen       : Cardinal;   {taille de donnée}
    FData      : PAnsichar;  {donnée à traiter}
    procedure DefaultCallback(P1,P2:PAnsichar);virtual;
    procedure Go();
    property Data:PAnsichar read FData write SetData;
    property Len:Cardinal read FLen write SetLen;
 public
    function Gets():boolean;virtual;
    property Delimiters:TSysCharSet read Get_Dl write Set_Dl;
    property Separators:TSysCharSet read Get_Sp write Set_Sp;
    property Limit:integer read FLimit write SetLimit;
    property Count:integer read FCount;
    property SkipEmpty:boolean read FSkipEmpty write FSkipEmpty;
    property Position:Cardinal read FPosition write SetPosition;
 end;
 
  TStrExplode=class(TBasicSplit)
  private
    FList     : PPointerList;{Liste des poiteurs}
    FStr      : string;      {texte à traiter}
    FCapacity : integer;
    FCreateNew: boolean;     {une nouvelle copie de texte pour le traitement}
    procedure Set_Str(const Value: string);
    procedure SetCapacity(ASize:integer);
  protected
    procedure DefaultCallback(P1,P2:PAnsichar);override;
  public
    destructor Destroy();override;
    procedure Clear();
    property List:PPointerList read FList;
    property CreateNew:boolean read FCreateNew write FCreateNew;
    property Capacity:integer  read FCapacity write SetCapacity;
    property Text:string  read FStr write Set_Str;
  end;
 
implementation
{ TBasicSplit }
 
function TBasicSplit.ArrayToSet(const Ar: TBoolTab): TSysCharSet;
var
 Ch:Char;
begin
for Ch := #0 to #255 do
 if Ar[Ch]  then
   Include(result,Ch)
 else
   Exclude(result,Ch);
end;
 
function TBasicSplit.SetToArray(const St: TSysCharSet): TBoolTab;
var
 Ch:Char;
begin
   for Ch := #0 to #255 do
     result[Ch]:=Ch in St;
 
end;
 
function TBasicSplit.Get_Dl: TSysCharSet;
begin
    result:= ArrayToSet(FDelimiters);
end;
 
function TBasicSplit.Get_Sp: TSysCharSet;
begin
   result:= ArrayToSet(FSeparators);
end;
 
procedure TBasicSplit.Set_Dl(const Value: TSysCharSet);
begin
    if (Value * Separators) <> [] then
     raise ETStrSplit.Create('Un caractère utilisé .');
 
    FDelimiters:=SetToArray(Value);
    FChars     :=SetToArray(Separators+Delimiters);
end;
 
procedure TBasicSplit.Set_Sp(const Value: TSysCharSet);
begin
    if (Value * Delimiters) <> [] then
     raise ETStrSplit.Create('Un caractère utilisé .');
 
    FSeparators:=SetToArray(Value);
    FChars     :=SetToArray(Separators+Delimiters);
end;
 
procedure TBasicSplit.SetLimit(const Value: integer);
begin
  if Value < 0 then
    raise ETStrSplit.Create('Valeur incorecte !');
  FLimit :=Value;
end;
 
procedure TBasicSplit.DefaultCallback(P1, P2: PAnsichar);
begin
   if (P1 = P2) and SkipEmpty then Exit;
   inc(FCount);
end;
 
 
procedure TBasicSplit.Go();
var
 Ch:Char;
 P,P1,Prv:PAnsichar;
begin
 P     := FData+FPosition;
 P1    := FData+FLen;
 Prv   := P;
 while P < P1 do
 begin
    repeat
      if FChars[P^] then
         break;
          inc(P);
      if (P = P1)then
         break; 
    until False;
 
    if (P < P1)and FDelimiters[P^] then
    begin //{=> Quoted Str
          Ch:=P^;
          inc(P);
          while P < P1 do
          begin
             if P^=Ch then
               break;
             inc(P);
          end;
    end
    else
    begin
          DefaultCallback(Prv,P);
          Prv:=P+1;
          if FCount=FLimit then
             Break;
    end;
    inc(P);
 end;
 FPosition :=Cardinal(Prv)-Cardinal(FData);
end;
 
function TBasicSplit.Gets: boolean;
 begin
    FCount := 0;
     if Assigned(FData)and (FLen > 0) then
        Go();
 
     result:= FCount <> 0;
end;
 
procedure TBasicSplit.SetData(const Value: PAnsichar);
begin
  if Assigned(Value)then
  begin
    FData     := Value;
    FLen      := 0;
    FPosition := 0;
  end;
end;
 
procedure TBasicSplit.SetLen(const Value: Cardinal);
begin
  FLen := Value;
end;
 
procedure TBasicSplit.SetPosition(const Value: Cardinal);
begin
  if Value < FLen then
  FPosition := Value;
end;
 
{ TStrExplode }
 
destructor TStrExplode.Destroy;
begin
  Clear();
  inherited;
end;
 
procedure TStrExplode.SetCapacity(ASize: integer);
begin
    if ASize <> FCapacity then
    begin
      FCapacity := ASize;
      ReallocMem(FList,FCapacity*Sizeof(Pointer));
      if FCount > FCapacity then
         FCount :=FCapacity;
    end;
end;
 
procedure TStrExplode.Clear;
begin
    SetCapacity(0);
end;
 
procedure TStrExplode.DefaultCallback(P1, P2: PAnsichar);
var
 d,ns:integer;
begin
     if (P1 = P2) and FSkipEmpty then Exit;
     d := FCount;
     if d = FCapacity then
     begin
       ns:= d;
       inc(ns,(d shr 2) or 4);
       SetCapacity(ns);
     end;
     FList[d]:=P1;
     P2^:= #0;
     inc(FCount);
end;
 
procedure TStrExplode.Set_Str(const Value: string);
begin
  if Value <> '' then
  begin
      FStr :='';
      Clear();
      if CreateNew then
       SetString(FStr,PChar(@Value[1]),Length(Value))
      else
        FStr:= Value;
 
      Data := Pointer(FStr);
      Len  := Length(FStr);
  end;
end;
 
end.

utilisation

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
procedure TForm1.Button1Click(Sender: TObject);
var
 Ex:TStrExplode;
 Txt:string;
 i:integer;
 function exemple:string;
 begin
    result:='txt1,`txt2`,"txt3",txt4,txt5,txt6' ;
 end;
begin
  Txt:=exemple();
  Ex :=TStrExplode.Create();
  Ex.Separators:=[',',';',#0];
  Ex.Delimiters:=['"',#39,'`'];
  Ex.Text:= Txt;
 
  {Exemple 1 :récuperer tout les éléments, gourmand en pointeurs }
 
  if Ex.Gets() then
    for i:=0 to Ex.Count-1 do
      Showmessage(StrPas(Ex.List[i]));
 
  Showmessage('deuxième exemple');
  {Position pointe sur la fin du dernier élément trouvé pour être réutiliser}
  { dans le prochaine invocation de Gets() }
 
  {repositonner sur le premier caractère et #0 dans la liste des séparateurs}
  Ex.Position:=0;
  {Exemple 2 :utilisation pertinente }
  Ex.Limit:=2;
 
  while Ex.Gets()do //Next
  for i:=0 to Ex.Count-1 do
      Showmessagefmt('boucle %d => [%s]',[i,StrPas(Ex.List[i])]);
 
 
  Ex.Free();
end;