How to convert a string to DateTime using a format mask

Problem/Question/Abstract:

How to convert a string to DateTime using a format mask

Answer:

unit FileNameRoutines2;

interface

{DATE-TIME NAME CONVERTER OBJ}

type
  tDateTimeNameConverterObj = class
  private
    fDefiningTemplate: string;
    fOpnBrk,
      fClsBrk: char;
    fSearchTemplate: string;
    fConstructionTemplate: string;
    NYrC: integer;
    YrCs: array[0..3] of integer; {Indexes w/in constr template.}
    NMoC: integer;
    MoCs: array[0..3] of integer;
    NDaC: integer;
    DaCs: array[0..3] of integer;
    NHrC: integer;
    HrCs: array[0..3] of integer;
    NMiC: integer;
    MiCs: array[0..3] of integer;
    NSeC: integer;
    SeCs: array[0..3] of integer;
  public
    constructor CreateFromDateTimeNameTemplate(const aBrackets, aDateTimeNameTemp:
      string);
    property DefiningTemplate: string read fDefiningTemplate;
    property SearchTemplate: string read fSearchTemplate;
    property ConstructionTemplate: string read fConstructionTemplate;
    function DateTimeToName(aDateTime: tDateTime): string;
    function NameToDateTime(const aName: string): tDateTime;
    function IsValidDateTimeName(const aName: string; var aDateTime: tDateTime):
      integer;
  end;

type
  tDateTimeNameConverterObj2 = class
  private
    fDefiningTemplate: string;
    fOpnBrk,
      fClsBrk: char;
    fSearchTemplate: string;
    fConstructionTemplate: string;
    NYrC: integer;
    YrCs: array[0..3] of integer; {Indexes w/in constr template.}
    NMoC: integer;
    MoCs: array[0..3] of integer;
    NDaC: integer;
    DaCs: array[0..3] of integer;
    NHrC: integer;
    HrCs: array[0..3] of integer;
    NMiC: integer;
    MiCs: array[0..3] of integer;
    NSeC: integer;
    SeCs: array[0..3] of integer;
    procedure SetDefiningTemplate(const aDefiningTemplate: string);
  public
    constructor Create(const aBrackets: string);
    property DefiningTemplate: string read fDefiningTemplate write
      SetDefiningTemplate;
    property SearchTemplate: string read fSearchTemplate;
    property ConstructionTemplate: string read fConstructionTemplate;
    function DateTimeToName(aDateTime: tDateTime): string;
    function NameToDateTime(const aName: string): tDateTime;
    function IsValidDateTimeName(const aName: string; var aDateTime: tDateTime):
      integer;
  end;

implementation

uses
  SysUtils;

{ tDateTimeNameConverterObj }

constructor tDateTimeNameConverterObj.CreateFromDateTimeNameTemplate
  (const aBrackets, aDateTimeNameTemp: string);
var
  c: char;
  i: integer;
  InDate: boolean;
begin
  fOpnBrk := aBrackets[1];
  fClsBrk := aBrackets[2];
  fDefiningTemplate := aDateTimeNameTemp;
  fConstructionTemplate := '';
  InDate := false;
  for i := 1 to length(fDefiningTemplate) do
  begin
    c := fDefiningTemplate[i];
    if not InDate then
      if c = fOpnBrk then
      begin
        InDate := true;
        fSearchTemplate := fSearchTemplate + '*';
      end
      else
      begin {copy name characters}
        fConstructionTemplate := fConstructionTemplate + c;
        fSearchTemplate := fSearchTemplate + c;
      end
    else
      if c = fClsBrk then
        InDate := false
      else
      begin
        fConstructionTemplate := fConstructionTemplate + c;
        case UpCase(c) of
          'Y':
            begin
              if NYrC < 4 then
                YrCs[NYrC] := length(fConstructionTemplate);
              Inc(NYrC);
            end;
          'M':
            begin
              if NMoC < 4 then
                MoCs[NMoC] := length(fConstructionTemplate);
              Inc(NMoC);
            end;
          'D':
            begin
              if NDaC < 4 then
                DaCs[NDaC] := length(fConstructionTemplate);
              Inc(NDaC);
            end;
          'H':
            begin
              if NHrC < 2 then
                HrCs[NHrC] := length(fConstructionTemplate);
              Inc(NHrC);
            end;
          'N':
            begin
              if NMiC < 2 then
                MiCs[NMiC] := length(fConstructionTemplate);
              Inc(NMiC);
            end;
          'S':
            begin
              if NSeC < 2 then
                SeCs[NSeC] := length(fConstructionTemplate);
              Inc(NSeC);
            end;
        end;
      end;
  end;
  if ((NYrC <> 2) and (NYrC <> 4)) or ((NMoC <> 0) and (NMoC <> 2)) or ((NMoC = 0) and
    (NDaC < 3)) or ((NMoC <> 0) and (NDaC <> 0) and (NDaC <> 2)) or ((NHrC <> 0) and
    (NHrC <> 2)) or ((NMiC <> 0) and (NMiC <> 2)) or ((NSeC <> 0) and (NSeC <> 2))
      then
    raise Exception.Create(Format('Bad date template (%d, %d, %d, %d, %d, %d)',
      [NYrC, NMoC, NDaC, NHrC, NMiC, NSeC]));
end;

function tDateTimeNameConverterObj.IsValidDateTimeName(const aName: string;
  var aDateTime: tDateTime): integer;

  procedure XX(i: integer; var n: word);
  var
    c: Char;
  begin
    c := aName[i];
    if c in ['0'..'9'] then
      n := 10 * n + (ord(c) - ord('0'))
    else
      Result := i;
  end;

var
  i: Integer;
  y, y2, y0, m, m2, d, d2, h, n, s: Word;
begin
  y := 0;
  m := 0;
  d := 0;
  h := 0;
  n := 0;
  s := 0;
  for i := 0 to NYrC - 1 do
    XX(YrCs[i], y);
  for i := 0 to NMoC - 1 do
    XX(MoCs[i], m);
  for i := 0 to NDaC - 1 do
    XX(DaCs[i], d);
  for i := 0 to NHrC - 1 do
    XX(HrCs[i], h);
  for i := 0 to NMiC - 1 do
    XX(MiCs[i], n);
  for i := 0 to NSeC - 1 do
    XX(SeCs[i], s);
  if m = 0 then
    m := 1;
  if d = 0 then
    d := 1;
  try
    if NYrC = 2 then
    begin {do the Y100 stuff}
      DecodeDate({Current} Date, y2, m2, d2);
      y0 := 100 * (y2 div 100);
      y := y + y0;
      if y < y2 - 50 then
        y := y + 100;
    end;
    aDateTime := EncodeDate(y, m, d) + EncodeTime(h, n, s, 0);
    Result := 0;
  except
    on Exception do
      aDateTime := 0;
  end;
end;

function tDateTimeNameConverterObj.NameToDateTime(const aName: string): tDateTime;
begin
  if IsValidDateTimeName(aName, Result) <> 0 then
    raise Exception.Create('Filename (' + aName + ') does not contain valid date.');
end;

function tDateTimeNameConverterObj.DateTimeToName(aDateTime: tDateTime): string;
var
  Y, M, D, H, N, S, X: Word;
  str: string[5];
  i: integer;
begin
  Result := fConstructionTemplate;
  DecodeDate(aDateTime, Y, M, D);
  DecodeTime(aDateTime, H, N, S, X);
  str := IntToStr(10000 + Y);
  for i := 0 to NYrC - 1 do
    Result[YrCs[i]] := str[i + 6 - NYrC];
  str := IntToStr(10000 + M);
  for i := 0 to NMoC - 1 do
    Result[MoCs[i]] := str[i + 6 - NMoC];
  str := IntToStr(10000 + D);
  for i := 0 to NDaC - 1 do
    Result[DaCs[i]] := str[i + 6 - NDaC];
  str := IntToStr(10000 + H);
  for i := 0 to NHrC - 1 do
    Result[HrCs[i]] := str[i + 6 - NHrC];
  str := IntToStr(10000 + N);
  for i := 0 to NMiC - 1 do
    Result[MiCs[i]] := str[i + 6 - NMiC];
  str := IntToStr(10000 + S);
  for i := 0 to NSeC - 1 do
    Result[SeCs[i]] := str[i + 6 - NSeC];
end;

{ tDateTimeNameConverterObj2 }

constructor tDateTimeNameConverterObj2.Create(const aBrackets: string);
begin
  fOpnBrk := aBrackets[1];
  fClsBrk := aBrackets[2];
end;

procedure tDateTimeNameConverterObj2.SetDefiningTemplate(const aDefiningTemplate:
  string);
var
  c: Char;
  i: integer;
  InDate: boolean;
begin
  fDefiningTemplate := aDefiningTemplate;
  fConstructionTemplate := '';
  fSearchTemplate := '';
  fConstructionTemplate := '';
  NYrC := 0;
  NMoC := 0;
  NDaC := 0;
  NHrC := 0;
  NMiC := 0;
  NSeC := 0;
  InDate := false;
  for i := 1 to length(fDefiningTemplate) do
  begin
    c := fDefiningTemplate[i];
    if not InDate then
      if c = fOpnBrk then
      begin
        InDate := true;
        fSearchTemplate := fSearchTemplate + '*';
      end
      else
      begin {copy name characters}
        fConstructionTemplate := fConstructionTemplate + c;
        fSearchTemplate := fSearchTemplate + c;
      end
    else if c = fClsBrk then
      InDate := false
    else
    begin
      fConstructionTemplate := fConstructionTemplate + c;
      case UpCase(c) of
        'Y':
          begin
            if NYrC < 4 then
              YrCs[NYrC] := length(fConstructionTemplate);
            Inc(NYrC);
          end;
        'M':
          begin
            if NMoC < 4 then
              MoCs[NMoC] := length(fConstructionTemplate);
            Inc(NMoC);
          end;
        'D':
          begin
            if NDaC < 4 then
              DaCs[NDaC] := length(fConstructionTemplate);
            Inc(NDaC);
          end;
        'H':
          begin
            if NHrC < 2 then
              HrCs[NHrC] := length(fConstructionTemplate);
            Inc(NHrC);
          end;
        'N':
          begin
            if NMiC < 2 then
              MiCs[NMiC] := length(fConstructionTemplate);
            Inc(NMiC);
          end;
        'S':
          begin
            if NSeC < 2 then
              SeCs[NSeC] := length(fConstructionTemplate);
            Inc(NSeC);
          end;
      end;
    end;
  end;
  if ((NYrC <> 2) and (NYrC <> 4)) or ((NMoC <> 0) and (NMoC <> 2)) or ((NMoC = 0) and
    (NDaC < 3)) or ((NMoC <> 0) and (NDaC <> 0) and (NDaC <> 2)) or ((NHrC <> 0) and
    (NHrC <> 2)) or ((NMiC <> 0) and (NMiC <> 2)) or ((NSeC <> 0) and (NSeC <> 2))
      then
    raise Exception.Create(Format('Bad date template (%d, %d, %d, %d, %d, %d)',
      [NYrC, NMoC, NDaC, NHrC, NMiC, NSeC]));
end;

function tDateTimeNameConverterObj2.IsValidDateTimeName(const aName: string;
  var aDateTime: tDateTime): integer;

  procedure XX(i: integer; var n: word);
  var
    c: Char;
  begin
    c := aName[i];
    if c in ['0'..'9'] then
      n := 10 * n + (ord(c) - ord('0'))
    else
      Result := i;
  end;

var
  i: integer;
  y, y2, y0, m, m2, d, d2, h, n, s: Word;
begin
  y := 0;
  m := 0;
  d := 0;
  h := 0;
  n := 0;
  s := 0;
  for i := 0 to NYrC - 1 do
    XX(YrCs[i], y);
  for i := 0 to NMoC - 1 do
    XX(MoCs[i], m);
  for i := 0 to NDaC - 1 do
    XX(DaCs[i], d);
  for i := 0 to NHrC - 1 do
    XX(HrCs[i], h);
  for i := 0 to NMiC - 1 do
    XX(MiCs[i], n);
  for i := 0 to NSeC - 1 do
    XX(SeCs[i], s);
  if m = 0 then
    m := 1;
  if d = 0 then
    d := 1;
  try
    if NYrC = 2 then
    begin {do the Y100 stuff}
      DecodeDate({Current} Date, y2, m2, d2);
      y0 := 100 * (y2 div 100);
      y := y + y0;
      if y < y2 - 50 then
        y := y + 100;
    end;
    aDateTime := EncodeDate(y, m, d) + EncodeTime(h, n, s, 0);
    Result := 0;
  except
    on Exception do
      aDateTime := 0;
  end;
end;

function tDateTimeNameConverterObj2.NameToDateTime(const aName: string): tDateTime;
begin
  if IsValidDateTimeName(aName, Result) <> 0 then
    raise Exception.Create('Filename (' + aName + ') does not contain valid date.');
end;

function tDateTimeNameConverterObj2.DateTimeToName(aDateTime: tDateTime): string;
var
  Y, M, D, H, N, S, X: Word;
  str: string[5];
  i: integer;
begin
  Result := fConstructionTemplate;
  DecodeDate(aDateTime, Y, M, D);
  DecodeTime(aDateTime, H, N, S, X);
  str := IntToStr(10000 + Y);
  for i := 0 to NYrC - 1 do
    Result[YrCs[i]] := str[i + 6 - NYrC];
  str := IntToStr(10000 + M);
  for i := 0 to NMoC - 1 do
    Result[MoCs[i]] := str[i + 6 - NMoC];
  str := IntToStr(10000 + D);
  for i := 0 to NDaC - 1 do
    Result[DaCs[i]] := str[i + 6 - NDaC];
  str := IntToStr(10000 + H);
  for i := 0 to NHrC - 1 do
    Result[HrCs[i]] := str[i + 6 - NHrC];
  str := IntToStr(10000 + N);
  for i := 0 to NMiC - 1 do
    Result[MiCs[i]] := str[i + 6 - NMiC];
  str := IntToStr(10000 + S);
  for i := 0 to NSeC - 1 do
    Result[SeCs[i]] := str[i + 6 - NSeC];
end;

end.