Now речь пойдет об одной функции

Август 2, 2009 — Шарахов А.П.

Некоторое время назад на стене рядом с моим столом висело и вдохновляло меня на новые трудовые свершения нетленное творение неизвестного автора. Этот поистине неиссякаемый источник вечной мудрости при каждой встрече с ним позволял мне испить свежей мысли, приоткрывал новые законы чисел и давал возможность прикоснуться к тайнам мироздания. Но вряд ли кто-либо из смертных способен в полной мере постичь великую мудрость, которой наполнен сей источник.

function IncDay(const DateTime: TDateTime;  NumberOfDays: Integer): TDateTime;
//Функция предназначена для изменения даты (DateTime) путем добавления  количества дней (NumberOfDays). 
//Значение NumberOfDays может быть отрицательным.
var
  Y, M, D, CountDays: Word;
  N: Integer;
  Sign, NoBreak: Boolean;
begin
  Sign := NumberOfDays >= 0;
  DecodeDate(DateTime, Y, M, D);
  N := NumberOfDays;
  NoBreak := True;
  if Sign then   //Прибавить
  begin
    while(NoBreak) do
    begin //Количество дней в месяце 
      CountDays := MonthDays[IsLeapYear(Y), M];
      if (N + D) <= CountDays then //Если в пределах данного месяца
      begin
        Inc(D, N);
        NoBreak := False;
      end
      else
      begin
        if M < 12 then
          Inc(M, 1)
        else
        begin
          M := 1;
          Inc(Y, 1);
        end;
        N := N - (CountDays - D);
        D := 0;
      end;
    end;
  end
  else  //Отнять
  begin
    N := -N;
    while(NoBreak) do
    begin
      if D > N then  //Если в пределах данного месяца
      begin
        Dec(D, N);
        NoBreak := False;
      end
      else
      begin
        if M > 1 then
          Dec(M, 1)
        else
        begin
          M := 12;
          Dec(Y, 1);
        end;
        //Количество дней в месяце
        CountDays := MonthDays[IsLeapYear(Y), M];
        N := N - D;
        D := CountDays;
      end;
    end;   
  end;
  Result := EncodeDate(Y, M, D);
  //Установить время из старой даты
  ReplaceTime(Result, DateTime);
end;

И вот недавно, в очередной раз находясь под впечатлением от Источника, я скользил погрустневшим взором по строкам продукта, созданного в далеких землях. Но что это – я не поверил своим глазам – не может быть, чтобы слава неизвестного автора докатилась так далеко. Да, это было правдой, знакомые струи угадывались коде заморской функции. Как ни старался, я не смог устоять перед желанием хоть на миг приобщиться к великому:

function ShaNow: TDateTime;
const
  MsPerDay     = 1440 * 60 * 1000;              //Day in milliseconds
  DateTimeBase = 693594;                        //Days between 01/01/0001 and 12/31/1899
  FileTimeBase = 584389;                        //Days between 01/01/0001 and 01/01/1601
  DeltaInDays  = DateTimeBase - FileTimeBase;   //Days between 01/01/1601 and 12/31/1899
const
  DeltaInMs    = int64(DeltaInDays) * MsPerDay; //Milliseconds between 01/01/1601 and 12/31/1899
  DeltaInMsLo  = DeltaInMs and $FFFFFFFF;
  DeltaInMsHi  = DeltaInMs shr 32;
const
  OneMs: extended = 1 / MsPerDay;                 //Millisecond in days
const
  //Magic constant to replace 64-bit integer division by 625 with multiplication
  Magic625Inverted   = $346DC5D63886594B;
  Magic625InvertedLo = Magic625Inverted and $FFFFFFFF;
  Magic625InvertedHi = Magic625Inverted shr 32;
asm
  add esp, -20
  mov [esp+16], ebx
  lea ebx, [esp+8]
  push ebx
  call GetSystemTimeAsFileTime
  push esp
  push ebx
  call FileTimeToLocalFileTime
 
  //Convert TFileTime to milliseconds: divide pint64(esp)^ by 10000, result in edx:eax
  mov eax, Magic625InvertedLo
  xor ebx, ebx
  mul [esp]
  mov eax, Magic625InvertedLo
  mov ecx, edx
  mul [esp+4]
  add ecx, eax
  mov eax, Magic625InvertedHi
  adc ebx, edx
  mul [esp]
  add ecx, eax
  mov eax, Magic625InvertedHi
  adc ebx, edx
  mov ecx, 0
  adc ecx, ecx
  mul [esp+4]
  add eax, ebx
  adc edx, ecx
  shrd eax, edx, 11
  shr edx, 11
 
  sub eax, DeltaInMsLo
  sbb edx, DeltaInMsHi
  mov [esp], eax
  mov [esp+4], edx
  fild qword ptr [esp]
  mov ebx, [esp+16]
  fld OneMs
  add esp, 20
  fmulp
  end;

Конечно, мне не удалось добиться даже малой части той лаконичности и самодостаточности кода, которая свойственна творениям великих мастеров. Но я буду пытаться. Вот только дом покрашу в цвет черешни и продолжу.

P.S. Времена выполнения функций Now() и ShaNow() отличаются в 10 раз на E6850.

на главную

Comments (4)

ShaNow

Всегда использовал эту более быструю функцию , но обнаружил что на проектах RAD Delphi 10.1 Berlin компилится без проблем, но программа при запуске вызывает AV Kernel.dll

ShaNow()

Спасибо. Функция действительно пригодилась и я ее использую в своих проектах. Особенно хороша когда например нужно вычислять разницу между событиями. Например по скорости ввода информации можно решать вводится информация со сканера штрих-кода или вручную. Now() в этом случае довольно тормозит программу на слабеньких клиентских компах.

Та ну Вас!!! Где смайлики?

Та ну Вас!!! Где смайлики?
Я думал Вы это серьёзно пишете, столько времени потратил на то, что бы разобрать, что это какой-то бред! :-( Я не программист, поэтому это действо для меня оказалось трудозатратным :-(

Ничто не проходит бесследно

Польза есть, просто она прячется. Как сказал классик,
"бросая в воду камни, смотри на круги, ими образуемые,
иначе такое бросание будет пустою забавою".