unit MYLDBDateFormat;

{$I MYLDBVer.inc}

//Example:  "Today is" mm/dd/yyyy hh24:nn:ss ' Wow !!!'

interface
uses SysUtils, math, windows,
     MYLDBExcept,
     MYLDBTypes,
     MYLDBConst;

Type
    TDateFormatType  = ( dfYYYY, dfYY, dfYEAR,                        // year
                         dfQ,                                         // quarter
                         dfMONTH, dfMON, dfMM, dfM, dfRM,             // month
                         dfDDD, dfDD, dfDAY, dfDY, dfDW, dfD,         // days
                         dfHH12, dfHH24, dfHH, dfH12, dfH24, dfH,     // huors
                         dfNN, dfN,                                   // minutes
                         dfSS, dfS,                                   // seconds
                         dfAMPM,                                      // am/pm
                         dfText);
const
    DateFormatReservedWordsCount = 26;
    DateFormatReservedWords: array[0..DateFormatReservedWordsCount-1] of String = (
                         'YYYY', 'YY', 'YEAR',
                         'Q',
                         'MONTH', 'MON', 'MM', 'M', 'RM',
                         'DDD', 'DD', 'DAY', 'DY', 'DW', 'D',
                         'HH12', 'HH24', 'HH', 'H12', 'H24', 'H',
                         'NN', 'N',
                         'SS', 'S',
                         'AMPM');

    Delimeters = '-/,.;:';

    TwoDigitYearCenturyWindow = 1930; // 1930 - 2029
var
   DateFormatReservedWordsMaxLength: integer;
Type

  TDateFormatToken = record
    TokenType: TDateFormatType;
    Text:      String;
  end;

  TDateFormater = class
  private
   FDateFormat: array of TDateFormatToken;
   procedure ParseDateFormat(const DateFormatStr: string);
   function GetReservedWord(const Text: string): TDateFormatType;
  public
   constructor Create(DateFormat: string);
   destructor Destroy; override;

   function ToDate(str: String): TDateTime;
   function ToString(dt: TDateTime): String;
   function GetStringMaxSize: Integer;
   function GetDataType: TMYLDBAdvancedFieldType;
   function DebugGetTotenList: String;
  end;

implementation

const
  AM = 'AM';
  PM = 'PM';

// DateUtils Functions...

function YearOf(const AValue: TDateTime): Word;
var
  LMonth, LDay: Word;
begin
  DecodeDate(AValue, Result, LMonth, LDay);
end;

function StartOfTheYear(const AValue: TDateTime): TDateTime;
begin
  Result := EncodeDate(YearOf(AValue), 1, 1);
end;

function DayOfTheYear(const AValue: TDateTime): Word;
begin
  Result := Trunc(AValue - StartOfTheYear(AValue)) + 1;
end;

function MonthOf(const AValue: TDateTime): Word;
var
  LYear, LDay: Word;
begin
  DecodeDate(AValue, LYear, Result, LDay);
end;

function DayOfTheWeek(const AValue: TDateTime): Word;
begin
  Result := (DateTimeToTimeStamp(AValue).Date - 1) mod 7 + 1;
end;

function HourOf(const AValue: TDateTime): Word;
var
  LMinute, LSecond, LMilliSecond: Word;
begin
  DecodeTime(AValue, Result, LMinute, LSecond, LMilliSecond);
end;

function HourOfTheDay(const AValue: TDateTime): Word;
begin
  Result := HourOf(AValue);
end;

{ TDateFormater }

constructor TDateFormater.Create(DateFormat: string);
begin
  SetLength(FDateFormat,0);
  ParseDateFormat(DateFormat);
end;

destructor TDateFormater.Destroy;
begin

  inherited;
end;

procedure TDateFormater.ParseDateFormat(const DateFormatStr: string);
var
  i,j,L: integer;
  start: integer;
  s: string;
  dft: TDateFormatType;
  charsLen: integer;
  isQuotedText: boolean;
  isDoubleQuotedText: boolean;
begin
 i := 0;
 start := 1;
 isQuotedText := false;
 isDoubleQuotedText := false;
 L := Length(DateFormatStr);
 while i < L do
  begin
   inc(i);
   // Quoted Text...
   if (DateFormatStr[i] = '''') or (DateFormatStr[i] = '"') then
    if isQuotedText or isDoubleQuotedText then
     begin
      if (DateFormatStr[i] = '''') and isQuotedText or
         (DateFormatStr[i] = '"') and isDoubleQuotedText then
       begin
        // Close QuotedText or DoubleQuotedText
        SetLength(FDateFormat, Length(FDateFormat)+1);
        FDateFormat[Length(FDateFormat)-1].TokenType := dfText;
        FDateFormat[Length(FDateFormat)-1].text :=
          copy(DateFormatStr, start, i-start);
        if DateFormatStr[i] = '"' then
          isDoubleQuotedText := false
        else
          isQuotedText := false;
        start := i + 1;
        continue;
       end
     end
    else
     begin
      if start <> i then
       begin
        // close previous Section 'Text'
        SetLength(FDateFormat, Length(FDateFormat)+1);
        FDateFormat[Length(FDateFormat)-1].TokenType := dfText;
        FDateFormat[Length(FDateFormat)-1].text :=
          copy(DateFormatStr, start, i-start);
       end;

      start := i + 1;
      if DateFormatStr[i] = '"' then
        isDoubleQuotedText := true
      else
        isQuotedText := true;
      continue;
     end;
   if isQuotedText or isDoubleQuotedText then continue;

   // look on 4-5 next chars
   charsLen := min(DateFormatReservedWordsMaxLength,L+1-i);
   for j:=charsLen downto 1 do
    begin
     s := copy(DateFormatStr, i, j);
     dft := GetReservedWord(s);
     // Is it Reserded word ?
     if dft <> dfText then
      begin
       if i <> start then
        begin
         SetLength(FDateFormat, Length(FDateFormat)+1);
         FDateFormat[Length(FDateFormat)-1].TokenType := dfText;
         FDateFormat[Length(FDateFormat)-1].text :=
           copy(DateFormatStr, start, i-start);
        end;
       SetLength(FDateFormat, Length(FDateFormat)+1);
       FDateFormat[Length(FDateFormat)-1].TokenType := dft;
       FDateFormat[Length(FDateFormat)-1].text :=
         copy(DateFormatStr, i, j);
       i := i + j - 1;
       start := i + 1;
       break;
      end;
    end;//for
  end;
 if i+1 <> start then
  begin
   SetLength(FDateFormat, Length(FDateFormat)+1);
   FDateFormat[Length(FDateFormat)-1].TokenType := dfText;
   FDateFormat[Length(FDateFormat)-1].text :=
     copy(DateFormatStr, start, i+1-start);
  end;
end;

function TDateFormater.GetReservedWord(const Text: string): TDateFormatType;
var i,n: integer;
    s: string;
begin
 n := DateFormatReservedWordsCount;
 s := UpperCase(Text);
 for i := 0 to DateFormatReservedWordsCount-1 do
   if (s = DateFormatReservedWords[i]) then
    begin
     n := i;
     break;
    end;
 Result := TDateFormatType(n);
end;

function TDateFormater.DebugGetTotenList: String;
var
 i: Integer;
begin
 Result := '';
 for i:=0 to Length(FDateFormat)-1 do
  begin
    Result := Result + IntToStr(i+1);
    if FDateFormat[i].TokenType = dfText then
      Result := Result + ' <dfText> = '''
    else
      Result := Result + ' <df' +
            DateFormatReservedWords[integer(FDateFormat[i].TokenType)] + '> = ''';
    Result := Result + FDateFormat[i].Text + ''''#13#10;
  end;
end;


function TDateFormater.ToDate(str: String): TDateTime;
var
 y,m,d, h,mi,s: word;
 i, start: Integer;
begin
 y:=0; m:=0; d:=0;
 h:=0; mi:=0; s:=0;
 // Firct char
 start := 1;
  for i:=0 to Length(FDateFormat)-1 do
  begin
   case FDateFormat[i].TokenType of
     dfYYYY,
     dfYEAR:   begin
                y := StrToInt(copy(str,start,4));
                Inc(Start,4);
               end;
     dfYY:     begin
                y := StrToInt(copy(str,start,2));
                Inc(Start,2);
                if y < (TwoDigitYearCenturyWindow mod 100) then
                  y := y + 100;
                y := y + (TwoDigitYearCenturyWindow div 100) * 100; // + 1900
               end;

     dfQ:      begin
                m := (StrToInt(copy(str,start,1))-1)*3;
                Inc(Start,1);
               end;

     {dfMONTH:  begin
                m := (StrToInt(copy(str,start,1))-1)*3;
                Inc(Start,1);
                m:=StrToDateTime
               end;}
     //dfMON:    s := FormatDateTime('mmm',dt);
     dfMM:     begin
                m := StrToInt(copy(str,start,2));
                Inc(Start,2);
               end;
     dfM:      begin
                if str[start+1] in ['0'..'9'] then
                 begin
                  m := StrToInt(copy(str,start,2));
                  Inc(Start,2);
                 end
                else
                 begin
                  m := StrToInt(copy(str,start,1));
                  Inc(Start,1);
                 end
               end;
     {dfRM:     case MonthOf(dt) of
                01: s := 'I';
                02: s := 'II';
                03: s := 'III';