Поиск по этому блогу

понедельник, 14 марта 2011 г.

Преобразование даты из одного формата в другой, без использования TDateTime.

Задача. Получить дату в виде строки (из txt файла), преобразовать ее в формат понятный для БД. В дальнейшем преобразованная дата может быть залита в базу или в CSV файл (файл с разделителями)
Необходимо учесть, что разделители могут отсутствовать вовсе, и не совпадать с системными.
To-do Функции проверки даты ...



Алгоритм.
    Задаем формат даты в строчном виде (ddmmyyyy hh:nn:ss.zzz), на основании этого формата мы можем узнать порядок переменных YMDHNSZ (сохраняем в DT_order), а также количество дней, месяцев ... для этого формата.
Для простоты dd два символа, больше для моей задачи не используется, т.к. дни недели в дате не фигурируют, однако
возможность использования дней недели вполне можно дописать.
месяц может быть задан двуми символами (mm=01..12), тремя (mm=Янв...Дек), четырьмя (mmmm=Январь...Декабрь)
год четырехзначный. SetFromat(edFormatFrom.Text,FormatFrom)
    Для того, чтобы декодировать строчку пробегаемся по массиву DT_order (порядок переменных) и выделяем эти переменные в соответствии с форматом, заполняя поля записи w_Year,w_Month,w_Day...
DateTimeStr - строка, например 1/2/2011 14:21:55.333.
procedure FMDDate_SetDate(const DateTimeStr: string; var DTSettingFrom: TFMTDateTimeString);
    Чтобы получить дату в другом формате опять таки пробегаемся по массиву DT_order и собираем дату.
Функция возвращает строку в заданном формате. 
    function FMDDate_GetStrDateTimeByFormat(const DTSettingFrom: TFMTDateTimeString): string;

Спецификация формата даты-времени почти стандартная, т.е.
dd      the day as a number with a leading zero or space (01-31).
mm    the month as a number with a leading zero or space (01-12).
mmm  the month as an abbreviation (Jan-Dec)
mmmm the month as a full name (January-December)
yy        the year as a two-digit number (00-99).  - не использую (пока)
yyyy    the year as a four-digit number (0000-9999).
hh       the hour with a leading zero or space (00-23)
nn       the minute with a leading zero or space (00-59).
ss       the second with a leading zero or space (00-59).
zzz     the millisecond with a leading zero (000-999).

Особенности и ограничения.
Общий порядок. сначала дата, потом время, мсек всегда последние
никаких of, at am/pm, а также эры

Даты могут не содержать сепараторов, т.е. допустимо ddmmyyyy, недопустимо dmyy

Дата может задаваться в любом порядке (YMD DMY...)

Разделитель сек.мсек - точка
Допустимые разделители: отсутствие такового,  "/ ", "-" , "." , ":" ,  ";" , пробел

Точку можно использовать в качестве разделителя даты dd.mm.yyyy, нельзя
в качестве разделителя времени hh.nn 

Использование.
//*****************************************************************************
объявляем переменные типа TFMTDateTimeString
var
    FormatFrom: TFMTDateTimeString;
    FormatTo: TFMTDateTimeString;

// очищаем данные
 ClearFMTData(FormatFrom);
 ClearFMTData(FormatTo);

 // устанавливаем формат даты 
 SetFromat(edFormatFrom.Text,FormatFrom); // где edFormatFrom.Text - dd/mm/yyyy hh:nn:ss.zzz
 SetFromat(edFormatTo.Text,FormatTo); // где edFormatTo.Text - dd.mm.yyyy hh:nn:ss.zzz
 // устанавливаем дату из строки
 FMDDate_SetDate(edDate.Text, FormatFrom); // где edDate.Text - 1/2/2011 14:21:55.333
 // если были ошибки - сообщаем
 MemoResult.Lines.Add(FormatFrom.FormatError);

 // возврат значения через копирование
 FMDDate_DTFCopy(FormatFrom, FormatTo);
 // получить дату в другом формате
 tmp := FMDDate_GetStrDateTimeByFormat(FormatTo);
 MemoResult.Lines.Add('Дата в новом формате ');
 MemoResult.Lines.Add(tmp);
//*****************************************************************************
сам модуль
unit StrDateTimeUtils;
interface
uses sysutils, strUtils, DateUtils, Variants;
type
// эта запись будет хранить
// дату время в декодированном виде
// форматы преобразования
  TFMTDateTimeString = record
    DateSeparator: Char;
    TimeSeparator: Char;
    Date_TimeSeparator: Char; // разделитель м-ду Датой и временем обычно пробел
    ListSeparator: Char;
    // год,месяц,день
    Y_count,M_count,D_count: word;
    // час,минута,секунда,миллисекунда
    H_count,N_count,S_count,Z_count: word;
    // собственно сама дата в раскодированном виде
    // числовое представление
    // год,месяц,день
    w_Year,w_Month,w_Day: word;
    // час,минута,секунда,миллисекунда
    w_Hour,w_Minute,w_Sec,w_Msec: word;
    // ну и чтобы два раза не бегать строчные тоже сохраним
    // год,месяц,день
    ss_Year,ss_Month,ss_Day: string;
    // час,минута,секунда,миллисекунда
    ss_Hour,ss_Minute,ss_Second,ss_Msec: string;
    // порядок YMD DMY MDY ?? DYM (а вдруг) hnsz...am/pm??
    DT_order: array[1..10] of char; //
    DT_string_Format: string; // сам формат в виде строки
    DT_string: string; // сама дата в виде строки
    ShortMonthNames: array[1..12] of string;
    LongMonthNames: array[1..12] of string;
    // сюда будем писать ошибки
    FormatError: string;
  end;
    // установить формат даты-времени по строке
    // DTFormat - формат ввода, например dd/mm/yyyy hh:nn:ss.zzz
    procedure SetFromat(const DTFormat: string; var DTSetting:TFMTDateTimeString);
    // очистить формат. (!!! данные остаются !!!)
    procedure ClearFormat(var DTSetting:TFMTDateTimeString);
    // очистить данные. (!!! формат не трогаем !!!)
    procedure ClearFMTData(var DTSetting: TFMTDateTimeString);
    // залить данные в запись типа TFMTDateTimeString
    procedure FMDDate_SetDate(const DateTimeStr: string; var DTSettingFrom: TFMTDateTimeString);
    // копируем данные из одной записи в другую
    procedure FMDDate_DTFCopy(const DTSettingFrom: TFMTDateTimeString; var DTSettingTo:  TFMTDateTimeString);
    // получить дату в строчном виде из данных DTSettingFrom в соответствии с установленным форматом
    function FMDDate_GetStrDateTimeByFormat(const DTSettingFrom: TFMTDateTimeString): string;


implementation

procedure ClearFMTData(var DTSetting: TFMTDateTimeString);
begin
  with DTSetting do
  begin
    w_Year := 0; w_Month := 0; w_Day := 0;
    w_Hour := 0; w_Minute := 0; w_Sec := 0; w_Msec := 0;

    ss_Year := ''; ss_Month := ''; ss_Day := '';
    ss_Hour:= ''; ss_Minute:= '';ss_Second:= '';ss_Msec:= '';
  end;
end;

procedure ClearFormat(var DTSetting: TFMTDateTimeString);
var
 i: word;
begin
  DTSetting.DateSeparator := #0;
  DTSetting.Date_TimeSeparator := #0;
  DTSetting.TimeSeparator := #0;
       
  with DTSetting do
  begin
    Y_count := 0; D_count := 0; M_count := 0;
    H_count := 0; N_count := 0; S_count := 0; Z_count := 0;
  end;
  // порядок
  for I := 0 to length(DTSetting.DT_order) do
     DTSetting.DT_order[i]:=#0;

  DTSetting.DT_string_Format := ''; // сам формат в виде строки
  DTSetting.DT_string := ''; // сама дата в виде строки

  // месяцы (независимо от установок системы)
// можно брать из локали, но лучше реализовать это в отдельной процедуре
  DTSetting.ShortMonthNames[1]:='ЯНВ';
  DTSetting.ShortMonthNames[2]:='ФЕВ';
  DTSetting.ShortMonthNames[3]:='МАР';
  DTSetting.ShortMonthNames[4]:='АПР';
  DTSetting.ShortMonthNames[5]:='МАЙ';
  DTSetting.ShortMonthNames[6]:='ИЮН';
  DTSetting.ShortMonthNames[7]:='ИЮЛ';
  DTSetting.ShortMonthNames[8]:='АВГ';
  DTSetting.ShortMonthNames[9]:='СЕН';
  DTSetting.ShortMonthNames[10]:='ОКТ';
  DTSetting.ShortMonthNames[11]:='НОЯ';
  DTSetting.ShortMonthNames[12]:='ДЕК';

  // месяцы (независимо от установок системы)
  DTSetting.LongMonthNames[1]:='ЯНВАРЬ';
  DTSetting.LongMonthNames[2]:='ФЕВРАЛЬ';
  DTSetting.LongMonthNames[3]:='МАРТ';
  DTSetting.LongMonthNames[4]:='АПРЕЛЬ';
  DTSetting.LongMonthNames[5]:='МАЙ';
  DTSetting.LongMonthNames[6]:='ИЮНЬ';
  DTSetting.LongMonthNames[7]:='ИЮЛЬ';
  DTSetting.LongMonthNames[8]:='АВГУСТ';
  DTSetting.LongMonthNames[9]:='СЕНТЯБРЬ';
  DTSetting.LongMonthNames[10]:='ОКТЯБРЬ';
  DTSetting.LongMonthNames[11]:='НОЯБРЬ';
  DTSetting.LongMonthNames[12]:='ДЕКАБРЬ';

end;

// устанавливаем формат в соответствии со строкой
// DTFormat = dd.mm.yyyy hh:nn:ss.zzz
// DTFormat = ddmmyyyy hh:nn:ss.zzz

procedure SetFromat(const DTFormat: string;   var DTSetting: TFMTDateTimeString);
var
 i: integer;
 //dtf_char: string;
 series_i: integer;
 Y_count, M_count, D_count: word;
 last_char, curr_char: char;
 test_str: string;
begin
  ClearFormat(DTSetting); // чистим формат
  DTSetting.DT_string_Format := DTFormat; // сам формат в виде строки
  I := 1; series_i:=1;
  last_char := '0'; curr_char:='0';
  while I <= Length(DTFormat) do
  begin
    // function Chr(X: Byte): Char; Returns the character for a specified ASCII value.
    //'E': эру игнорируем
  case Chr(Ord(DTFormat[I]) and $DF) of
       'Y': begin
        //dtf_char := 'ГОД';
        curr_char := 'Y';
        inc(DTSetting.Y_count);
      end;
      'M': begin
        //dtf_char := 'месяц';
        curr_char := 'M';
        inc(DTSetting.M_count);
      end;
      'D': begin
        //dtf_char := 'день';
        curr_char := 'D';
        inc(DTSetting.D_count);
      end;
      'H': begin
        //dtf_char := 'час';
        curr_char := 'H';
        inc(DTSetting.H_count);
      end;
      'N': begin
        //dtf_char := 'минута';
        curr_char := 'N';
        inc(DTSetting.N_count);
      end;
      'S': begin
        //dtf_char := 'секунда';
        curr_char := 'S';
        inc(DTSetting.S_count);
      end;
      'Z': begin
        //dtf_char := 'миллисекунда';
        curr_char := 'Z';
        inc(DTSetting.Z_count);
      end;
     end; // case

      // это сепараторы
     case DTFormat[I] of
      '/': begin
        if series_i<4  then
        DTSetting.DateSeparator:='/';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:='/';
        // время
        if series_i>4 then
        DTSetting.TimeSeparator:='/';
      end;
      '-': begin
        if series_i<4  then
        DTSetting.DateSeparator:='-';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:='-';
        // время
        if series_i>4 then
        DTSetting.TimeSeparator:='-';
      end;
      ' ': begin
        if series_i<3  then
        DTSetting.DateSeparator:=' ';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:=' ';
        // время
        if series_i>4 then
        DTSetting.TimeSeparator:=' ';
      end;
      '.': begin
        // если серия до 4 - это еще date separator
        if series_i<4  then
        DTSetting.DateSeparator:='.';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:='.';
        // время
        // она же (.) может быть sec.msec сепаратором
        // поэтому запрещаем его использование в кач-ве time separatora
      end;
      ':': begin
        if series_i<4  then
        DTSetting.DateSeparator:=':';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:=':';
        // время
        if series_i>4 then
        DTSetting.TimeSeparator:=':';
      end;
      ';': begin
        if series_i<4  then
        DTSetting.DateSeparator:=';';
        // между датой и временем
        if series_i=4 then
        DTSetting.Date_TimeSeparator:=';';
        // время
        if series_i>4 then
        DTSetting.TimeSeparator:=';';
      end;

     end; // case сепараторы

        // новая серия
        if curr_char<>last_char then
        begin
          DTSetting.DT_order[series_i] := curr_char;
          series_i := series_i+1;
        end;

        last_char := curr_char;

   
    inc(i);
  end;
  test_str := DTSetting.DT_order;
  //MemoResult.Lines.Add(dtf_char + ' ' + test_str);

end;

// заливаем данные в соответствии с установленным форматом
// DateTimeStr - сами данные в виде строки
// 01/02/2011 14:21:55.333
procedure FMDDate_SetDate(const DateTimeStr: string; var DTSettingFrom: TFMTDateTimeString);
var
 i, j: integer;
 m_i, m_len: Word;
 StartPos, DTStrLen: integer;

 s_Year, s_Month, s_Day: string;
 s_Hour, s_Minute,s_Second,s_MSec: string;

 temp_int,temp_int2:integer;
 tmp_str: string;

begin
DTSettingFrom.FormatError := '';
 DTSettingFrom.DT_string := DateTimeStr; // сохраняем исходную строчку
// DT_order должен содержать строку вида DMYHNSZ
// сначала декодируем строчку
 StartPos := 1;
 DTStrLen := length(DateTimeStr);
 for I := 1 to Length(DTSettingFrom.DT_order) do
 begin
    case Chr(Ord(DTSettingFrom.DT_order[i]) and $DF) of
    'D': begin
      // проверяем что не вышли за рамки строки
      // count-1 т.к. 1 символ уходит на исправление ошибки d/=/dd
      if (StartPos+DTSettingFrom.D_count-1)>DTStrLen+1 then break;
      s_Day := MidStr(DateTimeStr,StartPos,DTSettingFrom.D_count);
      // надо подстраховаться, пользователь мог определить
      // дату 1/2/2011, а формат dd/mm/yyyy
      // *вариант решения 2 для дат без сепараторов предпочтительнее
      // использовать DTSettingFrom.D_count,
      // а для дат с сепараторами вырезать от сепаратора до сепаратора
      // *вариант решения 1 просто удалить сепаратор
      // исправляем
      if  ord(DTSettingFrom.DateSeparator)=ord(s_Day[DTSettingFrom.D_count])
      then begin
       delete(s_Day,DTSettingFrom.D_count,1);
       // для единообразия
       s_Day := '0'+s_Day;
       StartPos := StartPos-1;
      end;
      // оцифровываем
      if trystrtoint(s_Day,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. День %s',[s_Day]);
        exit;
      end else DTSettingFrom.w_Day := temp_int;

      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.D_count + 1
      else
      StartPos := StartPos + DTSettingFrom.D_count;
    end;
    'M': begin
      // проверяем что не вышли за рамки строки
      if DTSettingFrom.M_count<=2  then
      begin
      if (StartPos+DTSettingFrom.M_count-1)>DTStrLen+1 then break;
      s_Month := MidStr(DateTimeStr,StartPos,DTSettingFrom.M_count);

      // исправляем пользователя
      if  ord(DTSettingFrom.DateSeparator)=ord(s_Month[DTSettingFrom.M_count])
      then begin
       delete(s_Month,DTSettingFrom.M_count,1);
       StartPos := StartPos-1;
       // для единообразия
       s_Month := '0'+s_Month;
      end;
      // оцифровываем
      if trystrtoint(s_Month,temp_int)=false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Месяц %s',[s_Month]);
        exit;
      end else  DTSettingFrom.w_Month := temp_int;

      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.M_count + 1
      else
      StartPos := StartPos + DTSettingFrom.M_count;
      end; // if DTSettingFrom.M_count<=2

      // JAN..DEC ЯНВ..ФЕВ
      if DTSettingFrom.M_count=3 then
      begin
        s_Month := MidStr(DateTimeStr,StartPos,DTSettingFrom.M_count);
        // вытащить из массива месяц
        for m_i := 1 to 12 do
          begin
            IF uppercase(s_Month) = DTSettingFrom.ShortMonthNames[m_i] then
            begin
             DTSettingFrom.w_Month := m_i;
             break;
            end; // if
          end; // for
     
      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.M_count + 1
      else
      StartPos := StartPos + DTSettingFrom.M_count; 
      end; // if JAN..DEC ЯНВ..ФЕВ

      // длинный месяц ЯНВАРЬ..ФЕВРАЛЬ
      if DTSettingFrom.M_count=4 then
      begin
        s_Month := MidStr(DateTimeStr,StartPos,DTSettingFrom.M_count);
        // вытащить из массива месяц
        for m_i := 1 to 12 do
          begin
            IF pos(uppercase(s_Month),DTSettingFrom.LongMonthNames[m_i])>=1 then
            begin
             DTSettingFrom.w_Month := m_i;
             s_Month := DTSettingFrom.LongMonthNames[m_i];
             m_len := length(s_Month);
             break;
            end; // if
          end; // for
   
     
      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos + m_len + 1
      else
      StartPos := StartPos + m_len; 
     end; // // ЯНВАРЬ..ФЕВРАЛЬ
         // здесь можно запустить проверку (для других аналогично)
         if DTSettingFrom.w_Month > 12  then
         begin
        DTSettingFrom.FormatError := format('Некорректные данные. Месяц %s',[s_Month]);
        //exit; или продолжаем, юзер потом исправит
      end;


    end; // 'M'
    'Y': begin
       // только четыре символа
      // проверяем что не вышли за рамки строки
      if (StartPos+DTSettingFrom.Y_count-1)>DTStrLen+1 then break;
      s_Year := MidStr(DateTimeStr,StartPos,DTSettingFrom.Y_count);

      // оцифровываем
      if trystrtoint(s_Year,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Год %s',[s_Year]);
        exit;
      end else DTSettingFrom.w_Year := temp_int;

      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.Y_count + 1
      else
      StartPos := StartPos + DTSettingFrom.Y_count;
    end;
    'H': begin
      if DTSettingFrom.DateSeparator <> #0 then
      StartPos := StartPos-1; // отсекаем все лишнее (последний сепаратор от разбора даты)
      if StartPos<=0 then StartPos:=1; // на всякий
      // добавляем сепаратор м-ду датой-временем
      if DTSettingFrom.Date_TimeSeparator <> #0 then
      StartPos:=StartPos+1;

      // проверяем что не вышли за рамки строки
      if (StartPos+DTSettingFrom.H_count-1)>DTStrLen+1 then break;

      s_Hour := MidStr(DateTimeStr,StartPos,DTSettingFrom.H_count);

      // исправляем
      if  ord(DTSettingFrom.TimeSeparator)=ord(s_Hour[DTSettingFrom.H_count])
      then begin
       delete(s_Hour,DTSettingFrom.H_count,1);
       s_Hour := '0'+s_Hour; // для единообразия
       StartPos := StartPos-1;
      end;

      // оцифровываем
      if trystrtoint(s_Hour,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Час %s',[s_Hour]);
        exit;
      end else DTSettingFrom.w_Hour := temp_int;

      if DTSettingFrom.TimeSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.H_count + 1
      else
      StartPos := StartPos + DTSettingFrom.H_count;

    end;
    'N': begin
      // проверяем что не вышли за рамки строки
      if (StartPos+DTSettingFrom.N_count-1)>DTStrLen+1 then break;

      s_Minute := MidStr(DateTimeStr,StartPos,DTSettingFrom.N_count);

      // исправляем
      if  ord(DTSettingFrom.TimeSeparator)=ord(s_Minute[DTSettingFrom.N_count])
      then begin
       delete(s_Minute,DTSettingFrom.N_count,1);
       s_Minute := '0'+s_Minute; // для единообразия
       StartPos := StartPos-1;
      end;

      // оцифровываем
      if trystrtoint(s_Minute,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Минута %s',[s_Minute]);
        exit;
      end else DTSettingFrom.w_Minute := temp_int;

      if DTSettingFrom.TimeSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.N_count + 1
      else
      StartPos := StartPos + DTSettingFrom.N_count;
    end;
   'S': begin
      // проверяем что не вышли за рамки строки
      if (StartPos+DTSettingFrom.S_count-1)>DTStrLen+1 then break;

      s_Second := MidStr(DateTimeStr,StartPos,DTSettingFrom.S_count);

      // исправляем
      if  (ord('.')=ord(s_Second[DTSettingFrom.S_count]))
      or  (ord(DTSettingFrom.TimeSeparator)=ord(s_Second[DTSettingFrom.S_count]))
      then begin
       delete(s_Second,DTSettingFrom.S_count,1);
       s_Second := '0'+s_Second; // для единообразия
       StartPos := StartPos-1;
      end;

      // оцифровываем
      if trystrtoint(s_Second,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Секунда %s',[s_Second]);
        exit;
      end else DTSettingFrom.w_Sec := temp_int;

      if DTSettingFrom.TimeSeparator <> #0 then
      StartPos := StartPos + DTSettingFrom.S_count + 1
      else
      StartPos := StartPos + DTSettingFrom.S_count;
    end;
   'Z': begin
      // проверяем что не вышли за рамки строки
      // если мсек имеют меньшую длину, все равно берем
      s_MSec := MidStr(DateTimeStr,StartPos,DTSettingFrom.Z_count);
      // оцифровываем
      if trystrtoint(s_MSec,temp_int) = false then
      begin
        // или возбуждаем исключение
        DTSettingFrom.FormatError := format('Некорректные данные. Мсек %s',[s_MSec]);
        exit;
      end else DTSettingFrom.w_Msec := temp_int;


    end;

    end; // case

 end; // for
  // до кучи сохраняем в строчном виде, необязательно
  with DTSettingFrom do
  begin
   ss_Year := s_Year;
   ss_Month := s_Month;
   ss_Day := s_Day;
   ss_Hour:= s_Hour;
   ss_Minute:= s_Minute;
   ss_Second:= s_Second;
   ss_Msec:= s_Msec;
  end;

   { тестовый вывод
  with DTSettingFrom do
  begin
  MemoResult.Lines.Add(
  format(
  ' год: %d, месяц: %d, день: %d,'
  + ' час: %d,минута: %d,секунда: %d, миллисекунда: %d',
  [w_Year,w_Month,w_Day,w_Hour,w_Minute,w_Sec,w_Msec]));

  MemoResult.Lines.Add(
  format(
  ' год: %s, месяц: %s, день: %s,'
  + ' час: %s, минута: %s, секунда: %s, миллисекунда: %s',
  [s_Year,s_Month,s_Day,s_Hour,s_Minute,s_Second,s_Msec]));
  end; // with
    }
end;

//  / отдаем дату в соответствии с установленным форматом
// до применения у записи TFMTDateTimeString должен быть
// установлен формат (SetFormat), залиты данные (FMDDate_SetDate)

function FMDDate_GetStrDateTimeByFormat(const DTSettingFrom: TFMTDateTimeString): string;
var
 i, j: integer;
 ResStr: string;
 tmp_str, pad_str: string;
begin
 ResStr := '';
 // отдаем дату в соответствии с установленным форматом
 for I := 1 to Length(DTSettingFrom.DT_order) do
 begin
    case Chr(Ord(DTSettingFrom.DT_order[i]) and $DF) of
    'D': begin
      tmp_str := inttostr(DTSettingFrom.w_Day);
      if length(tmp_str)=0 then continue;
      if (DTSettingFrom.D_count = 2) and
      (length(tmp_str)<2)
       then
         tmp_str := '0'+tmp_str;
      if (DTSettingFrom.DateSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.DateSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 'D'
    'M': begin
      tmp_str := inttostr(DTSettingFrom.w_Month);
      if length(tmp_str)=0 then continue;
      if (DTSettingFrom.M_count = 2) and
      (length(tmp_str)<2)
       then
         tmp_str := '0'+tmp_str;
      if (DTSettingFrom.DateSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.DateSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 'M'
    'Y': begin
      tmp_str := inttostr(DTSettingFrom.w_Year);
      if length(tmp_str)=0 then continue;
      if (DTSettingFrom.DateSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.DateSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 'Y'
    'H': begin
      tmp_str := inttostr(DTSettingFrom.w_Hour);
      if length(tmp_str)=0 then continue;

      if (DTSettingFrom.H_count = 2) and
      (length(tmp_str)<2)
       then
         tmp_str := '0'+tmp_str;

      if (DTSettingFrom.Date_TimeSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.Date_TimeSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 'H'
    'N': begin
      tmp_str := inttostr(DTSettingFrom.w_Minute);
      if length(tmp_str)=0 then continue;

      if (DTSettingFrom.N_count = 2) and
      (length(tmp_str)<2)
       then
         tmp_str := '0'+tmp_str;

      if (DTSettingFrom.TimeSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.TimeSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 'N'
    'S': begin
      tmp_str := inttostr(DTSettingFrom.w_Sec);
      if length(tmp_str)=0 then continue;

      if (DTSettingFrom.S_count = 2) and
      (length(tmp_str)<2)
       then
         tmp_str := '0'+tmp_str;

      if (DTSettingFrom.TimeSeparator <> #0) and (i>1)
       then
       ResStr := ResStr + DTSettingFrom.TimeSeparator + tmp_str
       else
       ResStr := ResStr + tmp_str;
    end; // 's'
    'Z': begin
       tmp_str := inttostr(DTSettingFrom.w_Msec);
       if length(tmp_str)=0 then continue;

       // добавляем нули до DTSettingFrom.Z_count
       // можно  функцией из AceUtils (быстрее)
       // G_PadLeft(const S: string; Length: Integer; PaddingChar: Char): string;
       for j := 1 to DTSettingFrom.Z_count - length(tmp_str) do
       pad_str := pad_str + '0';

       //tmp_str := pad_str + tmp_str; // дополняет слева, как принято
       tmp_str := tmp_str + pad_str; // или справа для этой задачи

       ResStr := ResStr + '.' + tmp_str;
    end; // 'z'
    end; // case
 end; // for
   Result := ResStr;
end;

// копируем данные из одной записи в другую
// DTSettingFrom - откуда копируем данные
// DTSettingTo - куда копируем
// !!! Формат при этом остается неизменным. Копируются только данные
procedure FMDDate_DTFCopy(const DTSettingFrom: TFMTDateTimeString;
  var DTSettingTo: TFMTDateTimeString);
begin
  ClearFMTData(DTSettingTo); // чистим данные 
  with DTSettingFrom do
  begin
    // числовое представление
    DTSettingTo.w_Year := w_Year;
    DTSettingTo.w_Month := w_Month;
    DTSettingTo.w_Day := w_Day;
    DTSettingTo.w_Hour := w_Hour;
    DTSettingTo.w_Minute := w_Minute;
    DTSettingTo.w_Sec := w_Sec;
    DTSettingTo.w_Msec :=  w_Msec;
    // строчное представление (строго говоря оно лишнее в этом модуле и его можно безболезненно убрать )
    DTSettingTo.ss_Year := ss_Year;
    DTSettingTo.ss_Month := ss_Month;
    DTSettingTo.ss_Day := ss_Day;
    DTSettingTo.ss_Hour := ss_Hour;
    DTSettingTo.ss_Minute := ss_Minute;
    DTSettingTo.ss_Second := ss_Second;
    DTSettingTo.ss_Msec :=  ss_Msec;
  end;

end;
end.


Дабы не засорять блог, куски кода с дополнительными функциями я упускаю, по большей части они опираются на стандартные функции (sysutils, dateutils).

Небольшой список функций для работы с датой-временем из стандартных библиотек
получить данные о текущем формате из ОС
procedure GetLocaleFormatSettings(LCID: Integer; var FormatSettings: TFormatSettings);
SysUtils
function FormatDateTime(const Format: string; DateTime: TDateTime): string; overload;
function FormatDateTime(const Format: string; DateTime: TDateTime; const FormatSettings: TFormatSettings): string; overload;
Пример. S := SysUtils.FormatDateTime( '"The meeting is on " dddd, mmmm d, yyyy, " at " hh:mm AM/PM', Now + 0.125);
преобразование строки в дату в соответствии с заданным форматом (TFormatSettings)
function StrToDate(const S: string; const FormatSettings: TFormatSettings): TDateTime; overload;

function EncodeDate(Year: Word; Month: Word; Day: Word): TDateTime;
Пример.
var MyDate: TDateTime;
begin
MyDate := SysUtils.EncodeDate('2010', '12', '01';
Label1.Caption := DateToStr(MyDate);
end;
и его аналоги TryEncodeDate, EncodeTime 
Обратные функции
procedure DecodeDate(const DateTime: TDateTime; var Year: Word; var Month: Word; var Day: Word);
и его аналоги DecodeDateFully, DecodeTime


Кроме того, есть сборник AdRock для работы с датой-временем (Date-Time Suit) adsuite.zip