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:

const

SecPerDay = 86400;

SecPerHour = 3600;

SecPerMinute = 60;

function SecondToTime(const Seconds: Cardinal): Double;

var

ms, ss, mm, hh, dd: Cardinal;

begin

dd := Seconds div SecPerDay;

hh := (Seconds mod SecPerDay) div SecPerHour;

mm := ((Seconds mod SecPerDay) mod SecPerHour) div SecPerMinute;

ss := ((Seconds mod SecPerDay) mod SecPerHour) mod SecPerMinute;

ms := 0;

Result := dd + EncodeTime(hh, mm, ss, ms);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

label1.Caption := DateTimeToStr(Date + SecondToTime(86543));

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:

{ **** UBPFD *********** by delphibase.endimus ****

>> Преобразование даты-времени в строковый вид и обратно (yyyymmddhhnnss)

Иногда становится нужно хранить дату и время в виде yyyymmddhhnnss.

Так, по некоторым причинам, с ними порой легче общаться и сортировать.

Зависимости: Windows, StdCtrls, SysUtils

Автор: mfender, mfenderfromru.com, Майкоп

Copyright: mfender

Дата: 10 августа 2003 г.

***************************************************** }

function mfStringToDateTime(const mfDTStr: string): TDateTime;

//Возвращает значение TDateTime из входящей строки mfDTStr

//в формате YYYYMMDDHHMMSS

var

Safe: string;

begin

Safe := ShortDateFormat; //сохраняем формат даты

ShortDateFormat := 'dd.mm.yyyy hh:nn:ss'; //придаем произвольный вид

//формату даты-времени

mfStringToDateTime := StrToDateTime(Copy(mfDTStr, 7, 2) + '.' +

Copy(mfDTStr, 5, 2) + '.' +

Copy(mfDTStr, 1, 4) + ' ' +

Copy(mfDTStr, 9, 2) + ':' +

Copy(mfDTStr, 11, 2) + ':' +

Copy(mfDTStr, 13, 2));

//Преобразуем, собственно, части строки в соответствующие

//детали даты и времени

ShortDateFormat := Safe; //возвращаем дате первоначальный вид

end;

function mfDateTimeToString(const Date: TDateTime): string;

//Возвращает строку в формате YYYYMMDDHHNNSS из входящей DateTime

begin

mfDateTimeToString := FormatDateTime('yyyymmddhhnnss', Date); //No comments

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:

{ **** UBPFD *********** by delphibase.endimus****

>> Преобразование даты (месяц прописью)

Преобразование даты. Например: 23.02.02 преобразуется в 23 февраля 2002 года.

Зависимости: DecodeDate

Автор: mukha, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Волгоград

Copyright: mukha

Дата: 17 ноября 2002 г.

***************************************************** }

function Monthstr(S: string): string;

const

Mes: array[1..12] ofstring = ('января', 'февраля', 'марта', 'апреля',

'мая', 'июня', 'июля', 'августа', 'сентября', 'октября', 'ноября',

'декабря');

var

Year, Month, Day: Word;

begin

try

StrToDate(S); // пр-ка правильности ввода даты

DecodeDate(StrToDate(S), Year, Month, Day);

Result := IntToStr(day);

Result := Result + ' ' + Mes[Month];

Result := result + ' ' + IntToStr(Year) + ' года';

except

raise

Exception.Create('"' + s + '"' + ' - такой даты нет!');

end;

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;

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Преобразование количества секунд в формат TTIME (ЧЧ:ММ:СС).

Преобразование количества секунд в формат TTIME (ЧЧ:ММ:СС).

На выходе функции, получаем TTIME

Зависимости: system, sysutils

Автор: VID, vidsnapmail.ru, ICQ:132234868, Махачкала

Copyright: VID

Дата: 14 июня 2002 г.

***************************************************** }

function SecToTime(Sec: Integer): TTime;

var

H, M, S: INTEGER;

HS, MS, SS: string;

begin

S := Sec;

M := Round(INT(S / 60));

S := S - M * 60; //Seconds

H := Round(INT(M / 60)); //Hours

M := M - H * 60; //Minutes

if H < 10then

HS := '0' + Inttostr(H)

else

HS := inttostr(H);

if M < 10then

MS := '0' + Inttostr(M)

else

MS := inttostr(M);

if S < 10then

SS := '0' + inttostr(S)

else

SS := inttostr(S);

RESULT := StrToTime(HS + ':' + MS + ':' + SS);

end;

Code:

{ **** UBPFD *********** by delphibase.endimus ****

>> Функция преобразует текстовую строку, задающую название месяца, в номер месяца

функция преобразует текстовую строку,задающую название месяца, в номер месяца

Зависимости: ???

Автор: Сергей, nfkazakinbox.ru, Краснодар

Copyright: VIP BANK

Дата: 11 сентября 2002 г.

***************************************************** }

function NumMonth(SMonth: string): word;

var

i: byte;

begin

Result := 0;

for i := 1to12do

if AnsiUpperCase(SMonth) = Month[i] then

Result := i

end;

Code:

Function GetMonthNumber(Month: String): Integer;

Begin

For Result := 1to12do

If Month = LongMonthNames[Result] Then

Exit;

Result := 0;

End;

Code:

function RetDate(inDate: TDateTime; inTip: integer): integer;

var

xYear, xMonth, xDay: word;

begin

Result := 0;

DecodeDate(inDate, xYear, xMonth, xDay);

case inTip of

1: Result := xYear; // год

2: Result := xMonth; // месяц

3: Result := xDay; // день

4: if xMonth < 4then

Result := 1

else// квартал

if xMonth < 7then

Result := 2

else

if xMonth < 10then

Result := 3

else

Result := 4;

end;

end;