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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (cs_costello)