Задача. Получить дату в виде строки (из 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
Необходимо учесть, что разделители могут отсутствовать вовсе, и не совпадать с системными.
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
