Comment supprimer tous les caractères spéciaux d'une string ?

Version imprimable

1 pièce(s) jointe(s)

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:

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;

14/12/2007, 09h43
newbie57

Bonjour,

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

8-)

Citation:

Envoyé par cooldid

Code:

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;

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:

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:

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

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:

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:

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

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
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:

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;

14/12/2007, 19h53
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

Salut,

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

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+ ;)

14/12/2007, 21h24
cooldid

1 pièce(s) jointe(s)

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
14/12/2007, 21h51
ero-sennin

Re,

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

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:

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

Peux tu m'en dire plus stp ?
Merci

(Ca à l'air intéressant comme outil :mrgreen:)
14/12/2007, 23h56
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

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:

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+ ;)

Juste ça :

Code:

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

voilà.

27/12/2007, 18h16
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:

1 2 3 str := StringReplace(str, 'é', '', rfReplaceAll); str := StringReplace(str, 'è', '', rfReplaceAll); str := StringReplace(str, '!', '', rfReplaceAll);
c'est juste 1000 fois plus lent que CopyStringOnly

Bonjour,

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

Code:

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:

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

Cela me va nickel :king:

Merci