fonction opposée a FormatDateTime Résolu

Question

Bonjour, 

Je suis a la recherche d'une fonction qui fait l'inverse de la fonction FormatDateTime.

Je m'explique: plutot que d'avoir en entrée un TDateTime et un formatage, et recuperer en sortie une String, je souhaiterais une fonction du style:

functionFormatStrToDateTime(const Format: string; Date: string): TDateTime;

où on passe une string contenant une date formatée d'une manière "speciale", et où on passe une string contenant le format a utilisé pour decoder cette date.

J'en ai besoin parce que je recoit un fichier ou les date sont formatée en YYYYMMDD (par exemple '19920519' pour le 19 mai 1992), et donc la fonction StrToDate ne fonctionne pas.

Etant donnée que le format de date peut changé, j'aimerais donc savoir si il existe une fonction telle que celle decrite çi-dessus.

Je sais pas si mes explications sont claires, mais si jamais vous avez une idée, je suis preneur!

Merci d'avance

japee · Accepted Answer

Salut,

Oui, j'aurais fait comme Loda.
Juste un point de détail :

result:=EncodeDate(StrToInt(copy(str,1,4)),StrToInt(copy(str,5,2)),StrToInt(copy(str,7,2)));

Il s'agit visiblement d'une erreur d'inattention

Guillemouze · Answer

bah ........ StrToDate !!!

Sat83 · Answer

Ben comme expliqué dans mon premier poste, StrToDate ne fonctionne pas, puisque le format date n'est pas reconnu.

J'ai une exception EConvertError  ''19920519' n'est pas une date correcte'

Sat83 · Answer

En attendant de pouvoir trouver mieux je me suis fait une petite fonction:

function StrToDatePerso(date : string) : TDate;
var
     y, m, d : integer;
begin
   y  :=  StrToInt(date[1])*1000
        + StrToInt(date[2])*100
        + StrToInt(date[3])*10
        + StrToInt(date[4]);

   m  :=  StrToInt(date[5])*10
        + StrToInt(date[6]);

   d  :=  StrToInt(date[7])*10
        + StrToInt(date[8]);

   StrToDatePerso := EncodeDate( y, m, d );
end;

C'est une solution provisoire pour que je puisse continué à avancer dans mon projet, donc je suis toujours à l'ecoute d'eventuelle solution que vous auriez a proposer...

Merci d'avance....

cs_Loda · Answer

salut,

c'est peut-être pas le plus "optimizé", mais ça marche:

function yyyymmddStrToDateTime(Str:String):TDateTime;
begin
 //ajout des tests si tu veux (length, ...)
  result:=EncodeDate(StrToInt(copy(str,0,4)),StrToInt(copy(str,5,2)),StrToInt(copy(str,7,2)));
end;

bon code,

Loda
<hr size="2" width="100%" />Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.

florenth · Answer

Salut ! La rapidité n'est pas fonction du nombre de lignes !! D'ailleurs, la fonction la plus rapide que j'ai pu trouver est :

function MyStrToDateTime(const S: string): TDateTime; const CDigits: array['0'..'9'] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9); var Y, M, D: Integer; begin Y := CDigits[S[1]] * 1000 + CDigits[S[2]] * 100 + CDigits[S[3]] * 10 + CDigits[S[4]]; M := CDigits[S[5]] * 10 + CDigits[S[6]]; D := CDigits[S[7]] * 10 + CDigits[S[8]]; Result := EncodeDate(Y, M, D); end;

NB: il y a bien une gestion d'erreurs car la fonction déclenche un EBoundError si un des caractère n'est pas un chiffre ou si la chaîne est trop courte. NB2: elle est 11 fois plus rapide que la version modifiée de Loda par japee et pourant... 11 fois plus longue (en lignes de code) ! A+ Flo Ressources Delphi, sources, tutoriaux, actu, ...: www.mx-dev.nethttp://te%3C/body

Sat83 · Answer

Merci pour ces reponses... 

Je testerais vos propositions  lundi!

Mais bon, le problème reste que ces fonctions sont spécifiques au format YYYYMMDD... (vous me direz c'est mieux que rien, et je suis d'accord!).

Dommage qu'il n'existe pas de solution 'miracle' existante permettant d'obtenir un TDate a partir de 2 string (une avec la date, l'autre avec le formatage).

Merci a vous en tout cas...

japee · Answer

Belle démonstration de ton talent, Flo !

f0xi · Answer

function StrYMDToDate(const S : string {yyyymmdd}): TDateTime; begin if Length(S) <> 8 then exit; result := EncodeDate( word(StrToIntDef( Copy(S, 1, 4), 1900)), word(StrToIntDef( Copy(S, 5, 2), 1)), word(StrToIntDef( Copy(S, 7, 2), 1)) ); end;

http://deefaze.gnomz.com

WhiteHippo · Answer

Bonjour

Va voir ici tu y trouveras peut être ce que tu souhaites.

Cordialement. 
<hr />"L'imagination est plus importante que le savoir." Albert Einstein

Cirec · Answer

Salut, voici une approche différente avec un résultat différent elle pourra peut être servir ne serait-ce que sur un plan éducatif En entré nous avons : '19920519' {String} Et en sortie nous obtenons '19/05/1992' {String} utilisable avec StrToDate Function ReverseDate(Const Str : String): String; Var P, Pr : PChar; L : Integer; Y, M, D : String; Begin P := PChar(Str + #0); L := Length(Str); Pr := P; Inc(Pr, L-2); // on se place à la fin de la chaine moins 2 caractères D := Pr; Pr^ := #0; // on déplace la fin de la chaine et on recommence Dec(Pr, 2); M := Pr; Pr^ := #0; Dec(Pr, 4); Y := Pr; Result := Format('%s/%s/%s', [D, M, Y]); End ; Highlighted with Pas2HTML @+ Cirec

japee · Answer

Hello,

Oh oui, Cirec, très très intéressant pour qui veut comprendre le fonctionnement des pointeurs sur les chaînes à 0 terminal.

Mais ne penses-tu pas qu'un seul PChar suffirait ?

Function ReverseDate(Const Str : String): String;
Var Pr : PChar;
    L : Integer;
    Y, M, D : String;
Begin
  L := Length(Str);
  Pr := PChar(Str + #0);
  Inc(Pr, L-2); // on se place à la fin de la chaine moins 2 caractères
  D := Pr;
  Pr^ := #0; // on déplace la fin de la chaine et on recommence
  Dec(Pr, 2);
  M := Pr;
  Pr^ := #0;
  Dec(Pr, 4);
  Y := Pr;
  Result := Format('%s/%s/%s', [D, M, Y]);
End;

A +

Cirec · Answer

Oui tu as entièrement raison 

En fait le deuxième pointeur est un vestige de la première mouture, 
j'avais l'intention d'utiliser un pointeur pour l'entrée (Str) et l'autre pour la sortie (Result) ... puis j'ai changer d'avis en oubliant d'éliminer  le pointeur en trop ...  

 
@+
Cirec

<hr siz="" />

Cirec · Answer

Petite précision ... ce n'est une chaine à zéro terminal mais 
une chaine à double zéro terminal
c'est justement cette différence qui permet de déplacer la fin de la chaine ... 

Pour s'en rendre compte il suffit de remplacer :
  Pr := PChar(Str + #0);
Par
  Pr := PChar(Str);
Pour obtenir une belle exception à la première instruction du type :
  Pr^ := #0;

 
@+
Cirec

<hr siz="" />

japee · Answer

Sous D4 et D7, ça passe :
Pr := PChar(Str);
ne provoque aucune exception à l'exécution...

Encore une différence entre D 2007 et les versions précédentes ?

Bizarre...

Cirec · Answer

L'exception se déclanche par sur cette instruction mais sur :
Pr^ := #0;

Testé sous D7 !!!!

 
@+
Cirec

<hr siz="" />

japee · Answer

Testé sous D7 aussi :

Voici ta fonction modifiée :

function ReverseDateT(const Str: string): string;
var
  Pr : PChar;
  Y, M, D : string;
begin  
  Pr := PChar(Str); // <- modif ici
  Inc(Pr, Length(Str) - 2);
  D := Pr;
  Pr^ := #0; // <- pas d'exception
  Dec(Pr, 2);
  M := Pr;
  Pr^ := #0; // <- pas d'exception
  Dec(Pr, 4);
  Y := Pr;
  Result := Format('%s/%s/%s', [D, M, Y]);
end;

Et ça passe...

Cirec · Answer

Arf ... moi j'ai une exception à la première instruction :
Pr^:= #0; 

Sous D7 et TurboDelphi  !!!!

peut être une directive de compilation ????

 
@+
Cirec

<hr siz="" />

Cirec · Answer

Je viens de tester le code sur une autre machine (PIII) et sur un AMD

et j'ai toujours le même problème ... si je retire "+ #0" le code plante 
et avec 3 versions de Delphi différentes ????

Quelqu'un pourrait-il tester cette procédure (avec et sans "+ #0") et nous dire ce qu'il en est 
S.V.P .... Merci 

 
@+
Cirec

<hr siz="" />

japee · Answer

Ouais, si quelqu'un pouvait être sympa et tester ça...

C'est facile, il faut juste :

- 1 TEdit,
- 1 TLabel,
- 1 TButton.

Le code :

function ReverseDateT(const Str: string): string;
var
  Pr : PChar;
  Y, M, D : string;
begin
  Pr := PChar(Str);
  Inc(Pr, Length(Str) - 2);
  D := Pr;
  Pr^ := #0;
  Dec(Pr, 2);
  M := Pr;
  Pr^ := #0;
  Dec(Pr, 4);
  Y := Pr;
  Result := Format('%s/%s/%s', [D, M, Y]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ADateTime: TDateTime;
begin
  ADateTime := StrToDate(ReverseDateT(ComboBox1.Text));
  Label1.Caption := DateTimeToStr(ADateTime);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '19920519';
end;

Voilà. Sinon j'en connais au moins 1 qui va avoir du mal à s'endormir ce soir...

P-S: Cirec, tu as reçu mon zip ? Des fois que...

Cirec · Answer

Voilà j'ai trouvé pourquoi

C'est l'utilisation du ComboBox.Text qui "évite" le plantage 

je conseille donc de laisser le fameux " + #0" il vous évitera de chercher pendant des heures le pourquoi du comment du plantage 

 
@+
Cirec

<hr siz="" />

japee · Answer

Bien vu, Cirec. C'est sans appel.

A noter que tous les Captions et Text de la VCL (Edit, Memo (Memo.Text et Memo.Lines[x]), Label, Button, etc...) que j'ai testés produisent le même effet. Ils rajoutent donc automatiquement un caractère (#0, ou bien #13#10 ?) à la fin...
Ça me laisse perplexe.

japee · Answer

Je retire "ils ajoutent automatiquement #13#10" : ça n'a pas de sens.
Donc, ils ajoutent un zéro terminal.

Cirec · Answer

Ca va même plus loin que ça :

Var aStr1 : String =  '19921905'+#0;

procedure TForm1.Button4Click(Sender: TObject);

begin
  Label1.Caption := ReverseDateT(aStr1);  // Plante 

end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  aStr1 : =  aStr1 ;
  Label1.Caption :=  ReverseDateT(aStr1);  // Ne plante pas 
end;

Var aStr2 : String  = '19921905';

procedure TForm1.Button6Click(Sender: TObject);

begin

  aStr2 :=   aStr2 ;

  Label1.Caption := ReverseDateT(aStr2);  // Ne plante pas 

end;

si quelqu'un a une explication ... je suis preneur 

 
@+
Cirec

<hr siz ="" />

WhiteHippo · Answer

Bonsoir

Il faut se mefier avec la manipulation des PChar. Si on reprend ta fonction :

  Pr := PChar(Str);          
  // Delphi fait une copie de la chaine Str                           
  // puis met l'adresse de celle ci dans dans Pr 
  //
  // Pr                           
  // |                           
  // V                           
  // '12345678'#0                            
  //                            
                             
  Inc(Pr, Length(Str) - 2);  
  //
  //        Pr                           
  //        |                           
  //        V                           
  // '12345678'#0                            
  //                            
  
  D := Pr;                   
  // Comme D a été déclaré en tant que string Delphi fait 
  // une copie du PChar dans la chaine D soit '78'#0
  //
  //        Pr                           
  //        |                           
  //        V                           
  // '12345678'#0                            
  //                              
  
  Pr^ := #0;
  // Là on réduit sauvagement la taille du PChar originel
  //         Pr                           
  //         |                           
  //         V                           
  // '123456'#0'8'#0                            
  //                              
  // Et on s'apperçoit que le bout '8'#0 est en quelque sorte perdu
  // Ce qui je suppose pose dans certaines conditions des problèmes
  // de désallocations et/ou des exceptions.

Il faut être très très prudent avec la manipulation directe des PChar. Les programmeurs en C connaissent d'ailleurs très bien les nombreux problèmes que ceux ci posent.

N.B. Pour info j'aurais plutôt ecris la fonction ainsi :

type
  TDatePtr = ^TDate ;
  TDate =  packed record
    Y : array[0..3] of char ;
    M,D : array[0..1] of char ;
  end ;



Function ReverseDateT(Const Str : String): String;
Var
  P : PChar;
  Date : TDatePtr absolute P ;
Begin
  P := PChar(Str);
  Result := Format('%.2s/%.2s/%.4s', [Date.D, Date.M, Date.Y]);
End;


Cordialement. <hr />"L'imagination est plus importante que le savoir." Albert Einstein

japee · Answer

Je pense avoir compris.

La VCL passe la main à l'API et le string est transformé en chaîne C à zéro terminal.

Il suffit de faire ce test :

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Caption := '1992' + #0 + '0518';
  ShowMessage(Button1.Caption);
  // encore plus fort! :
  Label1.Caption := Button1.Caption;
end;

La chaîne obtenue sera "1992", le caractère #0 marquant la fin de chaîne en C.
Étonnant, non ?

A +

Cirec · Answer

@WhiteHippo :

Merci pour ces explications mais je savais ce que cela allait "provoquer" 
d'ailleurs c'est l'effet souhaité dans ce cas bien précis.

Mais ceci n'explique pas le problème évoqué plus haut !!!!

Par contre ton approche me plait bien je dois avouer que je n'y avais pas pensé pourtant j'utilise souvent "l'astuce" du ABSOLUTE

@Japee :

J'ai pas bien compris le "encore plus fort" ou c'est nouveau mon PC qui est hanté 

je trouve ceci plus "spectaculaire":

procedure TForm1.Button1Click(Sender: TObject);
Var s : String;
begin
  S := '1992' + #0 + '0518';
  Button1.Caption := S;
  ShowMessage(Button1.Caption);
  // encore plus fort! :
  Label1.Caption := IntToStr(Length(s));
end;

 
@+
Cirec

<hr siz="" />

japee · Answer

Ouais, avant de manipuler les PChar à la légère, on va y réfléchir à 2 fois...

Encore plus probant que mon test précédent :

procedure TForm1.Button1Click(Sender: TObject);
var
  A, B: string;
  LA, LB, LC: Integer;
begin
  A := '1992' + #0 + '0518';
  LA := Length(A);
  ShowMessage(IntToStr(LA));
  B := A;
  LB := Length(B);
  ShowMessage(IntToStr(LB));
  Label1.Caption := B;
  LC := Length(Label1.Caption);
  ShowMessage(IntToStr(LC));
  // on obtient respectivement : 9, 9, 4
end;

Je crois que là c'est clair.

japee · Answer

@Cirec :

Par "encore plus fort", je voulais dire qu'en appelant ShowMessage, tu t'attends à passer par l'API, donc à ce que ta chaîne soit convertie en C, donc tronquée à l'endroit du "#0".
Alors qu'en l'attribuant à un "caption" ou autre "text", on ne manque pas d'être surpris...

Cirec · Answer

il n'y a rien d'extraordinaire dans cela ...

cela prouve juste que les Caption, Text et autres soit disant String sont en fait des PChar 

Par contre ce qui est étonnant c'est que (sur le problème cité plus haut) le simple fait de réaffecter la variable String avec sa propre valeur empêche ce fameux bug 

Et comme ça c'est encore plus bizarre !!!!

Var aStr1 : String = '19921905';
procedure TForm1.Button5Click(Sender: TObject);
begin
  ShowMessage(IntToStr(Length(aStr1)));
  aStr1 :=  aStr1 ;
  Label1.Caption := ReverseDateT(aStr1);
  ShowMessage(IntToStr(Length(aStr1)));
end;

on ne peut donc pas dire que Delphi rajoute un zéro terminal dans ce cas précis 

 
@+
Cirec

<hr siz="" />

Cirec · Answer

Mais elle est troqué chez moi, dans les deux cas j'obtiens  1992 
avec ce code :
procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Caption := '1992' + #0 + '0518';
  ShowMessage(Button1.Caption);
  // encore plus fort! :
  Label1.Caption := Button1.Caption;
end;

 
@+
Cirec

<hr siz="" />

japee · Answer

Et ça, c'est pas mal non plus :

var aStr1: string;  // <- OK
procedure TForm1.Button3Click(Sender: TObject);
//var aStr1: string;  // <- violation d'accès
begin
  aStr1 := '19920519';
  //Label1.Caption := ReverseDateT(aStr1); // <- OK
  Label1.Caption := ReverseDateT('19920519'); // <- violation d'accès
end;

aaarrrgggghhh...

Cirec · Answer

Oui et ceci plante :
Var aStr1 : String = '19921905';
procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := ReverseDateT(aStr1);
end;

C'est vraiment déconcertant ... non 

 
@+
Cirec

<hr siz="" />

Caribensila · Answer

ET ALORS ..?







Y'a 1 065 121 mecs qui attendent vos conclusions !

japee · Answer

1 065 121 mecs, ah quand même ?
Et quasiment pas une fille...
Faut dire qu'on a une tellement grande gueule (surtout certains, suivez mon regard), que je comprends qu'elles se fassent discrètes.

Ma conclusion, elle tient en quelques mots.
Delphi nous fournit un type de chaîne facile à manier, souple, performant, que le monde entier (et surtout les autres langages de programmation) nous envie : AnsiString.
A moins d'y être obligés, ou d'être un peu maso, je ne vois pas ce qui nous pousserait à utiliser PChar. Sauf à vouloir fréquenter l'api windows, ou autre dll codée en C...

Mais maso, on l'est tous un peu sur delphifr, sinon on passerait pas notre temps à se torturer les neurones. On se servirait de la VCL sans chercher à comprendre et puis c'est tout !

Caribensila · Answer

C'était un "mecs" générique, bien sûr...  :)))


Il est quand même difficile de ne pas se frotter de temps en temps à l'API Windows ou 
aux DLL. Mieux vaut comprendre PChar, tout comme les pointeurs d'ailleurs.
Il faut reconnaître que Delphi nous fait la vie belle avec tout ça. Peut-être un peu trop question "ouverture d'esprit".
La description complète du format interne de ces chaînes n'est pas documentée par Borland, qui se reserve le droit de modifier ce format interne dans les versions à venir.
Comme le suggérait Whitehippo, gare au débordement d'intervalle et à la corruption mémoire avec PChar!
Et le jour où on commence à utiliser WideString avec l'Unicode, on se sent un peu handicapé.

M'enfin, Delphi c'est quand même super...  et vous êtes là!!!

Fonction opposée a FormatDateTime

36 réponses

Votre réponse

Discussions similaires