Discussion :

[cooldid]

Bonjour,

Je désire supprimer tous les caractères spéciaux d'un str.
J'ai trouvé un code qui me parait convenir, je l'ai intregrer dans une procédure mais cela ne fonctionne pas.

Si quelqu'un pourrai m'aider ?

Merci d'avance.

La procedure en PJ

Le 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
i :longint;
Result : string;
 
begin
   Result := '';
   for i := 1 to Length(str)
   do
   begin
      Case str[i] of
         'A'..'Z', 'a'..'z' : Result := Result + str[i];
         '0'..'9'          : Result := Result + str[i];
         ' '               : Result := Result + str[i];
      end;
   end;
end;

[newbie57]

Bonjour,

As-tu essayé AnsiReplaceStr en prennant soin d'ajouter StrUtils dans uses. Tu remplaces tous tes caractères speciaux par ''.

[edam]

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
 
Function MyTrim(str:string):string;
i :longint;
begin
   Result := '';
   for i := 1 to Length(str)
   do
   begin
      Case str[i] of
         'A'..'Z', 'a'..'z' : Result := Result + str[i];
         '0'..'9'          : Result := Result + str[i];
         ' '               : Result := Result + str[i];
      end;
   end;
end;

[anapurna]

salut

argh j'ai jamais vu en code aussi mal ecrit
bon a part ca
il faut que tu creer un fonction en dehors de ta procedure

genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 Fonction DeletespecChar(avalue : String ) : String;
  var
     i :longint;
  begin
    Result := '';
    for i := 1 to Length(avalue)    do
    begin
       Case avalue[i] of
          'A'..'Z', 'a'..'z' : Result := Result + avalue[i];
          '0'..'9'          : Result := Result + avalue[i];
          ' '               : Result := Result + avalue[i];
       end;
   end;

est dans ton code tu remplace ce que tu as fait par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  str := DeletespecChar(str)

PS : on me derange cinq minute et voila que quelqu'un fournit la meme reponse j'y croit pas y'a pas de justice

[ShaiLeTroll]

Tient, voici un code 1000 fois plus rapide que celui proposé, bon je l'ai adapté rapidement ce matin donc quelques bugs peuvent survenir, me les signaler que je corrige ...

C'est une fonction optimisée que j'ai écrite sur l'idée de la fonction ExtractStrings (Classes.pas de Delphi) pour l'utilisation de TSysCharSet.
Fabrice ROUXEL qui devrait publié prochainement une QR a eu la même idée mais dans l'autre sens, il a fait une fonction qui retire les caractères (c'est juste le paramètre qui change finalement) dans une chaine

Code de Fabrice ROUXEL + SJRD :

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
function DeleteFromStr(const Str : string; Excluded : TSysCharSet) : string;
var Len, I, J : integer;
begin
  Len := Length(Str);
  SetLength(Result, Len);
  J := 0;
  for I := 1 to Len do
  begin
    if not (Str[i] in Excluded) then
    begin
      inc(J);
      Result[J] := Str[i];
    end;
  end;
  SetLength(Result, J);
end;

Dans ton cas les CharSet risque d'être très long, ainsi l'approche inverse sera plus pratique avec ma fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ResStr := CopyStringOnly('cou4co75u 4l782a 4523Fran45234c789e34!', ['a'..'z', 'A'..'Z', ' ', '!']);

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
function CopyStringOnly(const Str : string; const OnlyChars : TSysCharSet): string;
type
  TSCSALOON = record
    case Boolean of
      True: (SCS: TSysCharSet);
      False: (A: Array[1..8] of Cardinal);
    end;
var
   Len, I : integer;
   J, P: PChar;
begin
  Len := Length(Str);
  if Len = 0 then
  begin
    Result := '';
    Exit;
  end;
  with TSCSALOON(OnlyChars) do
  begin
    if (A[1] = 0) and (A[2] = 0) and (A[3] = 0) and (A[4] = 0) and (A[5] = 0) and (A[6] = 0) and (A[7] = 0) and (A[8] = 0) then
    begin
      Result := '';
      Exit;
    end;
  end;
 
  SetLength(Result, Len);
  P := @Result[1];
  J := P;
  for I := 1 to Len do
  begin
    if Str[i] in OnlyChars then
    begin
      J^ := Str[i];
      Inc(J);
    end;
  end;
  ReduceStr(Result, Cardinal(J) - Cardinal(P));
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
procedure ReduceStr(var S: string; NewLength: Integer);
type
   PStrRec = ^StrRec;
   StrRec = packed record
      refCnt: Longint;
      length: Longint;
   end;
begin
   if NewLength < Length(S) then
   begin
     S[Succ(NewLength)] := #0;
     PStrRec(Integer(S) - SizeOf(StrRec)).length := NewLength;
   end;
end;

[cooldid]

Bonjour,

Merci beaucoup pour vos réponses.

Mais j'ai 2 messages d'erreurs.

Undeclared indentifier : 'ReduceStr'
Undeclared indentifier : 'ResStr'

Quand penser vous ?

Merci

[ero-sennin]

Salut,

Pour ReduceStr, c'est la fonction que t'as donné ShaiLeTroll :

Code de ShaiLeTroll :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure ReduceStr(var S: string; NewLength: Integer);
type
   PStrRec = ^StrRec;
   StrRec = packed record
      refCnt: Longint;
      length: Longint;
   end;
begin
   if NewLength < Length(S) then
   begin
     S[Succ(NewLength)] := #0;
     PStrRec(Integer(S) - SizeOf(StrRec)).length := NewLength;
   end;
end;

Ensuite pour ResStr, il faut le déclarer comme étant de type String.

En espérant t'avoir aidé.
A+

[cooldid]

Re bonjour,

Merci pour les infos, effectivement je n'ai plus d'erreurs.

Malheureusement cela ne fonctionne toujours pas

Je met le code modifier en PJ


Et encore merci d'avance

[ero-sennin]

Re,

Pour que je puisse tester, comment on se sert de ton outil

J'ai compris qu'il fallait mettre JSInd.exe C:\UnRep UnSiteWeb mais en faite, je ne comprends pas trop le fonctionnement car il me crée un fichier js et on dirait qu'il lit tout mon DD.

J'ai fait ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

JSInd.exe C:\ Http://www.google.fr

Peux tu m'en dire plus stp ?
Merci

(Ca à l'air intéressant comme outil )

[cooldid]

Bonjour,

Effectivement, c'est pour cela que j'essaye de l'exploiter.

jsind.exe <Main_Directory> <Web_Root>

Ex en local : c:\jsind\jsind.exe c:\tr ../tr (c:\tr repertoire contenant fichier htm ou txt .... ../tr chemin relatif pour la création des lien) puis création d'un js indexer.


Voilà

Slts

[ero-sennin]

Salut,

Dans ton code, tu utilises bien la fonction, et tu mets bien le contenu dans la variable ResStr mais tu ne l'utilises pas par la suite !

J'ai essayé le code de ShaiLeTroll est ça fonctionne très bien.
Pour exemple, j'ai fait ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
procedure TForm1.Button1Click(Sender: TObject);
var
  A:string;
  B:String;
begin
  A:='azeré&!è';
  B:=CopyStringOnly(A,['a'..'z', 'A'..'Z', ' ', '!']);
  ShowMessage(B); // Affiche azer!
end;

A+

[bhf37]

Juste ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
str := StringReplace(str, 'é', 'e', rfReplaceAll);
str := StringReplace(str, 'è', 'e', rfReplaceAll);
str := StringReplace(str, '!', ' ', rfReplaceAll);
...

voilà.

[ShaiLeTroll]

Ta Solution bhf37 remplace les caractères accentués par les caractères non accentués, alors que l'on les retiré !

mais on peut donc dire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
str := StringReplace(str, 'é', '', rfReplaceAll);
str := StringReplace(str, 'è', '', rfReplaceAll);
str := StringReplace(str, '!', '', rfReplaceAll);

c'est juste 1000 fois plus lent que CopyStringOnly

[cooldid]

Bonjour,

En tous cas un grand merci à vous tous j'ai opté pour la solution de ShaiLeTroll avec la fonction :

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 DeleteFromStr(const Str : string; Excluded : TSysCharSet) : string;
var Len, I, J : integer;
begin
  Len := Length(Str);
  SetLength(Result, Len);
  J := 0;
  for I := 1 to Len do
  begin
    if not (Str[i] in Excluded) then
    begin
      inc(J);
      Result[J] := Str[i];
    end;
  end;
  SetLength(Result, J);
end;

Que j'utilise comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
ResStr := DeleteFromStr(str, ['‚','ƒ','…','=','{','}','-','\',')','|','/','','','ÿ','&','#','&',',','','+','*','"','~',';','^','`','%','','','','&','@','(','','>','€','?','$','„','†','‡','ˆ','‰','Š','‹','Œ','Ž','‘','’','“','”','•','–','—','˜','™','š','›','œ','ž','Ÿ','¡','¢','£','¤','¥','¦','§','¨','©','ª','«','¬','*','®','¯','°','±','²','³','´','µ','¶','·','¸','¹','º','»','¼','½','¾','¿','Á','Â','Ã','Ä','Å','Æ','Ç','È','É','Ê','Ë','Ì','Í','Î','Ï','Ð','Ñ','Ò','Ó','Õ','Ö','×','Ø','Ù','Ú','Û','Ü','Ý','Þ','ß','á','ã','ä','å','æ','ë','ì','í','î','ï','ð','ñ','ò','ó','õ','ö','÷','ø','ù','ú','û','ü','ý','þ','ÿ','[']);
 
str := ResStr;

Cela me va nickel

Merci