unit ABSDateFormat;

{$I ABSVer.inc}

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

interface
uses SysUtils, math, windows,
     ABSExcept,
     ABSTypes,
     ABSConst;

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: TABSAdvancedFieldType;
   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 AnsiChar(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';
                04: s := 'IV';
                05: s := 'V';
                06: s := 'VI';
                07: s := 'VII';
                08: s := 'VIII';
                09: s := 'IX';
                10: s := 'X';
                11: s := 'XI';
                12: s := 'XII';
               end;}

     //dfDDD:    s := Format('%d',[DayOfTheYear(dt)]);
     dfDD:     begin
                d := (StrToInt(copy(str,start,2)));
                Inc(Start,2);
               end;
     dfD:      begin
                if AnsiChar(str[start+1]) in ['0'..'9'] then
                 begin
                  d := (StrToInt(copy(str,start,2)));
                  Inc(Start,2);
                 end
                else
                 begin
                  d := StrToInt(copy(str,start,1));
                  Inc(Start,1);
                 end
               end;
     //dfDAY:    s:=FormatDateTime('dddd',dt);
     //dfDY:     s:=FormatDateTime('ddd',dt);
     //dfD:      s := Format('%d',[DayOfTheWeek(dt)]);

     dfH24:   begin
                if AnsiChar(str[start+1]) in ['0'..'9'] then
                 begin
                  h := (StrToInt(copy(str,start,2)));
                  Inc(Start,2);
                 end
                else
                 begin
                  h := (StrToInt(copy(str,start,1)));
                  Inc(Start);
                 end
               end;
     dfHH24:   begin
                h := (StrToInt(copy(str,start,2)));
                Inc(Start,2);
               end;
     dfHH12,
     dfHH:     begin
                if AnsiChar(str[start+1]) in ['0'..'9'] then
                 begin
                  h := (StrToInt(copy(str,start,2)));
                  Inc(Start,2);
                 end
                else
                 begin
                  h := (StrToInt(copy(str,start,1)));
                  Inc(Start,1);
                 end
               end;

     dfNN:     begin
                mi := (StrToInt(copy(str,start,2)));
                Inc(Start,2);
               end;

     dfN:      begin
                if AnsiChar(str[start+1]) in ['0'..'9'] then
                 begin
                  mi := (StrToInt(copy(str,start,2)));
                  Inc(Start,2);
                 end
                else
                 begin
                  mi := (StrToInt(copy(str,start,1)));
                  Inc(Start,1);
                 end
               end;

     dfSS:     begin
                s := (StrToInt(copy(str,start,2)));
                Inc(Start,2);
               end;

     dfS:      begin
                if AnsiChar(str[start+1]) in ['0'..'9'] then
                 begin
                  s := (StrToInt(copy(str,start,2)));
                  Inc(Start,2);
                 end
                else
                 begin
                  s := (StrToInt(copy(str,start,1)));
                  Inc(Start,1);
                 end
               end;

     dfAMPM:   begin
                if UpperCase(copy(str,start,2))='PM' then
                 h := h + 12
                else
                 if UpperCase(copy(str,start,2))<>'AM' then
                  raise EABSException.Create(30129, ErrorGAmPmExpected, [copy(str,start,2)]);
                Inc(Start,2);
               end;

     dfText:   begin
                Inc(Start, Length(FDateFormat[i].Text));
               end;
     else
      Inc(Start, Length(FDateFormat[i].Text));
      //raise Exception.Create('Unsupported DateFormatType');
   end;
  end;
  if (y=0) or (m=0) or (d=0) then
   begin
     y:=1899; m:=12; d:=30;
   end;
 Result := EncodeDate(y,m,d) + EncodeTime(h,mi,s,0);
end;

function TDateFormater.ToString(dt: TDateTime): string;
var
 i: Integer;
 s: string;
begin
 Result := '';
 for i:=0 to Length(FDateFormat)-1 do
  begin
   case FDateFormat[i].TokenType of
     dfYYYY,
     dfYEAR:   s := FormatDateTime('yyyy',dt);
     dfYY:     s := FormatDateTime('yy',dt);

     dfQ:      s := Format('%d',[(((MonthOf(dt)-1) div 3) + 1)]);

     dfMONTH:  s := FormatDateTime('mmmm',dt);
     dfMON:    s := FormatDateTime('mmm',dt);
     dfMM:     s := FormatDateTime('mm',dt);
     dfM:      s := FormatDateTime('m',dt);
     dfRM:     case MonthOf(dt) of
                01: s := 'I';
                02: s := 'II';
                03: s := 'III';
                04: s := 'IV';
                05: s := 'V';
                06: s := 'VI';
                07: s := 'VII';
                08: s := 'VIII';
                09: s := 'IX';
                10: s := 'X';
                11: s := 'XI';
                12: s := 'XII';
               end;

     dfDDD:    s:=FormatDateTime('ddd',dt);
     dfDD:     s := FormatDateTime('dd',dt);
     dfD:      s := FormatDateTime('d',dt);
     dfDAY:    s:=FormatDateTime('dddd',dt);
     dfDY:     s := Format('%d',[DayOfTheYear(dt)]);
     dfDW:     s := Format('%d',[DayOfTheWeek(dt)]);

     dfHH24:   s := FormatDateTime('hh',dt);
     dfHH,
     dfHH12:   s := Format('%.2d', [HourOfTheDay(dt) mod 12]);

     dfH24:   s := FormatDateTime('h',dt);
     dfH,
     dfH12:   s := Format('%d', [HourOfTheDay(dt) mod 12]);

     dfNN:     s := FormatDateTime('nn',dt);
     dfN:     s := FormatDateTime('n',dt);

     dfSS:     s := FormatDateTime('ss',dt);
     dfS:      s := FormatDateTime('s',dt);

     dfAMPM:   begin
                 if HourOfTheDay(dt) < 12 then
                   s := AM
                 else
                   s := PM
               end;
     dfText:   s := FDateFormat[i].Text;
     else
      raise Exception.Create('Unknown DateFormatType');
   end;
   Result := Result + s;
  end;

end;


function TDateFormater.GetStringMaxSize: Integer;
var
 i, s: Integer;
begin
 Result := 0;
 for i:=0 to Length(FDateFormat)-1 do
  begin
   case FDateFormat[i].TokenType of
     dfYYYY,
     dfYEAR:   s := 4;
     dfYY:     s := 2;

     dfQ:      s := 1;

     dfMONTH:  s := 9;
     dfMON:    s := 3;
     dfMM:     s := 2;
     dfM:      s := 2;
     dfRM:     s := 4;
     dfDDD:    s := 3;
     dfDD:     s := 2;
     dfDAY:    s := 12;
     dfDY:     s := 4; // with 3 there was buffer error 7.81
     dfD:      s := 2;
     dfDW:     s := 2;

     dfH24,
     dfH,
     dfH12,
     dfHH24,
     dfHH,
     dfHH12:   s := 2;

     dfNN,
     dfN:      s := 2;

     dfS,
     dfSS:     s := 2;

     dfAMPM:   s := 2;

     dfText:   s := length(FDateFormat[i].Text);
     else
      raise Exception.Create('Unknown DateFormatType');
   end;
   Result := Result + s;
  end;
end;


function TDateFormater.GetDataType: TABSAdvancedFieldType;
var
 i: Integer;
 bDate: Boolean;
 bTime: Boolean;
begin
 bDate := False;
 bTime := False;
 for i:=0 to Length(FDateFormat)-1 do
  begin
   case FDateFormat[i].TokenType of
     dfYYYY,
     dfYEAR,
     dfYY,
     dfQ,
     dfMONTH,
     dfMON,
     dfMM,
     dfM,
     dfRM,
     dfDDD,
     dfDD,
     dfDAY,
     dfDY,
     dfD,
     dfDW:
       bDate := True;

     dfH24,
     dfH,
     dfH12,
     dfHH24,
     dfHH,
     dfHH12,
     dfNN,
     dfN,
     dfS,
     dfSS,
     dfAMPM:
       bTime := True;
   end;
  end;
 if ((not bDate) and bTime) then
   Result := aftTime
 else
 if ((not bTime) and bDate) then
   Result := aftDate
 else
   Result := aftDateTime
end;


var i: integer;
begin
  // INIT DateFormatReservedWordsMaxLength value

  DateFormatReservedWordsMaxLength := 0;
  for i:=0 to DateFormatReservedWordsCount-1 do
   if length(DateFormatReservedWords[i]) > DateFormatReservedWordsMaxLength then
     DateFormatReservedWordsMaxLength := length(DateFormatReservedWords[i]);

end.
