Routines diverses et utiles sur chaînes de caractères

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 412 fois - Téléchargée 35 fois

Contenu du snippet

Plein de petites choses qui vous rendent la vie vraiment plus facile ;)
Ma première source (et je crois la millième, à moins que qqun me devance)

de nombreux programmeurs ont du déjà faire de telles unités
mais je publie la mienne quand même :)

Source / Exemple :


unit StrUtiles;

interface
uses SysUtils, windows;

  function ReadFile(FileName: string): string;
  function WriteFile(FileName: string; Data: string): boolean;
  function Purge(Msg,substr: string): string;
  function Replace(Msg,substr,repby: string): string;
  function StrCount(Msg, substr: string): integer;
  function Asc(Msg: string): integer;
  function IsIn(SubStr,StrIn: string):boolean;
  function AllowNumKeys(key: char): char;
  function Cut(var S: string; Index,count: integer): string;
  function Num(S: string): integer;

implementation

// lit le fichier "filename" et retourne son contenu
function ReadFile(FileName: string): string;
var Fi: textfile; buf: string;
begin
  try
  AssignFile(Fi,FileName);
  Reset(Fi);
  repeat
    readln(Fi,buf);
    result := result + buf;
  until eof(Fi);
  CloseFile(Fi);
  except
    result := '';
  end;
end;

// crée le fichier "filename" et écrit "data" dedans
function WriteFile(FileName, data: string): boolean;
var Fi: textfile;
begin
  if not FileExists(FileName) then
  begin
    result := false;
    exit;
  end;
  try
    AssignFile(Fi,FileName);
    Rewrite(Fi);
    write(fi,data);
    CloseFile(fi);
    result := true;
  except
    result := false;
  end;
end;

// efface toutes les instances de "substr" dans "msg"
function Purge(Msg,substr: string): string;
begin
  while pos(substr,msg)>0 do Delete(msg,pos(substr,msg),length(substr));
  result := msg;
end;

// remplace toutes les instances de "substr" par "repby" dans "msg"
function Replace(Msg,substr,repby: string): string;
begin
  while pos(substr,msg)>0 do
  begin
    Insert(repby,msg,pos(substr,msg));
    Delete(msg,pos(substr,msg),length(substr));
  end;
  result := msg;
end;

// compte le nombre d'instances de "substr" dans "msg"
function StrCount(Msg, substr: string): integer;
begin
  result := 0;
  while pos(substr,msg)>0 do
  begin
    result := result + 1;
    Delete(msg,1,pos(substr,msg)+length(substr));
  end;
end;

// retourne le code ASCII du premier caractère de "msg" (comme ASC() en qbasic)
function Asc(Msg: string): integer;
var i: integer;
begin
  if length(msg)=0 then
  begin
    result := 0;
    exit;
  end;
  result := ord(msg[1]);
end;

// retourne "true" si une instance de "Substr" est trouvée dans "strin"
function IsIn(SubStr,StrIn: string):boolean;
begin
  if pos(substr,strin)>0 then result := true
  else result := false;
end;

// à mettre dans les OnKeyPress de vos Edits qui ne doivent contenir que des nombres
// key := AllowNumKeys(key);
function AllowNumKeys(key: char): char;
begin
  if not (key in ['1','2','3','4','5','6','7','8','9','0',#8]) then result := #0
  else result := key;
end;

// copie "count" caractères de "S" à partir de "index" et les supprime
function Cut(var S: string; Index,count: integer): string;
begin
  result := copy(S,Index,Count);
  Delete(S,index,Count);
end;

// procédure VAL transformée en fonction, évite les erreurs générées par StrToInt
function Num(S: string): integer;
var code, value: integer;
begin
  Val(S,value,code);
  if code<>0 then result := -1
  else result := value;
end;

end.

Conclusion :


j'ai pas vu de bugs.. enfin, libre à vous de modifier ça comme vous voulez

A voir également

Ajouter un commentaire Commentaires
Messages postés
1
Date d'inscription
samedi 11 octobre 2003
Statut
Membre
Dernière intervention
18 décembre 2004

Merci!!
C'est impéc.
Je cherchais une fonction replace de chaine.
Messages postés
79
Date d'inscription
jeudi 6 novembre 2003
Statut
Membre
Dernière intervention
29 juin 2004

et pour la fonction replace sa mrche comment?
Messages postés
136
Date d'inscription
lundi 2 septembre 2002
Statut
Membre
Dernière intervention
15 février 2006

oups... jamais vu!
faudra que je revoie ça, de toute façons.
Messages postés
113
Date d'inscription
vendredi 16 août 2002
Statut
Modérateur
Dernière intervention
15 mai 2005

Attention! ReadFile et WriteFile sont des functions de l'API... le compilo peut ne pas aimer ss le paramètre overload !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.