Советы по Delphi. Версия 1.0.6

 month:= strtoint(copy(date,5,2));
 day:= strtoint(copy(date,7,2));
 year:= strtoint(copy(date,1,4));
 if month > 2 then month:= month – 3
 else begin
 month:= month + 9;
 year:= year – 1;
 end;
 ta:= 146097 * (year div 100) div 4;
 tb:= 1461 * (year MOD 100) div 4;
 tc:= (153 * month + 2) div 5 + day + 1721119;
 result:= ta + tb + tc
end;

function mdy2date(month, day, year : integer): string;
var
 y, m, d : string;
begin
 y:= '000'+inttostr(year);
 y:= copy(y,length(y)-3,4);
 m:= '0'+inttostr(month);
 m:= copy(m,length(m)-1,2);
 d:= '0'+inttostr(day);
 d:= copy(d,length(d)-1,2);
 result:= y+m+d;
end;

function Julian2date(julian : longint): string;
{Получает значение и возвращает дату в формате YYYYMMDD}
var
 x,y,d,m : longint;
 month,day,year : integer;
begin
 x:= 4 * julian – 6884477;
 y:= (x div 146097) * 100;
 d:= (x MOD 146097) div 4;
 x:= 4 * d + 3;
 y:= (x div 1461) + y;
 d:= (x MOD 1461) div 4 + 1;
 x:= 5 * d – 3;
 m:= x div 153 + 1;
 d:= (x MOD 153) div 5 + 1;
 if m < 11 then month:= m + 2
 else month:= m – 10;
 day:= d;
 year:= y + m div 11;
 result:= mdy2date(month, day, year);
end;

function checkdate(date : string): boolean;
{Дата должна быть в формате YYYYMMDD.}
var
 julian: longint;
 test: string;
begin
 {Сначала преобразовываем строку в юлианский формат даты.
 Это позволит получить необходимое значение.}
 julian:= Date2julian(date);
 {Затем преобразовываем полученную величину в дату.
 Это всегда будет правильной датой. Для проверки делаем обратное преобразование.
 Результат проверки передаем как выходной параметр функции.}
 test:= Julian2date(julian);
 if date = test then result:= true
 else result:= false;
end;

function DayOfTheWeek(date : string): string;
{Получаем дату в формате YYYYMMDD и возвращаем день недели.}
var
 julian: longint;
begin
 julian:= (Date2julian(date)) MOD 7;
 case julian of
 0: result:= 'Понедельник';
 1: result := 'Вторник';
 2: result:= 'Среда';
 3: result:= 'Четверг';
 4: result:= 'Пятница';
 5: result:= 'Суббота';
 6: result:= 'Воскресенье';
 end;
end;

end.

Формат даты

У меня есть неотложная задача: в настоящее время я разрабатываю проект, где я должен проверять достоверность введенных дат с применением маски __/__/____, например 12/12/1997.

Некоторое время назад я делал простой шифратор/дешифратор дат, проверяющий достоверность даты. Код приведен ниже.

function CheckDateFormat(SDate: string): string;
var
 IDateChar: string;
 x,y: integer;
begin
 IDateChar:='.,\/';
 for y:=1 to length(IDateChar) do begin
 x:= pos(IDateChar[y],SDate);
 while x>0 do begin
 Delete(SDate,x,1);
 Insert('-',SDate,x);
 x:= pos(IDateChar[y],SDate);
 end;
 end;
 CheckDateFormat:= SDate;
end;

function DateEncode(SDate:string):longint;
var
 year, month, day: longint;
 wy, wm, wd: longint;
 Dummy: TDateTime;
 Check: integer;
begin
 DateEncode:= -1;
 SDate:= CheckDateFormat(SDate);
 Val(Copy(SDate,1,pos('-',SDate)-1),day,check);
 Delete(Sdate,1,pos('-',SDate));
 Val(Copy(SDate,1,pos('-',SDate)-1),month,check);
 Delete(SDate,1,pos('-',SDate));
 Val(SDate,year,check);
 wy:= year;
 wm:= month;
 wd:= day;
 try
 Dummy:= EncodeDate(wy,wm,wd);
 except
 year:= 0;
 month:= 0;
 day:= 0;