CONVERTION D'UNE CHAINE EN TDATE

Uses DateUtils, StrUtils, SysUtils;

//------------------

function countcar(s:string;c:char):integer;
var
 i:integer;
begin
 result:=0;
 for i:=1 to length(s) do if s[i]=c then inc(result);
end;

//------------------

Function MyStrtoDate(mydate:string):tdate;
const
mois:array[1..12] of string=('jan','fev','mars','avr','mai','juin','juil','aou','sep','oct','nov','dec');
var
 i:integer;
 j,m,a:word;
begin
 result:=-1;
 mydate:=ansilowercase(mydate);
 // récup la date courante
 decodedate(date,a,m,j);
 //retire les accents pour décembre, août, février
 while pos('é',mydate)<>0 do mydate[pos('é',mydate)]:='e';
 while pos('û',mydate)<>0 do mydate[pos('û',mydate)]:='u';
 // remplace les mois en lettres par des mois en chiffres
 for i:=1 to 12 do
  if pos(mois[i],mydate)<>0 then
   begin
    insert(' '+inttostr(i)+' ',mydate,pos(mois[i],mydate));
    delete(mydate,pos(mois[i],mydate),length(mois[i]));
    break;
   end;
 // retire tous ce qui n'est pas des chiffres et remplace par un espace
 i:=1;
 for i:=1 to length(mydate) do  if not (mydate[i] in ['0'..'9',' ']) then mydate[i]:=' ';
 // retire les doubles espaces
 while pos('  ',mydate)<>0 do delete(mydate,pos('  ',mydate),1);
 mydate:=trim(mydate);
 // il n'y a plus rien... on sort
 if mydate='' then exit;
 // si il n'y a pas d'espace, alors c'est la forme JJMMAA
 case countcar(mydate,' ') of
 0:
  case length(mydate) of
   2: mydate:=mydate+'/'+inttostr(m) +'/'+inttostr(a);
   4: begin insert('/',mydate,3); mydate:=mydate+'/'+inttostr(a); end;
   6,8: begin insert('/',mydate,5); insert('/',mydate,3); end;
  end
 1: mydate:=mydate+'/'+inttostr(a);
 end;
 //remplace les espaces par des '/'
 while pos(' ',mydate)<>0 do mydate[pos(' ',mydate)]:='/';
 //verif et renvoi au format TDate
 if not TryStrToDate(mydate,result) then result:=-1;
end;

06 septembre 2007 11:36:04 :

Modification pour tenir compte des remarques de Loda - Rajout de la fonction CountCar que j'avait oublié de mettre...

06 septembre 2007 11:37:00 :

Modification pour tenir compte des remarques de Loda - Rajout de la fonction CountCar que j'avait oublié de mettre...

07 septembre 2007 10:40:02 :

correction d'un petit bug...