Работа с датами и временем

Code:

function DateTimeToRfcTime(

dt: TDateTime;

iDiff: integer;

blnGMT: boolean = false): string;

{*

Explanation:

iDiff is the local offset to GMT in minutes

if blnGMT then Result is UNC time else local time

e.g. local time zone: ET = GMT - 5hr = -300 minutes

dt is TDateTime of 3 Jan 2001 5:45am

blnGMT = true -> Result = 'Wed, 03 Jan 2001 05:45:00 GMT'

blnGMT = false -> Result = 'Wed, 03 Jan 2001 05:45:00 -0500'

*}

const

Weekday: array[1..7] ofstring =

('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');

Month: array[1..12] ofstring = (

'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',

'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

var

iDummy: Word;

iYear: Word;

iMonth: Word;

iDay: Word;

iHour: Word;

iMinute: Word;

iSecond: Word;

strZone: string;

begin

if blnGMT then

begin

dt := dt - iDiff / 1440;

strZone := 'GMT';

end

else

begin

iDiff := (iDiff div60) * 100 + (iDiff mod60);

if iDiff < 0then

strZone := Format('-%.4d', [-iDiff])

else

strZone := Format('+%.4d', [iDiff]);

end;

DecodeDate(dt, iYear, iMonth, iDay);

DecodeTime(dt, iHour, iMinute, iSecond, iDummy);

Result := Format('%s, %.2d %s %4d %.2d:%.2d:%.2d %s', [

Weekday[DayOfWeek(dt)], iDay, Month[iMonth], iYear,

iHour, iMinute, iSecond, strZone]);

end;

function RfcTimeToDateTime(

strTime: string;

blnGMT: boolean = true): TDateTime;

{*

Explanation:

if blnGMT then Result is UNC time else local time

e.g. local time zone: ET = GMT - 5hr = -0500

strTime = 'Wed, 03 Jan 2001 05:45:00 -0500'

blnGMT = true -> FormatDateTime('...', Result) = '03.01.2001 10:45:00'

blnGMT = false -> FormatDateTime('...', Result) = '03.01.2001 05:45:00'

*}

const

wd = 'sun#mon#tue#wed#thu#fri#sat';

month = 'janfebmaraprmayjunjulaugsepoctnovdec';

var

s: string;

dd: Word;

mm: Word;

yy: Word;

hh: Word;

nn: Word;

ss: Word;

begin

s := LowerCase(Copy(strTime, 1, 3));

if Pos(s, wd) > 0then

Delete(strTime, 1, Pos(' ', strTime));

s := Trim(Copy(strTime, 1, Pos(' ', strTime)));

Delete(strTime, 1, Length(s) + 1);

dd := StrToIntDef(s, 0);

s := LowerCase(Copy(strTime, 1, 3));

Delete(strTime, 1, 4);

mm := (Pos(s, month) div3) + 1;

s := Copy(strTime, 1, 4);

Delete(strTime, 1, 5);

yy := StrToIntDef(s, 0);

Result := EncodeDate(yy, mm, dd);

s := strTime[1] + strTime[2];

hh := StrToIntDef(strTime[1] + strTime[2], 0);

nn := StrToIntDef(strTime[4] + strTime[5], 0);

ss := StrToIntDef(strTime[7] + strTime[8], 0);

Delete(strTime, 1, 9);

Result := Result + EncodeTime(hh, nn, ss, 0);

if (CompareText(strTime, 'gmt') <> 0) and blnGMT then

begin

hh := StrToIntDef(strTime[2] + strTime[3], 0);

nn := StrToIntDef(strTime[4] + strTime[5], 0);

if strTime[1] = '+'then

Result := Result - EncodeTime(hh, nn, 0, 0)

else

Result := Result + EncodeTime(hh, nn, 0, 0);

end;

end;

Code:

function RFC1123ToDateTime(Date: string): TDateTime;

var

day, month, year: Integer;

strMonth: string;

Hour, Minute, Second: Integer;

begin

try

day := StrToInt(Copy(Date, 6, 2));

strMonth := Copy(Date, 9, 3);

if strMonth = 'Jan'then month := 1

elseif strMonth = 'Feb'then month := 2

elseif strMonth = 'Mar'then month := 3

elseif strMonth = 'Apr'then month := 4

elseif strMonth = 'May'then month := 5

elseif strMonth = 'Jun'then month := 6

elseif strMonth = 'Jul'then month := 7

elseif strMonth = 'Aug'then month := 8

elseif strMonth = 'Sep'then month := 9

elseif strMonth = 'Oct'then month := 10

elseif strMonth = 'Nov'then month := 11

elseif strMonth = 'Dec'then month := 12;

year := StrToInt(Copy(Date, 13, 4));

hour := StrToInt(Copy(Date, 18, 2));

minute := StrToInt(Copy(Date, 21, 2));

second := StrToInt(Copy(Date, 24, 2));

Result := 0;

Result := EncodeTime(hour, minute, second, 0);

Result := Result + EncodeDate(year, month, day);

except

Result := now;

end;

end;

function DateTimeToRFC1123(aDate: TDateTime): string;

const

StrWeekDay: string = 'MonTueWedThuFriSatSun';

StrMonth: string = 'JanFebMarAprMayJunJulAugSepOctNovDec';

var

Year, Month, Day: Word;

Hour, Min, Sec, MSec: Word;

DayOfWeek: Word;

begin

DecodeDate(aDate, Year, Month, Day);

DecodeTime(aDate, Hour, Min, Sec, MSec);

DayOfWeek := ((Trunc(aDate) - 2) mod7);

Result := Copy(StrWeekDay, 1 + DayOfWeek * 3, 3) + ', ' +

Format('%2.2d %s %4.4d %2.2d:%2.2d:%2.2d',

[Day, Copy(StrMonth, 1 + 3 * (Month - 1), 3),

Year, Hour, Min, Sec]);

end;

Code:

{

Sometimes you want to communicate with mySQL or other databases using

the unix timestamp. To solve this difference you may want to convert your

TDateTime to the unix timestamp format and vice versa.

}

unit unix_utils;

interface

implementation

const

// Sets UnixStartDate to TDateTime of 01/01/1970

UnixStartDate: TDateTime = 25569.0;

function DateTimeToUnix(ConvDate: TDateTime): Longint;

begin

//example: DateTimeToUnix(now);

Result := Round((ConvDate - UnixStartDate) * 86400);

end;

function UnixToDateTime(USec: Longint): TDateTime;

begin

//Example: UnixToDateTime(1003187418);

Result := (Usec / 86400) + UnixStartDate;

end;

end.

Code:

Function StringToDate(Temp:String):TDateTime;

{Drkb v.3(2007): www.drkb, 

®Vit (Vitaly Nevzorov) - nevzorov@yahoo}

type TDateItem=(diYear, diMonth, diDay, diUnknown);

TCharId=(ciAlpha, ciNumber, ciSpace);

//языковые настройки. Для включения нового языка добавляем раскладку сюда, дополняем тип alpha и меняем

//единственную строку где используется эта константа

const

eng_monthes:array[1..12] ofstring=('jan', 'feb', 'mar', 'apr', 'may', 'jun', 'jul', 'aug', 'sep', 'oct', 'nov', 'dec');

rus_monthes:array[1..12] ofstring=('янв', 'фев', 'мар', 'апр', 'ма', 'июн', 'июл', 'авг', 'сен', 'окт', 'ноя', 'дес');

alpha:setof char=['a'..'z','а'..'я'];

//временные переменные

var month, day, year:string;

temp1:string;

i, j:integer;

ci1, ci2:TCharId;

Function GetWord(var temp:string):string;

begin

//возвращаем следующее слово из строки и вырезаем это слово из исходной строки

if pos(' ', temp)>0then

begin//берём слово до пробела

result:=trim(copy(temp, 1, pos(' ', temp)));

temp:=copy(temp, pos(' ', temp)+1, length(temp));

end

else//это последнее слово в строке

begin

result:=trim(temp);

temp:='';

end;

end;

Function GetDateItemType(temp:string):TDateItem;

var i, j:integer;

begin

//распознаём тип слова

i:=StrToIntDef(temp,0); //попытка преобразовать слово в цифру

Case i of

0: Result:=diMonth; //не число, значит или месяц или мусор

1..31:Result:=diDay;//числа от 1 до 31 считаем днём

else Result:=diYear;//любые другие числа считаем годами

End;

end;

Function GetCharId(ch:char):TCharId;

begin

//узнаём тип символа, нужно для распознавания "склееных" дней или лет с месяцем

Case ch of

' ':Result:=ciSpace;

'0'..'9':Result:=ciNumber;

else Result:=ciAlpha;

End;

end;

begin

temp:=trim(ansilowercase(temp));

month:='';

day:='';

year:='';

//замена любого мусора на пробелы

For i:=1to length(temp) do

ifnot (temp[i] in alpha+['0'..'9']) then temp[i]:=' ';

//удаление лишних пробелов

while pos(' ', temp)>0do

Temp:=StringReplace(temp, ' ',' ',[rfReplaceAll]);

//вставка пробелов если месяц слеплен с днём или годом

ci1:=GetCharId(temp[1]);

i:=1;

Repeat

inc(i);

ci2:=GetCharId(temp[i]);

if ((ci1=ciAlpha) and (ci2=ciNumber)) or ((ci1=ciNumber) and (ci2=ciAlpha)) then

insert(' ', temp, i);

ci1:=ci2;

Until i>=length(temp);

//собственно парсинг

while temp>''do

begin

temp1:=GetWord(temp);

Case GetDateItemType(temp1) of

diMonth: if month=''then//только если месяц ещё не определён, уменьшает вероятность ошибочного результата

for i:=12downto1do// обязателен отсчёт в обратную сторону чтоб не путать май и март

if (pos(eng_monthes[i],temp1)=1) or (pos(rus_monthes[i],temp1)=1) then//сюда добавляем ещё язык если надо

month:=inttostr(i);

diDay: Day:=temp1;

diYear: Year:=temp1;

End;

end;

//проверка - все ли элементы определены

if (month='') or (Day='') or (Year='') thenraise Exception.Create('Could not be converted!');

//поправка на двузначный год

if length(year)<3then year:='19'+year;

//кодирование результата

Result:=EncodeDate(Strtoint(Year), Strtoint(month), Strtoint(Day));

end;

Code:

var

D1, D2, D3 : TDateTime;

begin

D1 := VarToDateTime('December 6, 1969');

D2 := VarToDateTime('6-Apr-1998');

D3 := VarToDateTime('1998-Apr-6');

ShowMessage(DateToStr(D1)+' '+DateToStr(D2)+' '+

DateToStr(D3));

end;

Code:

DateTimeStrEval(const DateTimeFormat : string; const DateTimeStr : string) : TDateTime;

Code:

MyDate := DateTimeStrEval('dddd dd mmmm yyyy hh:nnampm (ss xxxx)', DT1);

MyDate := DateTimeStrEval('yyyymmdd', DT2);

MyDate := DateTimeStrEval('dd-mmm-yy', DT3);

MyDate := DateTimeStrEval('hh xxxx nn xxxxxx ss xxxxxx zzz xxxxx', DT4);

Code:

uses SysUtils, DateUtils

// =============================================================================

// Evaluate a date time string into a TDateTime obeying the

// rules of the specified DateTimeFormat string

// eg. DateTimeStrEval('dd-MMM-yyyy hh:nn','23-May-2002 12:34)

//

// Delphi 6 Specific in DateUtils can be translated to ....

//

// YearOf()

//

// function YearOf(const AValue: TDateTime): Word;

// var LMonth, LDay : word;

// begin

// DecodeDate(AValue,Result,LMonth,LDay);

// end;

//

// TryEncodeDateTime()

//

// function TryEncodeDateTime(const AYear,AMonth,ADay,AHour,AMinute,ASecond,

// AMilliSecond : word;

// out AValue : TDateTime): Boolean;

// var LTime : TDateTime;

// begin

// Result := TryEncodeDate(AYear, AMonth, ADay, AValue);

// if Result then begin

// Result := TryEncodeTime(AHour, AMinute, ASecond, AMilliSecond, LTime);

// if Result then

// AValue := AValue + LTime;

// end;

// end;

//

// (TryEncodeDate() and TryEncodeTime() is the same as EncodeDate() and

// EncodeTime() with error checking and boolean return value)

//

// =============================================================================

function DateTimeStrEval(const DateTimeFormat: string;

const DateTimeStr: string): TDateTime;

var

i, ii, iii: integer;

Retvar: TDateTime;

Tmp,

Fmt, Data, Mask, Spec: string;

Year, Month, Day, Hour,

Minute, Second, MSec: word;

AmPm: integer;

begin

Year := 1;

Month := 1;

Day := 1;

Hour := 0;

Minute := 0;

Second := 0;

MSec := 0;

Fmt := UpperCase(DateTimeFormat);

Data := UpperCase(DateTimeStr);

i := 1;

Mask := '';

AmPm := 0;

while i < length(Fmt) do

begin

if Fmt[i] in ['A', 'P', 'D', 'M', 'Y', 'H', 'N', 'S', 'Z'] then

begin

// Start of a date specifier

Mask := Fmt[i];

ii := i + 1;

// Keep going till not valid specifier

while true do

begin

if ii > length(Fmt) then

Break; // End of specifier string

Spec := Mask + Fmt[ii];

if (Spec = 'DD') or (Spec = 'DDD') or (Spec = 'DDDD') or

(Spec = 'MM') or (Spec = 'MMM') or (Spec = 'MMMM') or

(Spec = 'YY') or (Spec = 'YYY') or (Spec = 'YYYY') or

(Spec = 'HH') or (Spec = 'NN') or (Spec = 'SS') or

(Spec = 'ZZ') or (Spec = 'ZZZ') or

(Spec = 'AP') or (Spec = 'AM') or (Spec = 'AMP') or

(Spec = 'AMPM') then

begin

Mask := Spec;

inc(ii);

end

else

begin

// End of or Invalid specifier

Break;

end;

end;

// Got a valid specifier ? - evaluate it from data string

if (Mask <> '') and (length(Data) > 0) then

begin

// Day 1..31

if (Mask = 'DD') then

begin

Day := StrToIntDef(trim(copy(Data, 1, 2)), 0);

delete(Data, 1, 2);

end;

// Day Sun..Sat (Just remove from data string)

if Mask = 'DDD'then

delete(Data, 1, 3);

// Day Sunday..Saturday (Just remove from data string LEN)

if Mask = 'DDDD'then

begin

Tmp := copy(Data, 1, 3);

for iii := 1to7do

begin

if Tmp = Uppercase(copy(LongDayNames[iii], 1, 3)) then

begin

delete(Data, 1, length(LongDayNames[iii]));

Break;

end;

end;

end;

// Month 1..12

if (Mask = 'MM') then

begin

Month := StrToIntDef(trim(copy(Data, 1, 2)), 0);

delete(Data, 1, 2);

end;

// Month Jan..Dec

if Mask = 'MMM'then

begin

Tmp := copy(Data, 1, 3);

for iii := 1to12do

begin

if Tmp = Uppercase(copy(LongMonthNames[iii], 1, 3)) then

begin

Month := iii;

delete(Data, 1, 3);

Break;

end;

end;

end;

// Month January..December

if Mask = 'MMMM'then

begin

Tmp := copy(Data, 1, 3);

for iii := 1to12do

begin

if Tmp = Uppercase(copy(LongMonthNames[iii], 1, 3)) then

begin

Month := iii;

delete(Data, 1, length(LongMonthNames[iii]));

Break;

end;

end;

end;

// Year 2 Digit

if Mask = 'YY'then

begin

Year := StrToIntDef(copy(Data, 1, 2), 0);

delete(Data, 1, 2);

if Year < TwoDigitYearCenturyWindow then

Year := (YearOf(Date) div100) * 100 + Year

else

Year := (YearOf(Date) div100 - 1) * 100 + Year;

end;

// Year 4 Digit

if Mask = 'YYYY'then

begin

Year := StrToIntDef(copy(Data, 1, 4), 0);

delete(Data, 1, 4);

end;

// Hours

if Mask = 'HH'then

begin

Hour := StrToIntDef(trim(copy(Data, 1, 2)), 0);

delete(Data, 1, 2);

end;

// Minutes

if Mask = 'NN'then

begin

Minute := StrToIntDef(trim(copy(Data, 1, 2)), 0);

delete(Data, 1, 2);

end;

// Seconds

if Mask = 'SS'then

begin

Second := StrToIntDef(trim(copy(Data, 1, 2)), 0);

delete(Data, 1, 2);

end;

// Milliseconds

if (Mask = 'ZZ') or (Mask = 'ZZZ') then

begin

MSec := StrToIntDef(trim(copy(Data, 1, 3)), 0);

delete(Data, 1, 3);

end;

// AmPm A or P flag

if (Mask = 'AP') then

begin

if Data[1] = 'A'then

AmPm := -1

else

AmPm := 1;

delete(Data, 1, 1);

end;

// AmPm AM or PM flag

if (Mask = 'AM') or (Mask = 'AMP') or (Mask = 'AMPM') then

begin

if copy(Data, 1, 2) = 'AM'then

AmPm := -1

else

AmPm := 1;

delete(Data, 1, 2);

end;

Mask := '';

i := ii;

end;

end

else

begin

// Remove delimiter from data string

if length(Data) > 1then

delete(Data, 1, 1);

inc(i);

end;

end;

if AmPm = 1then

Hour := Hour + 12;

ifnot TryEncodeDateTime(Year, Month, Day, Hour, Minute, Second, MSec, Retvar) then

Retvar := 0.0;

Result := Retvar;

end;

Code:

Consts.pas

//SMaskEditErr = 'Invalid input value. Use escape key to abandon changes';

SMaskEditErr = 'Введено некорректное значение. Нажмите Esc для отмены';

SysConsts.pas

//SInvalidDateTime = '''%s'' is not a valid date and time';

SInvalidDateTime = '''%s'' - некорректное значение даты и времени';

Mask.pas

function TCustomMaskEdit.RemoveEditFormat(const Value: string): string;

…

{шестая строка снизу}

{так было}

// if Result[I] = FMaskBlank then

// Result[I] := ' ';

{так стало}

if Result[I] = FMaskBlank then

if FMaskBlank = '0'then

Result[I] := FMaskBlank

else

Result[I] := ' ';

…

function TCustomMaskEdit.Validate(const Value: string; var Pos: Integer):

Boolean;

…

{одинадцатая строка снизу}

{так было}

// if (Value [Offset] = FMaskBlank) or

// ((Value [Offset] = ' ') and (EditMask[MaskOffset] <> mMskAscii)) then

if (FMaskBlank <> '0') and

((Value[Offset] = FMaskBlank) or

((Value[Offset] = ' ') and (EditMask[MaskOffset] <> mMskAscii))) then

…

Code:

function GetDateTimeWOSec(DateTime: TDateTime): TDateTime;

begin

Result := StrToDateTime(FormatDateTime('dd.mm.yy hh:nn', DateTime));

end;