La function Aujourd'hui:string; Retourne le nom du jour actuel

Commenter

Contenu du snippet 



unit u_date;

{  unité de manipulation du type T_Date le 9/7/93. ré-écrit par denis Bertin.

 cf: Origine
  Bibliothèque de programmes en Turbo Pascal by Kris Jamas + Steven nameroll + Denis Bertin.
  Chapitre 5 Routines de manipulation de la date et de l'heure - page 357
    Retapoter par denis bertin is it usefull ? my answer is yes
    Improve to add houre marker Time if i want in french and anglais.
    function  Aujourd_hui:string; Retourne le nom du jour actuel de la semaine en clair 
    exemple : lundi, mardi, mercredi ajouté le 18/August/2021}

interface

uses WinProcs,utile,wutil,sysutils;

type

 PT_pc_jour = ^T_pc_jour;
 T_pc_jour = record
  jour : array[0..15] of char;
      j : array [0..3] of char;
  end;

 T_DATE = record
  Jour,
  Mois,
  Annee,
    Heure : integer;
  end;

 T_Mois = record
  Nb_jour: byte;
  Nom:  array[0..15] of char;
  nb_car: byte;
  abrege: array[0..5] of char;
  end;

 T_Heure = record
  Heure,
  Minute,
  seconde:word;
    end;

 {$ifdef dis_NEO}
const
 K_Annee : array [1..12] of T_mois = (
  (Nb_Jour:31; Nom:'January'; nb_car:2; abrege:'JA'),
  (Nb_Jour:28; Nom:'February'; nb_car:1; abrege:'F'),
  (Nb_Jour:31; Nom:'March';  nb_car:3; abrege:'MAR'),
  (Nb_Jour:30; Nom:'April';  nb_car:2; abrege:'AP'),
  (Nb_Jour:31; Nom:'May';   nb_car:3; abrege:'MAY'),
  (Nb_Jour:30; Nom:'June';  nb_car:4; abrege:'JUNE'),
  (Nb_Jour:31; Nom:'July';  nb_car:4; abrege:'JULY'),
  (Nb_Jour:31; Nom:'August';  nb_car:2; abrege:'AU'),
  (Nb_Jour:30; Nom:'September'; nb_car:1; abrege:'S'),
  (Nb_Jour:31; Nom:'October'; nb_car:1; abrege:'O'),
  (Nb_Jour:30; Nom:'November'; nb_car:1; abrege:'N'),
  (Nb_Jour:31; Nom:'December';  nb_car:1; abrege:'D'));
    K_jour_dans_annee:integer=365;
   {$else}
var K_Annee : array [1..12] of T_mois;
    K_jour_dans_annee:integer;
   {$endif}

const


 K_annee_julien = 10000;

{ DAYS_IN_MONTH: array [1..12] of integer =
  (31,28,31,30,31,30,31,31,30,31,30,31);}

{$ifdef francais}
 Tableau_jour: array [0..6] of T_pc_jour = (
  (jour:'Dimanche'; j:'DIM'),
  (jour:'Lundi';  j:'LUN'),
  (jour:'Mardi';  j:'MAR'),
  (jour:'Mercredi'; j:'MER'),
  (jour:'Jeudi';  j:'JEU'),
  (jour:'Vendredi'; j:'VEN'),
  (jour:'Samedi'; j:'SAM'));
const
  string_heure = 'heure';
  string_minute = 'minute';
  string_seconde = 'seconde';
{$endif}

{$ifdef anglais}
  Tableau_jour: array [0..6] of T_pc_jour = (
  (jour:'Sunday';   j:'SUN'),
  (jour:'Monday';  j:'MON'),
  (jour:'Thirday'; j:'THI'),
  (jour:'Wenesday'; j:'WEN'),
  (jour:'Thuesday'; j:'THU'),
  (jour:'Friday';   j:'FRI'),
  (jour:'Saturday'; j:'SAT'));
const
  string_heure = 'hour';
  string_minute = 'minute';
  string_seconde = 'second';
{$endif}

{Pour les dates}
procedure correction_bissextile(annee:integer);
procedure init_table_mois_jour(index_ressource_mois,index_ressource_jour:integer);
function Is_Valid_Date (IN_DATE: T_DATE): boolean;
function  PChar_To_Date(In_Pchar:PChar; var Out_Date:T_Date):boolean;
procedure date_to_pchar_inverser_yyyy_mm_dd(out_date_pchar:pchar);
procedure date_to_pchar(in_date:t_date; out_pchar:pchar);
procedure date_to_pchar_dd_mm_yyyy(in_date:t_date; out_pchar:pchar);
procedure date_to_pchar_ddmmyyyy(in_date:t_date; out_pchar:pchar);
procedure date_to_pchar_en_clair(in_date:t_date; out_pchar:pchar);
procedure ddmmyyyyin_date(in_date:pchar; var out_date:t_date);
procedure get_system_date(var Out_Date: T_Date);
procedure ajoute_un_mois(var In_Out_Date:T_date);
procedure ajoute_une_semaine(var In_Out_Date:T_date);
procedure ajoute_un_nombre_de_jour(var In_Out_Date:T_date;nb_jour:integer);
function  nombre_de_jour_annee(In_Date:T_Date):integer;
procedure Date_To_Julian(In_Date:T_Date;var Julian_Date:longint);
procedure Julian_to_Date(Julian_Date:longint;var Out_Date:T_Date);
function  Compare_date(In_Un_Date,In_Deux_Date:T_Date):integer; {=> -1,0,+1}
function  Compare_Heure(In_Un_Date,In_Deux_Date:T_Heure):integer; {=> -1,0,+1}
function  Calcule_nb_jour_entre_2_date(date1,date2:t_date):longint;
function  Jour_de_la_semaine(In_Date:T_Date) : PT_pc_jour;
function  Aujourd_hui:string; {Return le nom du jour de la semaine en clair un ticket par jour exemple lundi, mardi, mercredi ajouté le 18/August/2021}
function  date_entre_2_date(date, date1, date2 : t_date):boolean;
function  Is_today(Year,Month,Day:word):boolean; {ECRIT PAR Denis B}
function  this_hour(Hour,Minute,Second,MilliSecond:word; var delta_dif_hour,delta_dif_minute,delta_dif_seconde:integer):boolean;
{function  date_heure_en_milliseconde(date:t_date; heure:T_Heure):int64;}

{pour les heures}
procedure Heure_en_seconde(in_heure:t_heure; var out_seconde:longint);
procedure Seconde_en_heure(in_seconde:longint; var out_heure:t_heure);
procedure Heure_en_pchar(in_heure:t_heure; apc:pchar; const with_hour : boolean = false);
function  Get_Seconde_Count:longint;
procedure get_heure(var une_heure:t_heure);
procedure Get_heure_system_pchar(apc:pchar);
procedure Get_Date_heure(apc:pchar);
function  FGet_Date_heure:string;
procedure Get_Heure_minute_seconde(temps_en_milliseconde:integer; var heure,minute,seconde:integer);
function  Difference_entre_deux_heure(apc,bpc:pchar):string;

{pour le jour actuel}
function  Get_Date_actuel:string; {Sous la forme 'jj-mm-aaaa'}
function  Get_Date_actuel_for_trace_logique:string; {Sous la forme 'aaaa_mm_jj-mm}
function  Get_Date_for_trace_logique(mon_jour:u_date.T_Date):string; {Sous la forme 'aaaa_mm_jj-mm}

{pour les fichiers}
{procedure change_date_fichier(apc_fichier:pchar;Une_Date:u_date.T_Date);}
{procedure Get_date_fichier(apc_fichier:pchar;var Une_Date:u_date.T_Date);}

function TimeAccesFichier(fichier: string): TDateTime;

implementation

(********************************************************************************)
(*                           pour les dates                                     *)
(********************************************************************************)

procedure correction_bissextile(annee:integer);
 begin
 K_Annee[2].nb_jour := 28;
 K_jour_dans_annee:=365;
 if (Annee mod 4) = 0 then
    begin
  if ((Annee mod 100) = 0) and ((Annee mod 400)<>0) then exit;
  K_Annee[2].nb_jour := 29;
  K_jour_dans_annee:=366;
    end
 end;

function get_nombre_jour_dans_cette_annee(pour_cette_annee:integer):integer;
  begin
  get_nombre_jour_dans_cette_annee:=365;
  if (pour_cette_annee mod 4) = 0 then
    begin
    {les années comme 2000 ne sont pas bisextile bien que divisible par quatre, celle en 400 non plus}
  if ((pour_cette_annee mod 100) = 0) and ((pour_cette_annee mod 400)<>0) then exit;
  get_nombre_jour_dans_cette_annee:=366;
    end;
  end;


{fonction en procedure exporté}

procedure init_table_mois_jour(index_ressource_mois,index_ressource_jour:integer);
 var apc:pc100;
     pc:pchar;
     i:integer;
 begin
 {Lecture des mois dans les ressources}
 for i:=1 to 12 do
  if loadstring(hinstance,i+index_ressource_mois,apc,pred(sizeof(apc)))<>0 then
   with K_Annee[i] do
    begin
    pc:=sysutils.StrPos(apc,';');
    if pc<>nil then
     begin
     pc^:=#0; inc(pc);
     StrLCopy(nom,apc,pred(sizeof(nom)));
     StrLCopy(abrege,pc,pred(sizeof(abrege)));
     nb_car:=strlen(abrege);
               end;
    end; {with}

 {Lecture des Jours dans les ressources}
 for i:=1 to 7 do
  if loadstring(hinstance,i+index_ressource_jour,apc,pred(sizeof(apc)))<>0 then
   with Tableau_jour[pred(i)] do
    begin
    pc:=StrPos(apc,';');
    if pc<>nil then
     begin
     pc^:=#0; inc(pc);
     StrLCopy(jour,apc,pred(sizeof(jour)));
     StrLCopy(j,pc,pred(sizeof(j)));
               end;
    end; {with}
 end; {init_table_mois}

function Is_Valid_Date (IN_DATE: T_DATE): boolean;
 begin
 with IN_Date do
    begin
  {traitement des années bissextiles}
  correction_bissextile(Annee);
    {test de la validité des jours et des mois}
  if (MOIS > 12) or (MOIS < 1) then
   Is_Valid_Date := false
  else if (JOUR > K_Annee[MOIS].nb_jour) or (JOUR < 1) then
   Is_Valid_Date := false
  else
   Is_Valid_Date := true;
  end;
 end; {Is_Valid_Date}
 
function PChar_To_Date(In_Pchar:PChar; var Out_Date:T_Date):boolean;
 var valid:boolean;
   fin:boolean;
   cherche_jour,cherche_mois,cherche_annee:boolean;
       i,j: integer;
   apc5:array[0..4] of char;
   apc_mois:array[0..15] of char;
   nb_num, {nb de caractères numériques et nombre de caractères}
   nb_car,
   nb:integer;

 type TDC_char = (TDC_num,TDC_car,TDC_separ,TDC_fin,TDC_Undef);

 function type_char(i:integer):TDC_char;
  begin
  case In_Pchar[i] of
   #0:             type_char:=TDC_fin;
   #48..#57:         type_char:=TDC_num;
   #32,#46,#47,#45,#58:type_char:=TDC_separ;{espace,.,/,-,:}
   #65..#90:         type_char:=TDC_car;
   #97..#122:
    begin
    type_char:=TDC_car;
    In_Pchar[i]:=upcase(In_Pchar[i]);
    end;
      else
        type_char:=TDC_Undef;
   end {case}
  end; {type_char}

  procedure voici_un_nombre;
       begin
   if cherche_jour then
          begin
    out_date.jour:=nb;
    cherche_jour:=false;
    cherche_mois:=true;
            end
   else if cherche_mois then
    begin
    out_date.mois:=nb;      
    cherche_mois:=false;
    cherche_annee:=true;
    end
   else if cherche_annee then
    begin
    out_date.annee:=nb;
    if nb<100 then
             begin
     if nb < 40 then
      inc(Out_Date.annee,100);
     inc(Out_Date.annee,1900);
     end;
    cherche_annee:=false;
            fin:=true;
    end;
   nb_num:=0;
   fillchar(apc5,sizeof(apc5),0);
   end; {voici_un_nombre}

 begin {PChar_To_Date}
 with out_date do begin jour:=0; mois:=0; annee:=0; end;
 fillchar(apc5,sizeof(apc5),0);
 fillchar(apc_mois,16,0);
 fin:=false;
 cherche_jour:=true;
 cherche_mois:=false;
 cherche_annee:=false;
 i:=0;
 nb_num:=0;
 nb_car:=0;
 while not fin do
    begin
  case type_char(i) of
   TDC_num:
    begin
    if nb_num<4 then
     begin 
     apc5[nb_num]:=In_Pchar[i];
     inc(nb_num);
     if (nb_num=2) and not cherche_annee then
      begin
      nb:=utile.pchar_integer(apc5);     
      voici_un_nombre;     
      end; {nb_num=2}
               end;
    end; {TDC_num}

   TDC_car:
    begin
    if nb_num=1 then
     begin
     nb:=utile.pchar_integer(apc5);
     voici_un_nombre;
     end; {nb_num=1}
    if cherche_mois then
     begin
     apc_mois[nb_car]:=In_Pchar[i];
     inc(nb_car);
     for j:=1 to 12 do
      if strcomp(K_Annee[j].abrege,apc_mois)=0 then
       begin
       nb:=j;
       voici_un_nombre;
                     end;
     end;
    end; {TDC_car}

   TDC_separ:
    begin
    if nb_num=1 then
     begin
     nb:=utile.pchar_integer(apc5);
     voici_un_nombre;     
     end; {nb_num=1}
    end; {TDC_separ}

   TDC_fin:
    begin
    fin:=true;
    if nb_num>0 then
     begin
     nb:=utile.pchar_integer(apc5);
     voici_un_nombre;     
     end; {nb_num=1}
    end;{TDC_fin}
   end; {case}
      inc(i);
  end; {while}
 valid:=Is_Valid_Date(out_date);
 PChar_To_Date:=valid;
 end; {PChar_To_Date}

procedure date_to_pchar_inverser_yyyy_mm_dd(out_date_pchar:pchar);
  var a_date:t_date;
      sm,sd:string;
  begin
  get_system_date(a_date);
  with a_date do
    begin
    sm:=inttostr(mois); if length(sm)=1 then sm:='0'+sm;
    sd:=inttostr(jour); if length(sd)=1 then sd:='0'+sd;
    strpcopy(out_date_pchar,inttostr(annee)+'_'+sm+'_'+sd);
    end;
  end; {date_to_pchar_inverser}

procedure date_to_pchar(in_date:t_date; out_pchar:pchar);
 var apc_jour,apc_mois,apc_annee:pc10;
   areal:real;
 begin
 with in_date do
  begin
  inttopchar(jour,apc_jour);
  caller_text_a_gauche(apc_jour,2,'0');
  inttopchar(mois,apc_mois);
  caller_text_a_gauche(apc_mois,2,'0');
  areal:=annee;
  annee:=round(frac(areal/100)*100);
  inttopchar(annee,apc_annee);
  caller_text_a_gauche(apc_annee,2,'0');
  end; {with}
 strcat(strcat(strcat(strcat(strcopy(out_pchar,apc_jour),
  '.'),apc_mois),'.'),apc_annee);
 end; {date_to_pchar}

procedure date_to_pchar_dd_mm_yyyy(in_date:t_date; out_pchar:pchar);
  var apc_jour,apc_mois,apc_annee:pc10;
  begin
  with in_date do
  begin
  inttopchar(jour,apc_jour);
  caller_text_a_gauche(apc_jour,2,'0');
  inttopchar(mois,apc_mois);
  caller_text_a_gauche(apc_mois,2,'0');
  inttopchar(annee,apc_annee);
  caller_text_a_gauche(apc_annee,4,'0');
  end; {with}
 strcat(strcat(strcat(strcat(strcopy(
    out_pchar,apc_jour),kpc_minus),apc_mois),kpc_minus),apc_annee);
  end;

procedure date_to_pchar_ddmmyyyy(in_date:t_date; out_pchar:pchar);
 var apc_jour,apc_mois,apc_annee:pc10;
 begin
 with in_date do
  begin
  inttopchar(jour,apc_jour);
  caller_text_a_gauche(apc_jour,2,'0');
  inttopchar(mois,apc_mois);
  caller_text_a_gauche(apc_mois,2,'0');
  inttopchar(annee,apc_annee);
  caller_text_a_gauche(apc_annee,4,'0');
  end; {with}
 strcat(strcat(strcopy(out_pchar,apc_jour),apc_mois),apc_annee);
 end; {date_to_pchar_ddmmyyyy}

procedure date_to_pchar_en_clair(in_date:t_date; out_pchar:pchar);
 var apc_jour,apc_annee:pc10;
 begin
 with in_date do
  begin
  inttopchar(jour,apc_jour);
  inttopchar(annee,apc_annee);
  strcat(strcat(strcat(strcat(strcopy(out_pchar,apc_jour),
   ' '),k_annee[mois].nom),' '),apc_annee);
  end; {with}
 end; {date_to_pchar_en_clair}

procedure ddmmyyyyin_date(in_date:pchar; var out_date:t_date);

 function char_in_int(c:char):integer;
  begin
  char_in_int:=ord(c)-ord('0')
  end;

 begin
 with out_date do
  begin
  jour:=char_in_int(in_date[0])*10+char_in_int(in_date[1]);
  mois:=char_in_int(in_date[2])*10+char_in_int(in_date[3]);
  annee:=char_in_int(in_date[4])*1000+char_in_int(in_date[5])*100+char_in_int(in_date[6])*10+char_in_int(in_date[7]);;
  end;
 end;

procedure get_system_date(var Out_Date: T_Date);
 var Present: TDateTime;
      Year, Month, Day: Word;
 begin
 //Windos.GetDate(y, m, d, dow);
  Present:= Now;
  DecodeDate(Present, Year, Month, Day);
 with Out_Date do
  begin
  jour:=day;
  mois:=month;
    annee:=Year;
    end;
 end; {get_system_date}

procedure ajoute_un_mois(var In_Out_Date:T_date);
  {ajoute 1 mois à In_Out_Date avec test de débordement}
 begin
 with In_Out_date do
  begin
  if jour=31 then
   jour:=30;
  if mois=12 then
   begin
   mois:=1;
         inc(annee);
         end   
  else
   inc(mois)
  end;   
 end; {ajoute_un_mois}

procedure ajoute_une_semaine(var In_Out_Date:T_date);
 begin
 ajoute_un_nombre_de_jour(In_Out_Date,7); 
 end; {ajoute_une_semaine}


{Résultat valide de 0 à (K_annee_julien - nombre de jour de la date de départ-1}
{exemple 10000 - 30 jours (30.01.90) -1 = 9969 }
procedure ajoute_un_nombre_de_jour(var In_Out_Date:T_date;nb_jour:integer);
 var julian_date:longint;
 begin
 Date_To_Julian(In_Out_Date,julian_date);
 inc(julian_date,nb_jour);
 julian_to_date(julian_date,In_Out_Date);
 end; {ajoute_un_jour}

function nombre_de_jour_annee(In_Date:T_Date):integer;
 var i,nb:integer;
 begin
 with In_Date do
  begin
  nb:=jour;
  correction_bissextile(Annee);
  for i:=1 to pred(mois) do
   inc(nb,K_Annee[i].nb_jour);
  end;
   nombre_de_jour_annee:=nb;
   end; 

procedure Date_To_Julian(In_Date:T_Date;var Julian_Date:longint);
 begin
 Julian_Date:=In_Date.annee;
 julian_date:=julian_date*K_annee_julien;
 inc(julian_date,nombre_de_jour_annee(In_Date)); 
 end; {Date_To_Julian}      

procedure Julian_to_Date(Julian_Date:longint;var Out_Date:T_Date);
 var un_nb_jour:integer;
 begin
 with Out_Date do
    begin
  {conversion de l'année}
  annee:= trunc(Julian_Date/K_annee_julien);
  un_nb_jour:=Julian_Date-annee*K_annee_julien;
  mois:=1;
  correction_bissextile(Annee);
  while un_nb_jour>K_jour_dans_annee do
   begin
   dec(un_nb_jour,K_jour_dans_annee);
   inc(annee);
   correction_bissextile(Annee);
         end;
  while un_nb_jour > K_Annee[mois].nb_jour do
   begin
   dec(un_nb_jour,K_Annee[mois].nb_jour);
   inc(mois);
   end;
  jour:=un_nb_jour;
  end; {with}
 end; {Julian_to_Date}

function Compare_date(In_Un_Date,In_Deux_Date:T_Date):integer;
 var Julian_Date_Un,
   Julian_Date_Deux : longint;
 begin
 Date_To_Julian(In_Un_Date,Julian_Date_Un);
 Date_To_Julian(In_Deux_Date,Julian_Date_Deux);
 if Julian_Date_Un < Julian_Date_Deux then
  Compare_date:=-1
 else if Julian_Date_Un > Julian_Date_Deux then
  Compare_date:=1
 else
  Compare_date:=0;
 end; {Compare_date}

function Compare_Heure(In_Un_Date,In_Deux_Date:T_Heure):integer; {=> -1,0,+1}
  var avant,apres:integer;
  begin
  avant:=In_Un_Date.Heure*3600+In_Un_Date.Minute*60+In_Un_Date.seconde;
  apres:=In_Deux_Date.Heure*3600+In_Deux_Date.Minute*60+In_Deux_Date.seconde;
  {*}
  if avant<apres then
    Compare_Heure:=-1
  else if avant>apres then
    Compare_Heure:=1
  else
    Compare_Heure:=0;
  end; {Compare_Heure}

function Calcule_nb_jour_entre_2_date(date1,date2:t_date):longint;
 var date3:t_date;
   negatif:boolean;
   nb_jour:longint;
 begin
 negatif:=false;
 if compare_date(date1,date2)=1 then
  begin
  negatif:=true;
  date3:=date1;
  date1:=date2;
  date2:=date3;
  end;
 if date1.annee=date2.annee then
  begin
  nb_jour:=nombre_de_jour_annee(date2);
  dec(nb_jour,nombre_de_jour_annee(date1));
  end
 else
    begin
  correction_bissextile(date1.Annee);
  nb_jour:=K_jour_dans_annee;
  dec(nb_jour,nombre_de_jour_annee(date1));
  while succ(date1.annee)<date2.annee do
   begin
   inc(date1.annee);
   correction_bissextile(date1.Annee);
   inc(nb_jour,K_jour_dans_annee);
   end;
  inc(nb_jour,nombre_de_jour_annee(date2));
    end;

 if negatif then
    nb_jour:=-nb_jour;
 Calcule_nb_jour_entre_2_date:=nb_jour;
 end; {Calcule_nb_jour_entre_2_date}


function Jour_de_la_semaine(In_Date:T_Date) : PT_pc_jour;
 const date_reference:t_date=(jour:1;mois:1;annee:1989);
 var   nb_jour:longint;
 begin
 nb_jour:=Calcule_nb_jour_entre_2_date(date_reference,In_Date);
 if nb_jour>=0 then
  nb_jour:=nb_jour mod 7
 else
  begin
  nb_jour:=abs(nb_jour) mod 7;
  nb_jour:=(7-nb_jour) mod 7;
  end;
 Jour_de_la_semaine:=@Tableau_jour[nb_jour];
 end; {Jour_de_la_semaine}

function Aujourd_hui:string;
  var Date: T_Date;
  begin
  u_date.get_system_date(Date);
  result:=Jour_de_la_semaine(Date).jour;
  end;

function date_entre_2_date(date, date1, date2 : t_date):boolean;
 begin
 date_entre_2_date:=(Compare_date(date,date1)>=0) and (Compare_date(date,date2)<=0);
  end;

function is_today(Year,Month,Day:word):boolean;
  var Out_Date: T_Date;
  begin
  get_system_date(Out_Date);
  is_today:=(Out_Date.Jour=Day) and (Out_Date.Mois=Month) and (Out_Date.Annee=Year);
  end; {is_today}

function this_hour(Hour,Minute,Second,MilliSecond:word; var delta_dif_hour,delta_dif_minute,delta_dif_seconde:integer):boolean;
  var une_heure:t_heure;
      temps,time,difference:integer;
  begin
  u_date.get_heure(une_heure);
  delta_dif_hour:=une_heure.Heure-Hour;
  if delta_dif_hour=0 then
    begin
    this_hour:=true;
    delta_dif_minute:=une_heure.Minute-Minute;
    temps:=Hour*24*3600+Minute*60+Second;
    time:=une_heure.Heure*24*3600+une_heure.Minute*60+une_heure.seconde;
    difference:=time-temps;
    delta_dif_hour:=(difference div 24*3600) mod 24;
    delta_dif_minute:=(difference div 60) mod 60;
    delta_dif_seconde:=difference mod 60;
    end
  else
    this_hour:=false;
  end;

(*
function date_heure_en_milliseconde(date:t_date; heure:T_Heure):int64;
  var i:integer;
      retour:int64;
      compte_nb_jour_mois:int64;
      date_jour:int64;
      retour_mois,retour_annee:int64;
      date_cumul_jour_excepter_anne_bisexitle:int64;
  begin
  retour:=heure.seconde*1000;
  retour:=retour+heure.minute*60*1000;
  retour:=retour+heure.heure*60*60*1000;
  date_jour:=date.Jour;
  retour:=retour+date_jour*24*60*60*1000;
  compte_nb_jour_mois:=0;
  correction_bissextile(date.annee);
  for i:=1 to pred(date.Mois) do
    compte_nb_jour_mois:=compte_nb_jour_mois+K_Annee[i].Nb_Jour;
  retour_mois:=compte_nb_jour_mois*24*60*60*1000;
  retour:=retour+retour_mois;
  date_cumul_jour_excepter_anne_bisexitle:=0;
  for i:=2001 to date.annee do
    begin
    inc(date_cumul_jour_excepter_anne_bisexitle,get_nombre_jour_dans_cette_annee(i));
    end;
  retour_annee:=date_cumul_jour_excepter_anne_bisexitle*24*60*60*1000;
  retour:=retour+retour_annee;
  date_heure_en_milliseconde:=retour;
  end;
*)

(********************************************************************************)
(*                           pour les heures                                    *)
(********************************************************************************)


procedure Heure_en_seconde(in_heure:t_heure; var out_seconde: longint);
 var along:longint;
 begin
 with in_heure do
  begin
  out_seconde:=seconde;
  inc(out_seconde,minute*60);
  along:=heure;
      along:=along*3600;
  inc(out_seconde,along);
  end; {with in_heure}
   end;

procedure Seconde_en_heure(in_seconde:longint; var out_heure:t_heure);
 var along:longint;
 begin
 with out_heure do
  begin
  heure:=0;
  minute:=0;
  if in_seconde>=3600 then
       begin
   heure:=in_seconde div 3600;
   along:=heure;
   along:=along*3600;
   dec(in_seconde,along);
   end;
  if in_seconde>=60 then
       begin
   minute:=in_seconde div 60;
   along:=minute;
   along:=along*60;
   dec(in_seconde,along);
         end;
  seconde:=in_seconde;
  end; {with out_heure}
 end;

procedure Heure_en_pchar(in_heure:t_heure; apc:pchar; const with_hour : boolean = false);
 var apc_heure,apc_minute,apc_seconde:pc100;
 begin
 with in_heure do
  begin
  inttopchar(heure,apc_heure);
  caller_text_a_gauche(apc_heure,2,'0');
    if with_hour then
      begin
      strcat(apc_heure,wutil.kpc_space);
      strcat(apc_heure,u_date.string_heure);
      if heure<>1 then strcat(apc_heure,'s');
      strcat(apc_heure,wutil.kpc_space);
      end;
  inttopchar(minute,apc_minute);
  caller_text_a_gauche(apc_minute,2,'0');
  inttopchar(seconde,apc_seconde);
  caller_text_a_gauche(apc_seconde,2,'0');
  if with_hour then
      begin
      strcat(strcopy(apc,apc_heure),apc_minute);
      strcat(strcat(apc,wutil.kpc_space),string_minute);
      if minute<>1 then strcat(apc,'s');
      strcat(strcat(apc,wutil.kpc_space),apc_seconde);
      strcat(strcat(apc,wutil.kpc_space),string_seconde);
      if seconde<>1 then strcat(apc,'s');
      end
    else
     strcat(strcat(strcat(strcat(strcopy(apc,apc_heure),':'),apc_minute),':'),apc_seconde);
    end;
 end;

function Get_Seconde_Count:longint;
 begin
 Get_Seconde_Count:=GetTickCount div 1000;
 end;

procedure get_heure_system_pchar(apc:pchar);
 var une_heure:t_heure;
      Present: TDateTime;
      Hour, Min, Sec, MSec: Word;
 begin
  Present:= Now;
  DecodeTime(Present, Hour, Min, Sec, MSec);
 with une_heure do
    begin
    Heure:=Hour;
    Minute:=Min;
    seconde:=Sec;
    end;
 Heure_en_pchar(une_heure,apc);
 end;

procedure get_heure(var une_heure:t_heure);
  var Present: TDateTime;
      Hour, Min, Sec, MSec: Word;
  begin
  Present:= Now;
  DecodeTime(Present, Hour, Min, Sec, MSec);
 with une_heure do
    begin
    Heure:=Hour;
    Minute:=Min;
    seconde:=Sec;
    end;
  end; {get_heure}

procedure Get_Date_heure(apc:pchar);
 var une_date:T_date;
   apc_date:pc100;
   apc_heure:pc100;
 begin
 u_date.get_system_date(une_date);
 u_date.get_heure_system_pchar(apc_heure);
 u_date.date_to_pchar_en_clair(une_date,apc_date);
 strcat(strcat(strcopy(apc,apc_date),' - '),apc_heure);
 end;

function FGet_Date_heure:string;
  var apc:wutil.pc1024;
  begin
  Get_Date_heure(apc);
  FGet_Date_heure:=strpas(apc);
  end;

procedure Get_Heure_minute_seconde(temps_en_milliseconde:integer; var heure,minute,seconde:integer);
  var moins_heure:integer;
  begin
  heure:=(temps_en_milliseconde div 1000) div 3600;
  moins_heure:=(temps_en_milliseconde div 1000)-3600*heure;
  minute:=moins_heure div 60;
  seconde:=moins_heure mod 60;
  end; {Exactement}

function Difference_entre_deux_heure(apc,bpc:pchar):string;
  var cumulation:string;
      time_hour,time_minute,time_seconde:integer;
      time_hour_terminal,time_minute_terminal,time_seconde_terminal:integer;
      time_begin,time_ending,time_difference:integer;
      hour,minute,seconde:integer;
  begin
  //Détermination de l'heure de début de traitement
  time_hour:=strtoint(apc[0]+apc[1]);
  time_minute:=strtoint(apc[3]+apc[4]);
  time_seconde:=strtoint(apc[6]+apc[7]);
  //Détermination de l'heure de fin de traitement
  time_hour_terminal:=strtoint(bpc[0]+bpc[1]);
  time_minute_terminal:=strtoint(bpc[3]+bpc[4]);
  time_seconde_terminal:=strtoint(bpc[6]+bpc[7]);
  //Déplacement des heures inférieurs au temps de départ.
  if time_hour_terminal<time_hour then
    time_hour_terminal:=time_hour_terminal+24;
  //Cumul des temps
  time_begin:=3600*time_hour+time_minute*60+time_seconde;
  time_ending:=3600*time_hour_terminal+time_minute_terminal*60+time_seconde_terminal;
  time_difference:=time_ending-time_begin;
  hour:=time_difference div 3600;
  time_difference:=time_difference-hour*3600;
  minute:=time_difference div 60;
  seconde:=time_difference-minute*60;
  if hour<10 then
    cumulation:='0'+inttostr(hour)
  else
    cumulation:=inttostr(hour);
  cumulation:=cumulation+':';
  if minute<10 then
    cumulation:=cumulation+'0'+inttostr(minute)
  else
    cumulation:=cumulation+inttostr(minute); {Denis Bertin Stéphane}
  cumulation:=cumulation+':';
  if seconde<10 then
    cumulation:=cumulation+'0'+inttostr(seconde)
  else
    cumulation:=cumulation+inttostr(seconde);
  result:=cumulation;
  end; {Différence_entre_deux_heure}

{pour les fichiers}
(*
procedure change_date_fichier(apc_fichier:pchar;Une_Date:u_date.T_Date);
 var f: text;
   long_time : Longint; { Pour Get/SetFTime}
     dt : TDateTime; { Pour Pack/UnpackTime}
  begin
 Assign(F, apc_fichier);
 Reset(F);
 dt.Year:=Une_Date.Annee;
 dt.Month:=Une_Date.Mois;
 dt.Day:=Une_Date.Jour;
 dt.Hour:=0;
 dt.Min:=0;
 dt.Sec:=0;

 packTime(dt,long_time);
 SetFTime(F,long_time);
 Close(F);   { Fermeture }
 end;
*)

function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
{=================================================================}
{ fonction permettant de convertir des date de type FileTime      }
{ en Date de type DateTime                                        }
{=================================================================}
var
  LocalFileTime: TFileTime;
  SystemTime: TSystemTime;
begin
  FileTimeToLocalFileTime(FileTime, LocalFileTime);
  FileTimeToSystemTime(LocalFileTime, SystemTime);
  Result := SystemTimeToDateTime(SystemTime);
end;


function TimeAccesFichier(fichier: string): TDateTime;
var SearchRec:TSearchRec;
    Resultat:LongInt;
begin
  //Result:=0;
  Resultat:=FindFirst(fichier, FaAnyFile, SearchRec);
  // FileDateToDateTime transforme une date de type Dos en format TDateTime
  if Resultat=0 then
    Result:=FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
  FindClose(SearchRec);
end;

function Get_Date_actuel:string; {Sous la forme 'jj-mm-aaaa'}
  var Out_Date: T_Date;
  begin
  get_system_date(Out_Date);
  Get_Date_actuel:=inttostr(Out_Date.Jour)+'-'+inttostr(Out_Date.mois)+'-'+inttostr(Out_Date.Annee);
  end;

function Get_Date_actuel_for_trace_logique:string;
  var Out_Date: T_Date; s:string;
  begin
  get_system_date(Out_Date);
  s:=inttostr(Out_Date.Annee)+'_';
  if Out_Date.mois<10 then
    s:=s+'0'+inttostr(Out_Date.mois)
  else
    s:=s+inttostr(Out_Date.mois);
  s:=s+'_';
  if Out_Date.Jour<10 then
    s:=s+'0'+inttostr(Out_Date.Jour)
  else
    s:=s+inttostr(Out_Date.Jour);
  Get_Date_actuel_for_trace_logique:=s;
  end; {Get_Date_actuel_for_trace_logique}

function Get_Date_for_trace_logique(mon_jour:u_date.T_Date):string; {Sous la forme 'aaaa_mm_jj-mm}
  var s:string;
  begin
  s:=inttostr(mon_jour.Annee)+'_';
  if mon_jour.mois<10 then
    s:=s+'0'+inttostr(mon_jour.mois)
  else
    s:=s+inttostr(mon_jour.mois);
  s:=s+'_';
  if mon_jour.Jour<10 then
    s:=s+'0'+inttostr(mon_jour.Jour)
  else
    s:=s+inttostr(mon_jour.Jour);
  Get_Date_for_trace_logique:=s;
  end; {Get_Date_for_trace_logique}

(*
procedure Get_date_fichier(apc_fichier:pchar;var Une_Date:u_date.T_Date);
  var LH: THandle;
      LFDate: Integer;
      DT: TDateTime; { Pour Pack/UnpackTime}
      Data: TWin32FindData;

     var f: text;
     long_time : Longint; { Pour Get/SetFTime}

  begin
  DateToStr(FileDateToDateTime(FileAge(apc_fichier)));


  { Open a file. }
  LH := FileOpen(apc_fichier, fmOpenRead);
  { Get the date from the file. }
  LFDate := FileGetDate(LH);
  { Close the file. }
  FileClose(LH);

 Assign(F, apc_fichier);
 Reset(F);
 GetFTime(F,long_time);

 UnpackTime(LFDate,dt);
 Une_Date.Annee:=dt.Year;
 Une_Date.Mois:=dt.Month;
 Une_Date.Jour:=dt.Day;
 //Close(F);   { Fermeture }
  end;
*)

  begin
  K_jour_dans_annee:=365;
  {$ifdef francais}
 with K_Annee[1] do begin Nb_Jour:=31; Nom:='Janvier'; nb_car:=2; abrege:='JA'; end;
 with K_Annee[2] do begin Nb_Jour:=28; Nom:='Février'; nb_car:=1; abrege:='F'; end;
 with K_Annee[3] do begin Nb_Jour:=31; Nom:='Mars';  nb_car:=3; abrege:='MAR'; end;
 with K_Annee[4] do begin Nb_Jour:=30; Nom:='Avril';  nb_car:=2; abrege:='AV'; end;
 with K_Annee[5] do begin Nb_Jour:=31; Nom:='Mai';   nb_car:=3; abrege:='MAI'; end;
 with K_Annee[6] do begin Nb_Jour:=30; Nom:='Juin';  nb_car:=4; abrege:='JUIN'; end;
 with K_Annee[7] do begin Nb_Jour:=31; Nom:='Juillet'; nb_car:=4; abrege:='JUIL'; end;
 with K_Annee[8] do begin Nb_Jour:=31; Nom:='Août';   nb_car:=2; abrege:='AO'; end;
 with K_Annee[9] do begin Nb_Jour:=30; Nom:='Septembre'; nb_car:=1; abrege:='S'; end;
 with K_Annee[10] do begin Nb_Jour:=31; Nom:='Octobre'; nb_car:=1; abrege:='O'; end;
 with K_Annee[11] do begin Nb_Jour:=30; Nom:='Novembre'; nb_car:=1; abrege:='N'; end;
 with K_Annee[12] do begin Nb_Jour:=31; Nom:='Décembre'; nb_car:=1; abrege:='D'; end;
  {$endif}

  {$ifdef anglais}
  with K_Annee[1] do begin Nb_Jour:=31; Nom:='January'; nb_car:=2; abrege:='JA'; end;
 with K_Annee[2] do begin Nb_Jour:=28; Nom:='February'; nb_car:=1; abrege:='F'; end;
 with K_Annee[3] do begin Nb_Jour:=31; Nom:='Mars';  nb_car:=3; abrege:='MAR'; end;
 with K_Annee[4] do begin Nb_Jour:=30; Nom:='April';  nb_car:=2; abrege:='AV'; end;
 with K_Annee[5] do begin Nb_Jour:=31; Nom:='May';   nb_car:=3; abrege:='MAI'; end;
 with K_Annee[6] do begin Nb_Jour:=30; Nom:='June';  nb_car:=4; abrege:='JUIN'; end;
 with K_Annee[7] do begin Nb_Jour:=31; Nom:='July'; nb_car:=4; abrege:='JUIL'; end;
 with K_Annee[8] do begin Nb_Jour:=31; Nom:='August';   nb_car:=2; abrege:='AO'; end;
 with K_Annee[9] do begin Nb_Jour:=30; Nom:='September'; nb_car:=1; abrege:='S'; end;
 with K_Annee[10] do begin Nb_Jour:=31; Nom:='October'; nb_car:=1; abrege:='O'; end;
 with K_Annee[11] do begin Nb_Jour:=30; Nom:='November'; nb_car:=1; abrege:='N'; end;
 with K_Annee[12] do begin Nb_Jour:=31; Nom:='December'; nb_car:=1; abrege:='D'; end;
  {$endif}

end.

Compatibilité : 1.0

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 (denisbertin)