BCS Secure Corporate Repositories

There are those times when secured access to corporate repositories is required. Secured access of all corporate repositories can be accomplished by using an e mail address and password scenario for security.

There is no such thing as a duplicate e mail address. The uniqueness of the e mail address makes it the first likely candidate for securing corporate repositories. The password further challenges the user to supply the correct credential to gain access to the corporate repository.

The BCS Register New User component is a working prototype how the non-registered user can gain access to the corporate repository. Even though there are additional data elements in the repository this components focuses only on the e mail address and the password fields. Since the primary key is auto generated it should not be interfered with.

The working prototype and source code can be located by clicking here. The component documentation can be located by clicking here.

The remaining portion of this scenario is the BCS User Login component. The login component challenges the user to supply the correct e mail address and password combination before access to the information is granted.

This scenario allows the user to access only one record and that was the record that was created when the user registered for the first time.

The working prototype and source code for this component can be located by clicking here.  The component documentation can be located by clicking here.

These two components will secure corporate repositories at the record level.  The usual is the user can only access the information pertinent to themselves only.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

BCS Calculating Elapsed Time In Delphi

There are those time in Delphi when operations involving dates and times are required. The most reliable code for accomplishing this is OvcDate.

Having been a registered TurboPower user back in the day I had used this as well as other unit in the past.

{*********************************************************}
{*                     OVC.INC                           *}
{*********************************************************}
 
{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Orpheus                                    *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002    *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}
 
{Conditional defines that affect compilation}
 
{$Q-} {Overflow Checking}
{$R-} {Range-Checking}
{$S-} {Stack-Overflow Checking}
{$V-} {Var-String Checking}
{$T-} {No type-checked pointers}
{$X+} {Extended syntax}
{$P-} {No open string parameters}
{$B-} {Incomplete Boolean evaluation}
{$J+} {Writable constants}
{$H+} {Huge strings}
 
{General define indicating use under C++ Builder}
{$IFDEF VER93}
  {$DEFINE CBuilder}
{$ENDIF}
{$IFDEF VER110}
  {$DEFINE CBuilder}
  {$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125}
  {$DEFINE CBuilder}
  {$ObjExportAll On}
{$ENDIF}
{$IFDEF VER130}
  {$IFDEF BCB}
    {$DEFINE CBuilder}
    {$ObjExportAll On}
  {$ENDIF}
{$ENDIF}
{$IFDEF VER140}                                                       {!!.04}
  {$IFDEF BCB}                                                        {!!.04}
    {$DEFINE CBuilder}                                                {!!.04}
    {$ObjExportAll On}                                                {!!.04}
  {$ENDIF}                                                            {!!.04}
{$ENDIF}                                                              {!!.04}
 
{$IFNDEF VER80}       {Delphi 1.0}
 {$DEFINE VERSION2}   {Delphi 2.0 and BCB 1 or higher}
{$ENDIF}
 
{$IFDEF VERSION2}
 {$IFNDEF VER90}      {Delphi 2.0}
  {$IFNDEF VER93}     {BCB 1.0}
   {$DEFINE VERSION3} {Delphi 3.0 or BCB 3.0}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION3}
 {$IFNDEF VER100}     {Delphi 3}
  {$IFNDEF VER110}    {BCB 3}
   {$DEFINE VERSION4} {Delphi 4.0 or higher}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION4}
 {$IFNDEF VER120}     {Delphi 4}
  {$IFNDEF VER125}    {BCB 4}
   {$DEFINE VERSION5} {Delphi 5.0 or higher}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION5}
 {$IFNDEF VER130}     {Delphi 5}
  {$IFNDEF VER135}    {BCB 5}
   {$DEFINE VERSION6} {Delphi 6.0 or higher}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION6}
 {$IFNDEF VER140}     {Delphi 6}
  {$IFNDEF VER145}    {BCB 6}
   {$DEFINE VERSION7} {Delphi 7.0 or higher}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION2}
 {$IFNDEF VERSION3}
  {$DEFINE VERSION2ONLY}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF VERSION3}
 {$IFNDEF VERSION4}
  {$DEFINE VERSION3ONLY}
 {$ENDIF}
{$ENDIF}
 
{$IFDEF Win32}
  {$A+} {Word Align Data}
{$ELSE}
  {$A-} {Byte Align Data}
{$ENDIF}
 
{$IFDEF VERSION6}
  {$WARN SYMBOL_PLATFORM OFF}
  {$IFDEF VERSION7}
    {$B- Incomplete boolean evaluation}
    {$H+ Long string support}
    {$J+ Writeable typed constants}
    {$P- No open string parameters}
    {$T- No type-checked pointers}
    {$V- No var string checking}
    {$X+ Extended syntax}
    {$Z1 Enumerations are word sized}
    {$WARN UNIT_PLATFORM OFF}
    {$WARN UNSAFE_CODE OFF}
    {$WARN UNSAFE_TYPE OFF}
    {$WARN UNSAFE_CAST OFF}
    {$WARN UNIT_DEPRECATED OFF}
  {$ENDIF}
{$ENDIF}
{ This define turns off all platform warnings in Delphi 6.  Delphi 6 }
{ is cross-platform compatible with Kylix and all of Orpheus' Win32  }
{ only stuff causes the compiler to throw a truckload of platform    }
{ warnings when rebuilding packages.                                 }
 
{.$DEFINE ZeroDateAsNull}
{This define enables special handling for a zero date. If defined,   }
{assigning 0 to a date field is treated the same as assigning the    }
{constant "BadDate" (see manual) using the AsDateTime property.      }
{Otherwise, 0 is treated as a valid date. (32-bit only)              }

The following is the OvcDate unit.  This code is now open source but it originally shipped with Turbo Power’s Orpheus product.

{*********************************************************}
{*                   OVCDATE.PAS 4.06                    *}
{*********************************************************}
 
{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Orpheus                                    *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002    *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}
 
{$I OVC.INC}
 
{$IFDEF VERSION7}
  {$WARN UNSAFE_CODE OFF}
  {$WARN UNSAFE_TYPE OFF}
  {$WARN UNSAFE_CAST OFF}
{$ENDIF}
 
{For BCB 3.0 package support.}
{$IFDEF VER110}
  {$ObjExportAll On}
{$ENDIF}
 
 
{---Global compiler defines for Delphi 2.0---}
{$A+} {Word Align Data}
{$H+} {Huge string support}
{$Q-} {Overflow check}
{$R-} {Range check}
{$S-} {Stack check}
{$T-} {Typed @ check}
{$V-} {Var strings}
 
unit ovcdate; {formerly StDate}
  {-Date and time manipulation}
 
interface
 
uses
  Windows, SysUtils;
 
type
  TStDate = LongInt;
  PStDate = ^TStDate;
    {In STDATE, dates are stored in long integer format as the number of days
    since January 1, 1600}
 
  TDateArray = array[0..(MaxLongInt div SizeOf(TStDate))-1] of TStDate;
    {Type for StDate open array}
 
  TStDayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
    {An enumerated type used when representing a day of the week}
 
  TStBondDateType = (bdtActual, bdt30E360, bdt30360, bdt30360psa);
    {An enumerated type used for calculating bond date differences}
 
  TStTime = LongInt;
  PStTime = ^TStTime;
    {STDATE handles time in a manner similar to dates, representing a given
    time of day as the number of seconds since midnight}
 
  TStDateTimeRec =
    record
     {This record type simply combines the two basic date types defined by
      STDATE, Date and Time}
      D : TStDate;
      T : TStTime;
    end;
 
const
  MinYear = 1600;        {Minimum valid year for a date variable}
  MaxYear = 3999;        {Maximum valid year for a date variable}
  Mindate = $00000000;   {Minimum valid date for a date variable - 01/01/1600}
  Maxdate = $000D6025;   {Maximum valid date for a date variable - 12/31/3999}
  Date1900 = $0001AC05;  {This constant contains the Julian date for 01/01/1900}
  Date1980 = $00021E28;  {This constant contains the Julian date for 01/01/1980}
  Date2000 = $00023AB1;  {This constant contains the Julian date for 01/01/2000}
  {This value is used to represent an invalid date, such as 12/32/1992}
  BadDate = LongInt($FFFFFFFF);
 
  DeltaJD     = $00232DA8;   {Days between 1/1/-4173 and 1/1/1600}
 
  MinTime = 0;          {Minimum valid time for a time variable - 00:00:00 am}
  MaxTime = 86399;      {Maximum valid time for a time variable - 23:59:59 pm}
  {This value is used to represent an invalid time of day, such as 12:61:00}
  BadTime = LongInt($FFFFFFFF);
 
  SecondsInDay = 86400;      {Number of seconds in a day}
  SecondsInHour = 3600;      {Number of seconds in an hour}
  SecondsInMinute = 60;      {Number of seconds in a minute}
  HoursInDay = 24;           {Number of hours in a day}
  MinutesInHour = 60;        {Number of minutes in an hour}
  MinutesInDay = 1440;       {Number of minutes in a day}
 
var
  DefaultYear : Integer;     {default year--used by DateStringToDMY}
  DefaultMonth : ShortInt;   {default month}
 
  {-------julian date routines---------------}
 
function CurrentDate : TStDate;
  {-returns today's date as a Julian date}
 
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
  {-Verify that day, month, year is a valid date}
 
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
  {-Convert from day, month, year to a Julian date}
 
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
  {-Convert from a Julian date to day, month, year}
 
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
  {-Add (or subtract) the number of days, months, and years to a date}
 
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
  {-Add (or subtract) the specified number of months and years to a date}
 
procedure DateDiff(Date1, Date2 : TStDate;
                   var Days, Months, Years : Integer);
{-Return the difference in days, months, and years between two valid Julian
  dates}
 
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
  {-Return the difference in days between two valid Julian
  dates using a specific financial basis}
 
function WeekOfYear(Julian : TStDate) : Byte;
  {-Returns the week number of the year given the Julian Date}
 
function AstJulianDate(Julian : TStDate) : Double;
  {-Returns the Astronomical Julian Date from a TStDate}
 
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
  {-Returns a TStDate from an Astronomical Julian Date.
  Truncate TRUE   Converts to appropriate 0 hours then truncates
           FALSE  Converts to appropriate 0 hours, then rounds to
                  nearest;}
 
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
  {-Returns an Astronomical Julian Date for any year, even those outside
    MinYear..MaxYear}
 
function DayOfWeek(Julian : TStDate) : TStDayType;
  {-Return the day of the week for a Julian date}
 
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
  {-Return the day of the week for the day, month, year}
 
function IsLeapYear(Year : Integer) : Boolean;
  {-Return True if Year is a leap year}
 
function DaysInMonth(Month : Integer; Year, Epoch : Integer) : Integer;
  {-Return the number of days in the specified month of a given year}
 
function ResolveEpoch(Year, Epoch : Integer) : Integer;
  {-Convert 2 digit year to 4 digit year according to Epoch}
 
 
  {-------time routines---------------}
 
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
  {-Return True if Hours:Minutes:Seconds is a valid time}
 
procedure StTimeToHMS(T : TStTime;
                    var Hours, Minutes, Seconds : Byte);
  {-Convert a time variable to hours, minutes, seconds}
 
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
  {-Convert hours, minutes, seconds to a time variable}
 
function CurrentTime : TStTime;
  {-Return the current time in seconds since midnight}
 
procedure TimeDiff(Time1, Time2 : TStTime;
                   var Hours, Minutes, Seconds : Byte);
  {-Return the difference in hours, minutes, and seconds between two times}
 
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Add the specified hours, minutes, and seconds to a given time of day}
 
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Subtract the specified hours, minutes, and seconds from a given time of day}
 
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
  {-Given a time, round it to the nearest hour, or truncate minutes and
  seconds}
 
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
  {-Given a time, round it to the nearest minute, or truncate seconds}
 
  {-------- routines for DateTimeRec records ---------}
 
procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
                       var Days : LongInt; var Secs : LongInt);
  {-Return the difference in days and seconds between two points in time}
 
procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
                      Days : Integer; Secs : LongInt);
  {-Increment (or decrement) a date and time by the specified number of days
  and seconds}
 
function DateTimeToStDate(DT : TDateTime) : TStDate;
  {-Convert Delphi TDateTime to TStDate}
 
function DateTimeToStTime(DT : TDateTime) : TStTime;
  {-Convert Delphi TDateTime to TStTime}
 
function StDateToDateTime(D : TStDate) : TDateTime;
  {-Convert TStDate to TDateTime}
 
function StTimeToDateTime(T : TStTime) : TDateTime;
  {-Convert TStTime to TDateTime}
 
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
  {-Convert an Object Professional two byte date into a SysTools date}
 
function Convert4ByteDate(FourByteDate : TStDate) : Word;
  {-Convert a SysTools date into an Object Professional two byte date}
 
 
implementation
 
const
  First2Months = 59;           {1600 was a leap year}
  FirstDayOfWeek = Saturday;   {01/01/1600 was a Saturday}
  DateLen = 40;                {maximum length of Picture strings}
  MaxMonthName = 15;
  MaxDayName   = 15;
 
 
type
{  DateString = string[DateLen];}
  SString = string;
 
function IsLeapYear(Year : Integer) : Boolean;
  {-Return True if Year is a leap year}
begin
  Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
    ((Year mod 100 <> 0) or (Year mod 400 = 0));
end;
 
function IsLastDayofMonth(Day, Month, Year : Integer) : Boolean;
  {-Return True if date is the last day in month}
var
  Epoch : Integer;
begin
  Epoch := (Year div 100) * 100;
  if ValidDate(Day + 1, Month, Year, Epoch) then
    Result := false
  else
    Result := true;
end;
 
function IsLastDayofFeb(Date : TStDate) : Boolean;
  {-Return True if date is the last day in February}
var
  Day, Month, Year : Integer;
begin
  StDateToDMY(Date, Day, Month, Year);
  if (Month = 2) and IsLastDayOfMonth(Day, Month, Year) then
    Result := true
  else
    Result := false;
end;
 
 
 
procedure ExchangeLongInts(var I, J : LongInt);
register;
asm
  mov  ecx, [eax]
  push ecx
  mov  ecx, [edx]
  mov  [eax], ecx
  pop  ecx
  mov  [edx], ecx
end;
 
procedure ExchangeStructs(var I, J; Size : Cardinal);
register;
asm
  push edi
  push ebx
  push ecx
  shr  ecx, 2
  jz   @@LessThanFour
 
@@AgainDWords:
  mov  ebx, [eax]
  mov  edi, [edx]
  mov  [edx], ebx
  mov  [eax], edi
  add  eax, 4
  add  edx, 4
  dec  ecx
  jnz  @@AgainDWords
 
@@LessThanFour:
  pop  ecx
  and  ecx, $3
  jz   @@Done
  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh
  inc  eax
  inc  edx
  dec  ecx
  jz   @@Done
 
  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh
  inc  eax
  inc  edx
  dec  ecx
  jz   @@Done
 
  mov  bl, [eax]
  mov  bh, [edx]
  mov  [edx], bl
  mov  [eax], bh
 
@@Done:
  pop  ebx
  pop  edi
end;
 
function ResolveEpoch(Year, Epoch : Integer) : Integer;
  {-Convert 2-digit year to 4-digit year according to Epoch}
var
  EpochYear,
  EpochCent : Integer;
begin
  if Word(Year) < 100 then begin
    EpochYear := Epoch mod 100;
    EpochCent := (Epoch div 100) * 100;
    if (Year < EpochYear) then
      Inc(Year,EpochCent+100)
    else
      Inc(Year,EpochCent);
  end;
  Result := Year;
end;
 
function CurrentDate : TStDate;
  {-Returns today's date as a julian}
var
  Year, Month, Date : Word;
begin
  DecodeDate(Now,Year,Month,Date);
  Result := DMYToStDate(Date,Month,Year,0);
end;
 
function DaysInMonth(Month : integer; Year, Epoch : Integer) : Integer;
    {-Return the number of days in the specified month of a given year}
begin
  Year := ResolveEpoch(Year, Epoch);
 
  if (Year < MinYear) OR (Year > MaxYear) then
  begin
    Result := 0;
    Exit;
  end;
 
  case Month of
    1, 3, 5, 7, 8, 10, 12 :
      Result := 31;
    4, 6, 9, 11 :
      Result := 30;
    2 :
     Result := 28+Ord(IsLeapYear(Year));
  else
    Result := 0;
  end;
end;
 
function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
  {-Verify that day, month, year is a valid date}
begin
  Year := ResolveEpoch(Year, Epoch);
 
  if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
    Result := False
  else case Month of
    1..12 :
      Result := Day <= DaysInMonth(Month, Year, Epoch);
  else
    Result := False;
  end
end;
 
function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
  {-Convert from day, month, year to a julian date}
begin
  Year := ResolveEpoch(Year, Epoch);
 
  if not ValidDate(Day, Month, Year, Epoch) then
    Result := BadDate
  else if (Year = MinYear) and (Month < 3) then
    if Month = 1 then
      Result := Pred(Day)
    else
      Result := Day+30
  else begin
    if Month > 2 then
      Dec(Month, 3)
    else begin
      Inc(Month, 9);
      Dec(Year);
    end;
    Dec(Year, MinYear);
    Result :=
      ((LongInt(Year div 100)*146097) div 4)+
      ((LongInt(Year mod 100)*1461) div 4)+
      (((153*Month)+2) div 5)+Day+First2Months;
  end;
end;
 
function WeekOfYear(Julian : TStDate) : Byte;
  {-Returns the week number of the year given the Julian Date}
var
  Day, Month, Year : Integer;
  FirstJulian : TStDate;
begin
  if (Julian < MinDate) or (Julian > MaxDate) then
  begin
    Result := 0;
    Exit;
  end;
 
  Julian := Julian + 3 - ((6 + Ord(DayOfWeek(Julian))) mod 7);
  StDateToDMY(Julian,Day,Month,Year);
  FirstJulian := DMYToStDate(1,1,Year,0);
  Result := 1 + (Julian - FirstJulian) div 7;
end;
 
function AstJulianDate(Julian : TStDate) : Double;
  {-Returns the Astronomical Julian Date from a TStDate}
begin
  {Subtract 0.5d since Astronomical JD starts at noon
   while TStDate (with implied .0) starts at midnight}
  Result := Julian - 0.5 + DeltaJD;
end;
 
 
function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
var
  A, B : integer;
  LY,
  GC   : Boolean;
 
begin
  Result := -MaxLongInt;
  if (not (Month in [1..12])) or (Date < 1)  then
    Exit
  else if (Month in [1, 3, 5, 7, 8, 10, 12]) and (Date > 31) then
    Exit
  else if (Month in [4, 6, 9, 11]) and (Date > 30) then
    Exit
  else if (Month = 2) then begin
    LY := IsLeapYear(Year);
    if ((LY) and (Date > 29)) or (not (LY) and (Date > 28)) then
      Exit;
  end else if ((UT < 0) or (UT >= SecondsInDay)) then
    Exit;
 
  if (Month <= 2) then begin
    Year := Year - 1;
    Month := Month + 12;
  end;
  A := abs(Year div 100);
 
  if (Year > 1582) then
    GC := True
  else if (Year = 1582) then begin
    if (Month > 10) then
      GC := True
    else if (Month < 10) then
      GC := False
    else begin
      if (Date >= 15) then
        GC := True
      else
        GC := False;
    end;
  end else
    GC := False;
  if (GC) then
    B := 2 - A + abs(A div 4)
  else
    B := 0;
 
  Result := Trunc(365.25 * (Year + 4716))
          + Trunc(30.6001 * (Month + 1))
          + Date + B - 1524.5
          + UT / SecondsInDay;
end;
 
 
function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
  {-Returns a TStDate from an Astronomical Julian Date.
    Truncate TRUE   Converts to appropriate 0 hours then truncates
             FALSE  Converts to appropriate 0 hours, then rounds to
                    nearest;}
begin
  {Convert to TStDate, adding 0.5d for implied .0d of TStDate}
  AstJulian := AstJulian + 0.5 - DeltaJD;
  if (AstJulian < MinDate) OR (AstJulian > MaxDate) then
  begin
    Result := BadDate;
    Exit;
  end;
 
  if Truncate then
    Result := Trunc(AstJulian)
  else
    Result := Trunc(AstJulian + 0.5);
end;
 
procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
  {-Convert from a julian date to month, day, year}
var
  I, J : LongInt;
begin
  if Julian = BadDate then begin
    Day := 0;
    Month := 0;
    Year := 0;
  end else if Julian <= First2Months then begin
    Year := MinYear;
    if Julian <= 30 then begin
      Month := 1;
      Day := Succ(Julian);
    end else begin
      Month := 2;
      Day := Julian-30;
    end;
  end else begin
    I := (4*LongInt(Julian-First2Months))-1;
 
    J := (4*((I mod 146097) div 4))+3;
    Year := (100*(I div 146097))+(J div 1461);
    I := (5*(((J mod 1461)+4) div 4))-3;
    Day := ((I mod 153)+5) div 5;
 
    Month := I div 153;
    if Month < 10 then
      Inc(Month, 3)
    else begin
      Dec(Month, 9);
      Inc(Year);
    end;
    Inc(Year, MinYear);
  end;
end;
 
function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
  {-Add (or subtract) the number of months, days, and years to a date.
    Months and years are added before days. No overflow/underflow
    checks are made}
var
  Day, Month, Year, Day28Delta : Integer;
begin
  StDateToDMY(Julian, Day, Month, Year);
  Day28Delta := Day-28;
  if Day28Delta < 0 then
    Day28Delta := 0
  else
    Day := 28;
 
  Inc(Year, Years);
  Inc(Year, Months div 12);
  Inc(Month, Months mod 12);
  if Month < 1 then begin
    Inc(Month, 12);
    Dec(Year);
  end
  else if Month > 12 then begin
    Dec(Month, 12);
    Inc(Year);
  end;
 
  Julian := DMYtoStDate(Day, Month, Year,0);
  if Julian <> BadDate then begin
    Inc(Julian, Days);
    Inc(Julian, Day28Delta);
  end;
  Result := Julian;
end;
 
function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
  {-Add (or subtract) the specified number of months and years to a date}
var
  Day, Month, Year : Integer;
  MaxDay, Day28Delta : Integer;
begin
  StDateToDMY(Julian, Day, Month, Year);
  Day28Delta := Day-28;
  if Day28Delta < 0 then
    Day28Delta := 0
  else
    Day := 28;
 
  Inc(Year, Years);
  Inc(Year, Months div 12);
  Inc(Month, Months mod 12);
  if Month < 1 then begin
    Inc(Month, 12);
    Dec(Year);
  end
  else if Month > 12 then begin
    Dec(Month, 12);
    Inc(Year);
  end;
 
  Julian := DMYtoStDate(Day, Month, Year,0);
  if Julian <> BadDate then begin
    MaxDay := DaysInMonth(Month, Year,0);
    if Day+Day28Delta > MaxDay then
      Inc(Julian, MaxDay-Day)
    else
      Inc(Julian, Day28Delta);
  end;
  Result := Julian;
end;
 
procedure DateDiff(Date1, Date2 : TStDate; var Days, Months, Years : Integer);
  {-Return the difference in days,months,years between two valid julian dates}
var
  Day1, Day2, Month1, Month2, Year1, Year2 : Integer;
begin
  {we want Date2 > Date1}
  if Date1 > Date2 then
    ExchangeLongInts(Date1, Date2);
 
  {convert dates to day,month,year}
  StDateToDMY(Date1, Day1, Month1, Year1);
  StDateToDMY(Date2, Day2, Month2, Year2);
 
  {days first}
  if (Day1 = DaysInMonth(Month1, Year1, 0)) then begin
    Day1 := 0;
    Inc(Month1);   {OK if Month1 > 12}
  end;
  if (Day2 = DaysInMonth(Month2, Year2, 0)) then begin
    Day2 := 0;
    Inc(Month2);   {OK if Month2 > 12}
  end;
  if (Day2 < Day1) then begin
    Dec(Month2);
    if Month2 = 0 then begin
      Month2 := 12;
      Dec(Year2);
    end;
    Days := Day2 + DaysInMonth(Month1, Year1, 0) - Day1;
  end else
  Days := Day2-Day1;
 
  {now months and years}
  if Month2 < Month1 then begin
    Inc(Month2, 12);
    Dec(Year2);
  end;
  Months := Month2-Month1;
  Years := Year2-Year1;
end;
 
function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
  {-Return the difference in days between two valid Julian
    dates using one a specific accrual method}
var
  Day1,
  Month1,
  Year1,
  Day2,
  Month2,
  Year2       : Integer;
  IY          : LongInt;
begin
  {we want Date2 > Date1}
  if Date1 > Date2 then
    ExchangeLongInts(Date1, Date2);
 
  if (DayBasis = bdtActual) then
    Result := Date2-Date1
  else
  begin
    StDateToDMY(Date1, Day1, Month1, Year1);
    StDateToDMY(Date2, Day2, Month2, Year2);
 
    if ((DayBasis = bdt30360PSA) and IsLastDayofFeb(Date1)) or (Day1 = 31) then
      Day1 := 30;
    if (DayBasis = bdt30E360) then
    begin
      if (Day2 = 31) then
        Day2 := 30
    end else
      if (Day2 = 31) and (Day1 >= 30) then
        Day2 := 30;
 
    IY := 360 * (Year2 - Year1);
    Result := IY + 30 * (Month2 - Month1) + (Day2 - Day1);
  end;
end;
 
function DayOfWeek(Julian : TStDate) : TStDayType;
  {-Return the day of the week for the date. Returns TStDayType(7) if Julian =
    BadDate.}
var
  B : Byte;
begin
  if Julian = BadDate then begin
    B := 7;
    Result := TStDayType(B);
  end else
    Result := TStDayType( (Julian+Ord(FirstDayOfWeek)) mod 7 );
end;
 
function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
  {-Return the day of the week for the day, month, year}
begin
  Result := DayOfWeek( DMYtoStDate(Day, Month, Year, Epoch) );
end;
 
procedure StTimeToHMS(T : TStTime; var Hours, Minutes, Seconds : Byte);
  {-Convert a Time variable to Hours, Minutes, Seconds}
begin
  if T = BadTime then begin
    Hours := 0;
    Minutes := 0;
    Seconds := 0;
  end
  else begin
    Hours := T div SecondsInHour;
    Dec(T, LongInt(Hours)*SecondsInHour);
    Minutes := T div SecondsInMinute;
    Dec(T, LongInt(Minutes)*SecondsInMinute);
    Seconds := T;
  end;
end;
 
function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
  {-Convert Hours, Minutes, Seconds to a Time variable}
var
  T : TStTime;
begin
  Hours := Hours mod HoursInDay;
  T := (LongInt(Hours)*SecondsInHour)+(LongInt(Minutes)*SecondsInMinute)+Seconds;
  Result := T mod SecondsInDay;
end;
 
function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
  {-Return true if Hours:Minutes:Seconds is a valid time}
begin
  if (Hours < 0)   or (Hours > 23) or
     (Minutes < 0) or (Minutes >= 60) or
     (Seconds < 0) or (Seconds >= 60) then
    Result := False
  else
    Result := True;
end;
 
function CurrentTime : TStTime;
  {-Returns current time in seconds since midnight}
begin
  Result := Trunc(SysUtils.Time * SecondsInDay);
end;
 
procedure TimeDiff(Time1, Time2 : TStTime; var Hours, Minutes, Seconds : Byte);
  {-Return the difference in hours,minutes,seconds between two times}
begin
  StTimeToHMS(Abs(Time1-Time2), Hours, Minutes, Seconds);
end;
 
function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Add the specified hours,minutes,seconds to T and return the result}
begin
  Inc(T, HMStoStTime(Hours, Minutes, Seconds));
  Result := T mod SecondsInDay;
end;
 
function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
  {-Subtract the specified hours,minutes,seconds from T and return the result}
begin
  Hours := Hours mod HoursInDay;
  Dec(T, HMStoStTime(Hours, Minutes, Seconds));
  if T < 0 then
    Result := T+SecondsInDay
  else
    Result := T;
end;
 
function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
  {-Round T to the nearest hour, or Truncate minutes and seconds from T}
var
  Hours, Minutes, Seconds : Byte;
begin
  StTimeToHMS(T, Hours, Minutes, Seconds);
  Seconds := 0;
  if not Truncate then
    if Minutes >= (MinutesInHour div 2) then
      Inc(Hours);
  Minutes := 0;
  Result := HMStoStTime(Hours, Minutes, Seconds);
end;
 
function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
  {-Round T to the nearest minute, or Truncate seconds from T}
var
  Hours, Minutes, Seconds : Byte;
begin
  StTimeToHMS(T, Hours, Minutes, Seconds);
  if not Truncate then
    if Seconds >= (SecondsInMinute div 2) then
      Inc(Minutes);
  Seconds := 0;
  Result := HMStoStTime(Hours, Minutes, Seconds);
end;
 
 
procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
                       var Days : LongInt; var Secs : LongInt);
  {-Return the difference in days and seconds between two points in time}
var
  tDT1, tDT2 : TStDateTimeRec;
begin
  tDT1 := DT1;
  tDT2 := DT2;
  {swap if tDT1 later than tDT2}
  if (tDT1.D > tDT2.D) or ((tDT1.D = tDT2.D) and (tDT1.T > tDT2.T)) then
    ExchangeStructs(tDT1, tDT2,sizeof(TStDateTimeRec));
 
  {the difference in days is easy}
  Days := tDT2.D-tDT1.D;
 
  {difference in seconds}
  if tDT2.T < tDT1.T then begin
    {subtract one day, add 24 hours}
    Dec(Days);
    Inc(tDT2.T, SecondsInDay);
  end;
  Secs := tDT2.T-tDT1.T;
end;
 
function DateTimeToStDate(DT : TDateTime) : TStDate;
  {-Convert Delphi TDateTime to TStDate}
var
  Day, Month, Year : Word;
begin
  DecodeDate(DT, Year, Month, Day);
  Result := DMYToStDate(Day, Month, Year, 0);
end;
 
function DateTimeToStTime(DT : TDateTime) : TStTime;
  {-Convert Delphi TDateTime to TStTime}
var
  Hour, Min, Sec, MSec : Word;
begin
  DecodeTime(DT, Hour, Min, Sec, MSec);
  Result := HMSToStTime(Hour, Min, Sec);
end;
 
function StDateToDateTime(D : TStDate) : TDateTime;
  {-Convert TStDate to TDateTime}
var
  Day, Month, Year : Integer;
begin
  Result := 0;
  if D <> BadDate then begin
    StDateToDMY(D, Day, Month, Year);
    Result := EncodeDate(Year, Month, Day);
  end;
end;
 
function StTimeToDateTime(T : TStTime) : TDateTime;
  {-Convert TStTime to TDateTime}
var
  Hour, Min, Sec   : Byte;
begin
  Result := 0;
  if T <> BadTime then begin
    StTimeToHMS(T, Hour, Min, Sec);
    Result := EncodeTime(Hour, Min, Sec, 0);
  end;
end;
 
procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; Days : Integer; Secs : LongInt);
  {-Increment (or decrement) DT1 by the specified number of days and seconds
    and put the result in DT2}
begin
  DT2 := DT1;
 
  {date first}
  Inc(DT2.D, LongInt(Days));
 
  if Secs < 0 then begin
    {change the sign}
    Secs := -Secs;
 
    {adjust the date}
    Dec(DT2.D, Secs div SecondsInDay);
    Secs := Secs mod SecondsInDay;
 
    if Secs > DT2.T then begin
      {subtract a day from DT2.D and add a day's worth of seconds to DT2.T}
      Dec(DT2.D);
      Inc(DT2.T, SecondsInDay);
    end;
 
    {now subtract the seconds}
    Dec(DT2.T, Secs);
  end
  else begin
    {increment the seconds}
    Inc(DT2.T, Secs);
 
    {adjust date if necessary}
    Inc(DT2.D, DT2.T div SecondsInDay);
 
    {force time to 0..SecondsInDay-1 range}
    DT2.T := DT2.T mod SecondsInDay;
  end;
end;
 
function Convert2ByteDate(TwoByteDate : Word) : TStDate;
begin
  Result := LongInt(TwoByteDate) + Date1900;
end;
 
function Convert4ByteDate(FourByteDate : TStDate) : Word;
begin
  Result := Word(FourByteDate - Date1900);
end;
 
procedure SetDefaultYear;
  {-Initialize DefaultYear and DefaultMonth}
var
  Month, Day, Year : Word;
  T : TDateTime;
begin
  T := Now;
  DecodeDate(T, Year, Month, Day);
  DefaultYear := Year;
  DefaultMonth := Month;
end;
 
 
initialization
  {initialize DefaultYear and DefaultMonth}
  SetDefaultYear;
end.

This code has outlived TurboPower but it is a testament the power of Delphi and Pascal.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

BCS Wampserver 64 Bit

When installing Wampserver on the Windows 8.1 (64 bit) and the Windows 10 (64 bit) be sure and use the 64 bit version of Wampserver. Depending on the platform Wampserver will advise you of any missing software.

The first thin to do is make sure the localhost designation is not commented in the hosts file of the operating system. The hosts file on the windows platform is usually found at C:\Windows\System32\drivers\etc\hosts. Care should be taken to open the file you will perform the edit with in administrator mode. Anything less than administrator mode not be able to save any required changes.

After successful install make sure services are installed for Apache and MySQL. Start all service should be invoked after these two services are installed.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.

BCS Web Browser Component

There are those times when it would be nice to have a component with the capability to surf the web. This stand alone component provides the user with exactly that. Additional features implemented include a search and highlight facility.

This component is easily modifiable to store URL and page title in a database. Consequently SEO information may be retrieved and stored in the database also.

There are other utilization of this component which will be released in subsequent versions of this component.

The source code is available by clicking here.

The component documentation can be located here.

Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.