mlemanczyk/Delphi-Project-Manager
1
0 Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
653730888b7d04b09c8d0aa26cba512746c31898
Delphi-Project-Manager/DelphiProjectHandler.Tests/UsesClauseReaderClassTests.cs
T
mlemanczyk fa6feafba7 Initial import
2012-09-24 20:55:07 +02:00

5483 lines
290 KiB
C#
Raw Blame History

using System;
using System.Collections.Generic;
using NUnit.Framework;
using DelphiProjectHandler;
namespace DelphiProjectHandler.Tests
{
[TestFixture]
public class UsesClauseReaderClassTests
{
protected UnitList GetDefaultUnits(int iCount, bool iWithPaths, bool iRelative, bool iWithConditions)
{
UnitList vResult = new UnitList();
for (int vUnitIdx = 0; vUnitIdx < iCount; vUnitIdx++)
{
string vUnitName = "Unit" + vUnitIdx.ToString();
string vUnitPath = "";
if (iWithPaths)
if (iRelative)
vUnitPath = "..\\.." + "DefaultPath" + vUnitIdx.ToString();
else
vUnitPath = @"c:\windows\temp\DefaultPath" + vUnitIdx.ToString() + "\\" + vUnitName + ".pas";
UnitItem vUnit = new UnitItem(vUnitName, vUnitPath, iWithPaths, "");
if (iWithConditions)
{
vUnit.StartingConditions = "{$IFDEF TestCondition}";
vUnit.EndingConditions = "{$ENDIF}";
}
vResult.Add(vUnit);
}
return vResult;
}
protected void CompareUnitLists(UnitList iExpected, UnitList iActual, bool iWithPaths)
{
Assert.AreEqual(iExpected.Count, iActual.Count, "Wrong number of units was read");
for (int vUnitIdx = 0; vUnitIdx < iActual.Count; vUnitIdx++)
{
Assert.AreEqual(iExpected[vUnitIdx].Name, iActual[vUnitIdx].Name, "Wrong name of the unit was read");
Assert.AreEqual(iExpected[vUnitIdx].UsePath, iActual[vUnitIdx].UsePath, "Wrong HasPath was read");
if (iWithPaths)
Assert.AreEqual(iExpected[vUnitIdx].Path, iActual[vUnitIdx].Path, "Wrong path of the unit was read");
Assert.AreEqual(iExpected[vUnitIdx].StartingConditions, iActual[vUnitIdx].StartingConditions, "Wrong StartingCondition was read");
Assert.AreEqual(iExpected[vUnitIdx].EndingConditions, iActual[vUnitIdx].EndingConditions, "Wrong EndingCondition was read (" + vUnitIdx.ToString() + ")");
}
}
protected void DoTestGetUnits(int iCount, bool iWithPaths, bool iRelative, bool iWithConditions)
{
UnitList vExpected = GetDefaultUnits(iCount, iWithPaths, iRelative, iWithConditions);
string vTestValue =
"interface\n" +
"\n" +
vExpected.ToString();
UnitList vActual = UsesClauseReader.GetUnits(vTestValue);
CompareUnitLists(vExpected, vActual, iWithPaths);
}
protected void DoTestGetUnits_MultipleUnitsInConditionals(int iCount, int iStartingIdx, int iEndingIdx, bool iWithPaths, bool iRelativePaths)
{
UnitList vExpected = GetDefaultUnits(iCount, iWithPaths, iRelativePaths, false);
vExpected[iStartingIdx].StartingConditions = "{$IFDEF test}";
vExpected[iEndingIdx].EndingConditions = "{$ENDIF}";
string vTestValue = vExpected.ToString();
UnitList vActual = UsesClauseReader.GetUnits(vTestValue);
CompareUnitLists(vExpected, vActual, iWithPaths);
}
protected string ConstructUnit(
string iInterfaceUses,
string iImplementationUses,
bool iAddTypes,
bool iAddVars)
{
string vTypeDeclaration =
"type\n" +
" TType = class(TObject)\n" +
" private\n" +
" FField: Integer;\n" +
" public\n" +
" property Field: Integer read FField write FField;\n" +
" end;\n" +
"\n";
string vVarsDeclaration =
"var\n" +
" vIndex: Integer;\n" +
" vValue: AnsiString;\n" +
"\n" +
"const\n" +
" cInteger: Integer = 10;\n" +
" cString: AnsiString = \"test\";\n" +
"\n";
string vTestValue =
"interface\n" +
"\n" +
iInterfaceUses + "\n" +
"\n";
if (iAddTypes)
vTestValue += vTypeDeclaration;
if (iAddVars)
vTestValue += vVarsDeclaration;
vTestValue +=
"implementation\n" +
"\n" +
iImplementationUses;
if (iAddTypes)
vTestValue += vTypeDeclaration;
if (iAddVars)
vTestValue += vVarsDeclaration;
return vTestValue;
}
protected void DoTestExtractUses(
bool iHasInterface,
bool iHasImplementation,
bool iWithPaths,
bool iRelative,
bool iWithConditionals,
bool iAddTypes,
bool iAddVars)
{
string vActualInterface;
string vActualImplementation;
string vInterface = "";
string vImplementation = "";
if (iHasInterface)
vInterface = GetDefaultUnits(2, iWithPaths, iRelative, iWithConditionals).ToString();
if (iHasImplementation)
vImplementation = GetDefaultUnits(3, iWithPaths, iRelative, iWithConditionals).ToString();
string vTestValue = ConstructUnit(vInterface, vImplementation, iAddTypes, iAddVars);
UsesClauseReader.ExtractUses(vTestValue, out vActualInterface, out vActualImplementation);
Assert.AreEqual(vInterface, vActualInterface, "Uses clause from interface is wrong");
Assert.AreEqual(vImplementation, vActualImplementation, "Uses clause from implementation is wrong");
}
protected void CheckUnitList(string iUsesClause, IList<string> iExpectedList, string iErrorMsg)
{
if (iExpectedList.Count > 0)
Assert.AreNotEqual("", iUsesClause, "Parse uses clause is empty. " + iErrorMsg);
UnitList vActual = UsesClauseReader.GetUnits(iUsesClause);
Assert.AreEqual(iExpectedList.Count, vActual.Count, "Incorrect no. of units on list. " + iErrorMsg);
foreach (string vUnitName in iExpectedList)
Assert.AreNotEqual(-1, vActual.IndexOf(vUnitName), "Unit " + vUnitName + " was not found on the list. " + iErrorMsg);
}
protected void TestGetUnits(string iTestValue, IList<string> iExpectedInterfaceUnits, IList<string> iExpectedImplementationUnits)
{
string vInterface, vImplementation;
UsesClauseReader.ExtractUses(iTestValue, out vInterface, out vImplementation);
CheckUnitList(vInterface, iExpectedInterfaceUnits, "Interface parsing error");
CheckUnitList(vImplementation, iExpectedImplementationUnits, "Implementation parsing error");
}
[Test]
public void GetUnits_WithoutPath()
{
DoTestGetUnits(8, false, false, false);
}
[Test]
public void GetUnits_WithPath()
{
DoTestGetUnits(8, true, false, false);
}
[Test]
public void GetUnits_WithPath_Relative()
{
DoTestGetUnits(8, true, true, false);
}
[Test]
public void GetUnits_WithoutPaths_WithConditions()
{
DoTestGetUnits(8, false, false, true);
}
[Test]
public void GetUnits_WitPaths_WithConditions()
{
DoTestGetUnits(8, true, false, true);
}
[Test]
public void GetUnits_WithPaths_Relative_WithConditions()
{
DoTestGetUnits(8, true, true, true);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals()
{
DoTestGetUnits_MultipleUnitsInConditionals(2, 0, 1, false, false);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals_WithPaths()
{
DoTestGetUnits_MultipleUnitsInConditionals(2, 0, 1, true, false);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals_WithPaths_Relative()
{
DoTestGetUnits_MultipleUnitsInConditionals(2, 0, 1, true, true);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals_4()
{
DoTestGetUnits_MultipleUnitsInConditionals(4, 1, 2, false, false);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals_4_WithPaths()
{
DoTestGetUnits_MultipleUnitsInConditionals(4, 1, 2, true, false);
}
[Test]
public void GetUnits_MultipleUnitsInConditionals_4_WithPaths_Relative()
{
DoTestGetUnits_MultipleUnitsInConditionals(4, 1, 2, true, true);
}
[Test]
public void ExtractUses_2Sections_Simple()
{
DoTestExtractUses(true, true, false, false, false, false, false);
}
[Test]
public void ExtractUses_2Sections_Simple_WithConditionals()
{
DoTestExtractUses(true, true, false, false, true, false, false);
}
[Test]
public void ExtractUses_2Sections_Simple_WithPaths()
{
DoTestExtractUses(true, true, true, false, false, false, false);
}
[Test]
public void ExtractUses_2Sections_Simple_WithPaths_Relative()
{
DoTestExtractUses(true, true, true, true, false, false, false);
}
[Test]
public void ExtractUses_2Sections_Simple_WithPathsConditionals()
{
DoTestExtractUses(true, true, true, false, true, false, false);
}
[Test]
public void ExtractUses_2Sections_Simple_WithPathsConditionals_Relative()
{
DoTestExtractUses(true, true, true, true, true, false, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes()
{
DoTestExtractUses(true, true, false, false, false, true, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes_WithConditionals()
{
DoTestExtractUses(true, true, false, false, true, true, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes_WithPaths()
{
DoTestExtractUses(true, true, true, false, false, true, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes_WithPaths_Relative()
{
DoTestExtractUses(true, true, true, true, false, true, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes_WithPathsConditionals()
{
DoTestExtractUses(true, true, true, false, true, true, false);
}
[Test]
public void ExtractUses_2Sections_WithTypes_WithPathsConditionals_Relative()
{
DoTestExtractUses(true, true, true, true, true, true, false);
}
[Test]
public void ExtractUses_2Sections_WithVars()
{
DoTestExtractUses(true, true, false, false, false, false, true);
}
[Test]
public void ExtractUses_2Sections_WithVars_WithConditionals()
{
DoTestExtractUses(true, true, false, false, true, false, true);
}
[Test]
public void ExtractUses_2Sections_WithVars_WithPaths()
{
DoTestExtractUses(true, true, true, false, false, false, true);
}
[Test]
public void ExtractUses_2Sections_WithVars_WithPaths_Relative()
{
DoTestExtractUses(true, true, true, true, false, false, true);
}
[Test]
public void ExtractUses_2Sections_WithVars_WithPathsConditionals()
{
DoTestExtractUses(true, true, true, false, true, false, true);
}
[Test]
public void ExtractUses_2Sections_WithVars_WithPathsConditionals_Relative()
{
DoTestExtractUses(true, true, true, true, true, false, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars()
{
DoTestExtractUses(true, true, false, false, false, true, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars_WithConditionals()
{
DoTestExtractUses(true, true, false, false, true, true, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars_WithPaths()
{
DoTestExtractUses(true, true, true, false, false, true, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars_WithPaths_Relative()
{
DoTestExtractUses(true, true, true, true, false, true, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars_WithPathsConditionals()
{
DoTestExtractUses(true, true, true, false, true, true, true);
}
[Test]
public void ExtractUses_2Sections_WithTypesVars_WithPathsConditionals_Relative()
{
DoTestExtractUses(true, true, true, true, true, true, true);
}
[Test]
public void ExtractUses_InterfaceOnly()
{
DoTestExtractUses(true, false, false, false, false, true, true);
}
[Test]
public void ExtractUses_ImplementationOnly()
{
DoTestExtractUses(false, true, false, false, false, true, true);
}
[Test]
public void ExtractUses_Project()
{
#region (Test value)
string vTestValue =
@"{WXPFIB}" + "\n" +
@"program WXPFIB;" + "\n" +
@"" + "\n" +
@"uses" + "\n" +
@" {$IFDEF WINRUNNER}" + "\n" +
@" TestSrvr ," + "\n" +
@" {$ENDIF}" + "\n" +
@" Forms ," + "\n" +
@" DBUNIT ," + "\n" +
@" GDECLARE ," + "\n" +
@" SIGNIN ," + "\n" +
@" ViewScrn ," + "\n" +
@" uWXPFIB ," + "\n" +
@" oWXPFIB in '..\FORMS\oWXPFIB.pas' {sWXPFIB}" + "\n" +
@" ;" + "\n" +
@"{$R *.RES}" + "\n" +
@"" + "\n" +
@"begin" + "\n" +
@" Application.Initialize;" + "\n" +
@" Application.Title := 'Weekly World Wide Briefing Report';" + "\n" +
@" Application.CreateForm(TsWXPFIB, sWXPFIB);" + "\n" +
@" Application.CreateForm(TViewForm , ViewForm);" + "\n" +
@" Application.Run;" + "\n" +
@"end." + "\n";
#endregion
string vExpected =
@"uses" + "\n" +
@" {$IFDEF WINRUNNER}" + "\n" +
@" TestSrvr ," + "\n" +
@" {$ENDIF}" + "\n" +
@" Forms ," + "\n" +
@" DBUNIT ," + "\n" +
@" GDECLARE ," + "\n" +
@" SIGNIN ," + "\n" +
@" ViewScrn ," + "\n" +
@" uWXPFIB ," + "\n" +
@" oWXPFIB in '..\FORMS\oWXPFIB.pas' {sWXPFIB}" + "\n" +
@" ;";
string vActual = UsesClauseReader.ExtractUses(vTestValue);
Assert.AreEqual(vExpected, vActual);
}
[Test]
public void ExtractUses_LibraryWithDefaultComments()
{
#region (Test value)
string vTestValue =
@"library FlightInfo;" + "\n" +
@"" + "\n" +
@"{ Important note about DLL memory management: ShareMem must be the" + "\n" +
@" first unit in your library's USES clause AND your project's (select" + "\n" +
@" Project-View Source) USES clause if your DLL exports any procedures or" + "\n" +
@" functions that pass strings as parameters or function results. This" + "\n" +
@" applies to all strings passed to and from your DLL--even those that" + "\n" +
@" are nested in records and classes. ShareMem is the interface unit to" + "\n" +
@" the BORLNDMM.DLL shared memory manager, which must be deployed along" + "\n" +
@" with your DLL. To avoid using BORLNDMM.DLL, pass string information" + "\n" +
@" using PChar or ShortString parameters. }" + "\n" +
@"" + "\n" +
@"uses" + "\n" +
@" UpdateArrivalFlightInfoClass in '..\Web\FT\Server\UpdateArrivalFlightInfoClass.pas';" + "\n" +
@"" + "\n" +
@"function GetData(const iRequest : PChar; const iMetaData : PChar;" + "\n" +
@" var iResponse: PChar) : Boolean; stdcall;" + "\n" +
@"var" + "\n" +
@" vServiceProvider : TRemoteServiceProvider;" + "\n" +
@" vLogger: TLogger;" + "\n" +
@"begin" + "\n" +
@" Result := False;" + "\n" +
@" vLogger := TLogger.Create(LC_WEB_ENTRY_POINTS);" + "\n" +
@" vServiceProvider := TRemoteServiceProvider.Create;" + "\n" +
@" try" + "\n" +
@" try" + "\n" +
@" Result := vServiceProvider.GetData(iRequest, iMetaData, iResponse);" + "\n" +
@" except" + "\n" +
@" on e : Exception do" + "\n" +
@" vLogger.error('FlightInfo', 'GetData', e.Message);" + "\n" +
@" end;" + "\n" +
@" finally" + "\n" +
@" vServiceProvider.Free;" + "\n" +
@" vLogger.Free;" + "\n" +
@" end;" + "\n" +
@"end;" + "\n" +
@"" + "\n" +
@"" + "\n" +
@"procedure FreePChar(const p: PChar); stdcall;" + "\n" +
@"begin" + "\n" +
@" TRemoteServiceProvider.FreePChar(p);" + "\n" +
@"end;" + "\n" +
@"" + "\n" +
@"exports" + "\n" +
@" GetData," + "\n" +
@" FreePChar;" + "\n" +
@"" + "\n" +
@"var" + "\n" +
@" vRSP : TRemoteServiceProvider;" + "\n" +
@" vLogger: TLogger;" + "\n" +
@"begin" + "\n" +
@" TLogger.Configure('log4d.properties');" + "\n" +
@" vRSP := TRemoteServiceProvider.Create;" + "\n" +
@" vLogger := TLogger.Create(LC_WEB_ENTRY_POINTS);" + "\n" +
@" try" + "\n" +
@" try" + "\n" +
@" vRSP.SetUpFromConfig();" + "\n" +
@" except" + "\n" +
@" on e : Exception do" + "\n" +
@" vLogger.error('FlightInfo', 'StartUp method', e.Message);" + "\n" +
@" end;" + "\n" +
@" finally" + "\n" +
@" vRSP.Free;" + "\n" +
@" vLogger.Free;" + "\n" +
@" end;" + "\n" +
@"end.";
#endregion
string vExpected =
@"uses" + "\n" +
@" UpdateArrivalFlightInfoClass in '..\Web\FT\Server\UpdateArrivalFlightInfoClass.pas';";
string vActual = UsesClauseReader.ExtractUses(vTestValue);
Assert.AreEqual(vExpected, vActual);
}
[Test]
public void GetUnits_FormComments()
{
#region (Test value)
string vTestValue =
@"library FlightInfo;" + "\n" +
@"" + "\n" +
@"{ Important note about DLL memory management: ShareMem must be the" + "\n" +
@" first unit in your library's USES clause AND your project's (select" + "\n" +
@" Project-View Source) USES clause if your DLL exports any procedures or" + "\n" +
@" functions that pass strings as parameters or function results. This" + "\n" +
@" applies to all strings passed to and from your DLL--even those that" + "\n" +
@" are nested in records and classes. ShareMem is the interface unit to" + "\n" +
@" the BORLNDMM.DLL shared memory manager, which must be deployed along" + "\n" +
@" with your DLL. To avoid using BORLNDMM.DLL, pass string information" + "\n" +
@" using PChar or ShortString parameters. }" + "\n" +
@"" + "\n" +
@"uses" + "\n" +
@" UpdateArrivalFlightInfoClass in '..\Web\FT\Server\UpdateArrivalFlightInfoClass.pas' {test_form_name};" + "\n" +
@"" + "\n" +
@"function GetData(const iRequest : PChar; const iMetaData : PChar;" + "\n" +
@" var iResponse: PChar) : Boolean; stdcall;" + "\n" +
@"var" + "\n" +
@" vServiceProvider : TRemoteServiceProvider;" + "\n" +
@" vLogger: TLogger;" + "\n" +
@"begin" + "\n" +
@" Result := False;" + "\n" +
@" vLogger := TLogger.Create(LC_WEB_ENTRY_POINTS);" + "\n" +
@" vServiceProvider := TRemoteServiceProvider.Create;" + "\n" +
@" try" + "\n" +
@" try" + "\n" +
@" Result := vServiceProvider.GetData(iRequest, iMetaData, iResponse);" + "\n" +
@" except" + "\n" +
@" on e : Exception do" + "\n" +
@" vLogger.error('FlightInfo', 'GetData', e.Message);" + "\n" +
@" end;" + "\n" +
@" finally" + "\n" +
@" vServiceProvider.Free;" + "\n" +
@" vLogger.Free;" + "\n" +
@" end;" + "\n" +
@"end;" + "\n" +
@"" + "\n" +
@"" + "\n" +
@"procedure FreePChar(const p: PChar); stdcall;" + "\n" +
@"begin" + "\n" +
@" TRemoteServiceProvider.FreePChar(p);" + "\n" +
@"end;" + "\n" +
@"" + "\n" +
@"exports" + "\n" +
@" GetData," + "\n" +
@" FreePChar;" + "\n" +
@"" + "\n" +
@"var" + "\n" +
@" vRSP : TRemoteServiceProvider;" + "\n" +
@" vLogger: TLogger;" + "\n" +
@"begin" + "\n" +
@" TLogger.Configure('log4d.properties');" + "\n" +
@" vRSP := TRemoteServiceProvider.Create;" + "\n" +
@" vLogger := TLogger.Create(LC_WEB_ENTRY_POINTS);" + "\n" +
@" try" + "\n" +
@" try" + "\n" +
@" vRSP.SetUpFromConfig();" + "\n" +
@" except" + "\n" +
@" on e : Exception do" + "\n" +
@" vLogger.error('FlightInfo', 'StartUp method', e.Message);" + "\n" +
@" end;" + "\n" +
@" finally" + "\n" +
@" vRSP.Free;" + "\n" +
@" vLogger.Free;" + "\n" +
@" end;" + "\n" +
@"end.";
#endregion
string vExpected =
@"uses" + "\n" +
@" UpdateArrivalFlightInfoClass in '..\Web\FT\Server\UpdateArrivalFlightInfoClass.pas' {test_form_name};";
string vActual = UsesClauseReader.ExtractUses(vTestValue);
Assert.AreEqual(vExpected, vActual, "Wrong uses clause returned");
UnitList vList = UsesClauseReader.GetUnits(vActual);
Assert.AreEqual(1, vList.Count, "Wrong number of units returned");
UnitItem vItem = vList[0];
Assert.IsTrue(vItem.HasForm, "UnitItem should indicated to have form");
Assert.AreEqual("test_form_name", vItem.Form, "Form name is wrong");
}
[Test]
public void GetUnits_CommentsBetweenUnitNames()
{
#region (Test value)
string cACWGTSBroker =
"unit ACWGTSBroker;\r\n" +
"\r\n" +
"interface\r\n" +
"\r\n" +
"uses\r\n" +
" oConsole,\r\n" +
" // system units\r\n" +
" Classes, SysUtils, Contnrs,\r\n" +
" // DAL-specific units\r\n" +
" // 2nd line comment,\r\n" +
" // 3rd line comment; Part after comment\r\n" +
" QueryInterface,\r\n" +
" DMBaseBrokerClass,\r\n" +
" DMBaseSQLBrokerClass,\r\n" +
" DMBaseArchSQLBrokerClass,\r\n" +
" DatabaseProviderFactoryClass,\r\n" +
" DatabaseQueryFactoryClass,\r\n" +
" AbstractQuery,\r\n" +
" MetaTableAgentClass,\r\n" +
" //io units\r\n" +
" ACWGTSio\r\n" +
" ;\r\n" +
"\r\n" +
"type\r\n" +
" TACWGTSData = class(TObject)\r\n" +
" private\r\n" +
" FData: ACWGTSRecordType;\r\n" +
" public\r\n" +
" property Data: ACWGTSRecordType read FData;\r\n" +
" end;\r\n" +
"\r\n" +
" TACWGTSDataList = class(TObjectList)\r\n" +
" private\r\n" +
" function GetItem(Index: Integer): TACWGTSData;\r\n" +
" public\r\n" +
" property Items[Index: Integer]: TACWGTSData read GetItem; default;\r\n" +
" end;\r\n" +
"\r\n" +
" // Interface to access brokers\r\n" +
" ILoadACWGTSQuery = interface(IQuery)\r\n" +
" procedure GetACWGTSRecord(\r\n" +
" TailNumber,\r\n" +
" Config,\r\n" +
" Comp: string;\r\n" +
" var ACWGTSRecord: ACWGTSRecordType);\r\n" +
" end;\r\n" +
"\r\n" +
" // SQL broker\r\n" +
" TACWGTSSqlBroker = class(TDMBaseArchSQLBroker, ILoadACWGTSQuery)\r\n" +
" private\r\n" +
" function GetACWGTSKey(\r\n" +
" const iACWGTSRecord : ACWGTSRecordType): AnsiString;\r\n" +
" protected\r\n" +
" procedure MoveToObject(const iAbstractQuery: TAbstractQuery; const iMoveable: TObject); override;\r\n" +
" function CreateMoveable(const iAbstractQuery: TAbstractQuery): TObject; override;\r\n" +
" function GetTableName: string; override;\r\n" +
" public\r\n" +
" procedure GetACWGTSRecord(\r\n" +
" TailNumber,\r\n" +
" Config,\r\n" +
" Comp: string;\r\n" +
" var ACWGTSRecord: ACWGTSRecordType);\r\n" +
" function ResolveInterface(const iType: TQueryType): IQuery; override;\r\n" +
" end;\r\n" +
"\r\n" +
" // Btrive broker\r\n" +
" TACWGTSBtrvBroker = class(TDMBaseBroker, ILoadACWGTSQuery)\r\n" +
" private\r\n" +
" procedure GetACWGTSRecord(\r\n" +
" TailNumber,\r\n" +
" Config,\r\n" +
" Comp: string;\r\n" +
" var ACWGTSRecord: ACWGTSRecordType);\r\n" +
" public\r\n" +
" function ResolveInterface(const iType: TQueryType): IQuery; override;\r\n" +
" end;\r\n" +
"\r\n" +
" TACWGTSDataAcquisitor = class\r\n" +
" class procedure GetACWGTSRecord(\r\n" +
" TailNumber,\r\n" +
" Config,\r\n" +
" Comp: string;\r\n" +
" var ACWGTSRecord: ACWGTSRecordType);\r\n" +
" end;\r\n" +
"\r\n" +
"implementation\r\n" +
"\r\n" +
"uses\r\n" +
" MyStd,\r\n" +
" DMGlobals,\r\n" +
" CommonConsts,\r\n" +
" OracleKeywordClass,\r\n" +
" DMSQLQueryFactory,\r\n" +
" DMBtrvQueryFactory,\r\n" +
" DMUtils,\r\n" +
" gdeclare,\r\n" +
" DBUNIT,\r\n" +
" Datetime;\r\n" +
"\r\n";
#endregion
TestGetUnits(cACWGTSBroker,
new string[] {"oConsole", "Classes", "SysUtils", "Contnrs", "QueryInterface",
"DMBaseBrokerClass", "DMBaseSQLBrokerClass", "DMBaseArchSQLBrokerClass",
"DatabaseProviderFactoryClass", "DatabaseQueryFactoryClass", "AbstractQuery",
"MetaTableAgentClass", "ACWGTSio"},
new string[] {"MyStd", "DMGlobals", "CommonConsts", "OracleKeywordClass", "DMSQLQueryFactory",
"DMBtrvQueryFactory", "DMUtils", "gdeclare", "DBUNIT", "Datetime"});
}
[Test]
public void GetUnits_DateTime()
{
#region (Test value)
const string cDateTime =
"{ DATETIME PAS 68,928 05-31-96 6:10p DCO 119 }\r\n" +
"unit Datetime;\r\n" +
"{$O+,F+}\r\n" +
"interface\r\n" +
"\r\n" +
"uses\r\n" +
" SYSUTILS,\r\n" +
" Classes,\r\n" +
" Math,\r\n" +
" Windows;\r\n" +
"\r\n" +
"const\r\n" +
" MIN_PER_HR = 60;\r\n" +
" MIN_PER_DAY = 1440; { 24 Hr/Day * 60 Min/Hr }\r\n" +
" SEC_PER_DAY = 86400; { 24 Hr/Day * 60 Min/Hr * 60 Sec/Min }\r\n" +
" SEC_PER_HR = 3600; { 60 Min/Hr * 60 Sec/Min }\r\n" +
" SEC_PER_MIN = 60;\r\n" +
"\r\n" +
" MAX_EARLY_DEP_MINS = (4 * MIN_PER_HR);\r\n" +
" MAX_FLT_LENGTH_MINS = (20 * MIN_PER_HR);\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }\r\n" +
" coDatePartSize = 7;\r\n" +
" coTimePartSize = 4;\r\n" +
" coBlankDate : ShortString = ' ';\r\n" +
" coBlankTime : ShortString = ' ';\r\n" +
" coDRBMaxNumericDate = #99#99#05#15;\r\n" +
"var\r\n" +
" coMaxDate : TDateTime;\r\n" +
"\r\n" +
"type\r\n" +
" FlightTimeType = record\r\n" +
" Date :array[1..8] of char;\r\n" +
" Time :smallint;\r\n" +
" UTCVariance :smallint;\r\n" +
" end;\r\n" +
"\r\n" +
" EagleTimeType = string[4]; { HHMM }\r\n" +
" NumericDateType = string[4]; { chr(CC), chr (YY), chr (MM), chr (DD) }\r\n" +
" UpdateTimeType = string[4]; { HHMM }\r\n" +
" UTCVarianceType = string[5]; { +/-HHMM }\r\n" +
" UniversalTimeType = string[6]; { HHMMSS }\r\n" +
" UniversalTimeTypeMS = string[9]; { HHMMSSTTT }\r\n" +
" UniversalDateType = string[7]; { DDMMMYY }\r\n" +
" CCYYMMDDDateType = array[1..8] of Char; // was string[8]; { CCYYMMDD }\r\n" +
" CrewDateType = CCYYMMDDDateType;\r\n" +
" USDateType = string[6]; { MMDDYY }\r\n" +
"\r\n" +
"function EagleDateToDateTime(const StringDateTime: ShortString): TDateTime; overload; // DMB\r\n" +
"function EagleDateToDateTime(const StringDateTime: ShortString; var ivIsOK: Boolean): TDateTime; overload;\r\n" +
"function DateTimetoEagleDate(const DateTimeIn :TDateTime) :shortstring;\r\n" +
"function EagleDateTimeToDateTime(const iDate, iTime: ShortString): TDateTime; overload;\r\n" +
"function EagleDateTimeToDateTime(const iDate, iTime: ShortString; var ivIsOK: Boolean): TDateTime; overload;\r\n" +
"function EagleTimeToDateTime(const iTime: ShortString; const iFixTime : Boolean = False): TDateTime;\r\n" +
"function DateTimeToEagleTime(const iDateTime: TDateTime) : ShortString;\r\n" +
"\r\n" +
"function FormatToHHNNDDMMYY(const iDateTime :TDateTime):AnsiString;\r\n" +
"procedure GetUTCDates\r\n" +
" (const iUTCNumericDepartureDate: NumericDateType;\r\n" +
" const iDepartureTime: EagleTimeType;\r\n" +
" const iArrivalTime: EagleTimeType;\r\n" +
" var iUTCDeparture: TDateTime;\r\n" +
" var iUTCArrival: TDateTime);\r\n" +
"function ConvertToDateTime(const iEagleTime: EagleTimeType; const iNumericDate: NumericDateType):TDateTime;\r\n" +
"procedure DecodeEagleTime(iEagleTime:string; var Hour, Min: Word);\r\n" +
"procedure DecodeNumericDate(const iNumDate :string; var Year, Month, Day: Word);\r\n" +
"\r\n" +
"function NumericToYYYYMMDD(iNumDate :string) :string;\r\n" +
"\r\n" +
"function YYYYMMDDtoNumericDate(iYYYYMMDD :string) :string;\r\n" +
"\r\n" +
"function ValidUSDate(\r\n" +
" USDate :USDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function USToUniversalDate\r\n" +
" (\r\n" +
" USDate :USDateType;\r\n" +
" var UniversalDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function UniversalToUSDate\r\n" +
" (\r\n" +
" UniversalDate :UniversalDateType;\r\n" +
" var USDate :USDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"(**************************************************************************************************\r\n" +
"Converts the DDMONYY date & the time to TDATETIME format\r\n" +
"SB 09NOV1999\r\n" +
"**************************************************************************************************)\r\n" +
"function UniversalDateToTDATE(NumericDate :NumericDateType;\r\n" +
" APTime :integer;\r\n" +
" var DateTimeasSysFormat :TDateTime) :boolean;\r\n" +
"\r\n" +
"function ValidUniversalDate(\r\n" +
" ChkDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function ValidEagleTime(\r\n" +
" ChkTime :EagleTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function ValidUniversalTime(\r\n" +
" ChkTime :UniversalTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function GetUniversalDateTime\r\n" +
" (\r\n" +
" var CurrDate :UniversalDateType;\r\n" +
" var CurrTime :UniversalTimeType;\r\n" +
" var wSec100 :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"procedure GetCurrentDateTime\r\n" +
" (\r\n" +
" var CurrDate :UniversalDateType;\r\n" +
" var wCurrHour :word;\r\n" +
" var wCurrMinute :word;\r\n" +
" var wCurrSecond :word;\r\n" +
" var wCurrSec100 :word\r\n" +
" );\r\n" +
"\r\n" +
"function ConvertEagleTime\r\n" +
" (\r\n" +
" EagleTime :EagleTimeType;\r\n" +
" var wHour :word;\r\n" +
" var wMinute :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function ConvertUniversalTime\r\n" +
" (\r\n" +
" UniversalTime :UniversalTimeType;\r\n" +
" var wHour :word;\r\n" +
" var wMinute :word;\r\n" +
" var wSecond :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function TimeDiff\r\n" +
" (\r\n" +
" var ErrorRet :integer;\r\n" +
" var Minutes :longint;\r\n" +
" FirstDate :UniversalDateType;\r\n" +
" FirstTime :EagleTimeType;\r\n" +
" SecondDate :UniversalDateType;\r\n" +
" SecondTime :EagleTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function UnivTimeDiff\r\n" +
" (\r\n" +
" var ErrorRet :integer;\r\n" +
" var Seconds :longint;\r\n" +
" FirstDate :UniversalDateType;\r\n" +
" FirstTime :UniversalTimeType;\r\n" +
" SecondDate :UniversalDateType;\r\n" +
" SecondTime :UniversalTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"procedure SecSince01Jan1970\r\n" +
" (\r\n" +
" var Seconds :longint;\r\n" +
" var Sec1000 :longint\r\n" +
" );\r\n" +
"\r\n" +
"function CheckDDMMMYYDate\r\n" +
" (\r\n" +
" CheckDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function CompleteDate\r\n" +
" (\r\n" +
" var ReferenceDate :UniversalDateType;\r\n" +
" var PartialDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"function SecondsSinceMidnight :longint;\r\n" +
"\r\n" +
"function GetUniversalTime :UniversalTimeType;\r\n" +
"\r\n" +
"function GetUniversalTimeMS :UniversalTimeTypeMS;\r\n" +
"\r\n" +
"function GetUniversalDate :UniversalDateType;\r\n" +
"\r\n" +
"function GetUniversalYear :string;\r\n" +
"\r\n" +
"function AddCenturyToYear(YearOfCentury :string) :string;\r\n" +
"\r\n" +
"function NumericDate\r\n" +
" (\r\n" +
" const iDate :UniversalDateType\r\n" +
" )\r\n" +
" :NumericDateType;\r\n" +
"\r\n" +
"function ValidateDate(var s :string) :boolean;\r\n" +
"\r\n" +
"function ValidateTime(s :string): Boolean;\r\n" +
"\r\n" +
"function ValidateGMTVariance(s :string): Boolean;\r\n" +
"\r\n" +
"function ValidateDateChange(s :string): Boolean;\r\n" +
"\r\n" +
"function ValidateDailyFrequency(s :string): Boolean;\r\n" +
"\r\n" +
"function JulianDay(DateNumeric :string) :longint;\r\n" +
"\r\n" +
"function DayAD(DateNumeric :string) :longint;\r\n" +
"\r\n" +
"function NumToDate(DateNumeric :string) :string;\r\n" +
"\r\n" +
"function DayOfWeekAD(DayAD :longint) :shortint;\r\n" +
"\r\n" +
"function DayOfWeekAlpha(DayOfWeek :shortint) :string;\r\n" +
"\r\n" +
"function NumericDayOfWeek(Date :TDateTime) :integer;\r\n" +
"\r\n" +
"function LeapYear(YearAD :integer) :boolean;\r\n" +
"\r\n" +
"function DayADToDate(DayAD :longint) :string;\r\n" +
"\r\n" +
"function NumericMonth(Month :string) :shortint;\r\n" +
"\r\n" +
"function AlphaMonth(MonthNumeric :shortint) :string;\r\n" +
"\r\n" +
"function TimeToMinutes(Time :string) :integer;\r\n" +
"\r\n" +
"function MinutesToTime(Minutes :integer) :string;\r\n" +
"\r\n" +
"function MinutesToTime5H(Minutes :LongInt) :string;\r\n" +
"\r\n" +
"function SecondsToTime(Seconds :integer) :string;\r\n" +
"\r\n" +
"function GMTMinuteAD(NumericLocalDate\r\n" +
" , LocalTime\r\n" +
" , GMTVariance\r\n" +
" , DateChange :string) :longint;\r\n" +
"\r\n" +
"function MinAdToTime(i: longint): string;\r\n" +
"\r\n" +
"function MinAdToDate(i: longint): string; overload;\r\n" +
"function MinAdToDate(i : longint; var ivIsOK: Boolean): string; overload;\r\n" +
"\r\n" +
"procedure CalculateNextMonth(Date :string;\r\n" +
" var NextMonth , Year :string);\r\n" +
"\r\n" +
"function LocalToGMT(LocalTime , GMTVariance :string) :string;\r\n" +
"\r\n" +
"function GMTtoLocal(GMT , GMTVariance :string) :string;\r\n" +
"\r\n" +
"function TimeToAMPM(Time :string) :string;\r\n" +
"\r\n" +
"function TimeToAMPM1(Time :string) :string;\r\n" +
"\r\n" +
"function TimeToAMPM2(Time :string) :string;\r\n" +
"\r\n" +
"function TimeAMToTime(Time :string) :string;\r\n" +
"\r\n" +
"function TimeToTimeMaintenance(iTime :integer) :string;\r\n" +
"\r\n" +
"function EagleToCCYYMMDDDate(EagleDate :UniversalDateType) : CCYYMMDDDateType;\r\n" +
"\r\n" +
"function GetCrewDate(RefDateTime: TDateTime = 0) :CrewDateType;\r\n" +
"\r\n" +
"procedure EagleToCrewTracDate\r\n" +
" (EagleDate :UniversalDateType;\r\n" +
" var StartCrewTracDate :CrewDateType);\r\n" +
"\r\n" +
"procedure FlightEventUTCToLt\r\n" +
" (\r\n" +
" sNumFltDateUTC :NumericDateType;\r\n" +
" sSTDUTC :EagleTimeType;\r\n" +
" sFltEventUTC :EagleTimeType;\r\n" +
" sUTCVariance :UTCVarianceType;\r\n" +
" var stFltEventLt :FlightTimeType\r\n" +
" );\r\n" +
"\r\n" +
"procedure GMTtoOUTOFFONINMVTCrewTracTime\r\n" +
" (EagleNumGMTDate ,\r\n" +
" EagleSTDudt ,\r\n" +
" EagleETDudt ,\r\n" +
" EagleGMTTime ,\r\n" +
" EagleGMTVariance :string;\r\n" +
" var CrewTracTime :FlightTimeType);\r\n" +
"\r\n" +
"function YMD2DMYEagle(inDate :string) :string;\r\n" +
"\r\n" +
"function ZIPDate(iNumDate :string) :string;\r\n" +
"\r\n" +
"function ComputeElapsedMinutes(Time1udt , Time2udt :string) :integer;\r\n" +
"\r\n" +
"procedure Delay(DelayAmount :word);\r\n" +
"\r\n" +
"function GetUTCDate :TDateTime;\r\n" +
"\r\n" +
"function GetUTCTime :TDateTime;\r\n" +
"\r\n" +
"function GetUTCDateTime :TDateTime;\r\n" +
"\r\n" +
"function NowUTC :TDateTime;\r\n" +
"\r\n" +
"function NumericYesterday :string;\r\n" +
"\r\n" +
"function nowUTCMinute: TDateTime;\r\n" +
"\r\n" +
"procedure TimeIsUTCBased(Value :boolean); // vs. system time\r\n" +
"\r\n" +
"function ConvertDateTimeToUniversalDate(DateTime :TDateTime) :UniversalDateType;\r\n" +
"\r\n" +
"function NumericDateToUniversalDate(iNumDate :string) :UniversalDateType;\r\n" +
"\r\n" +
"function UniversalDateTimeToTDateTime\r\n" +
" ( UniversalDate: UniversalDateType;\r\n" +
" HHMM : EagleTimeType;\r\n" +
" var iTDateTime : TDateTime ) : boolean;\r\n" +
"\r\n" +
"function TDateTimeToUniversalDateTime\r\n" +
" ( iTDateTime : TDateTime;\r\n" +
" var UniversalDate: UniversalDateType;\r\n" +
" var HHMM : EagleTimeType ) : boolean;\r\n" +
"\r\n" +
"function TDateTimeToDDHHMM (iTDateTime : TDateTime) :string;\r\n" +
"\r\n" +
"function DDHHMMToTDateTime (iDDHHMM : string; iRefTimestamp: TDateTime = -1) :TDateTime;\r\n" +
"\r\n" +
"Function NumericDateToDDMMMYY (NumericDateIn : String) : String;\r\n" +
"\r\n" +
"Function ValidNumericDate (Const NumericDateIn : String) : Boolean;\r\n" +
"\r\n" +
"function DateTimeToDDMMMYY( NewDate : TDateTime ) : string;\r\n" +
"\r\n" +
"function NumericDateToDateTime(const iNumericDate : string): TDatetime;\r\n" +
"\r\n" +
"function DDMMMYYDateToDateTime( DDMMMYYDate : string ) : TDateTime;\r\n" +
"\r\n" +
"function NumericDateWithTimeToDateTime(iNumericDateTime: ShortString): TDateTime;\r\n" +
"\r\n" +
"function DateTimeToNumericDateWithTime(iValue: TDateTime): ShortString;\r\n" +
"\r\n" +
"function DateTimeToNumericDate(const DateTimeIn :TDateTime) :NumericDateType;\r\n" +
"\r\n" +
"function YYYYMMDDToTDateTime(iYYYYMMDD: AnsiString): TDateTime;\r\n" +
"\r\n" +
"function HHMMToTTime(iHHMM: AnsiString): TDateTime;\r\n" +
"\r\n" +
"implementation\r\n" +
"\r\n" +
"uses\r\n" +
" Mystd, Forms, Dialogs, DateUtils;\r\n" +
"\r\n" +
"const\r\n" +
" AnnualDaysToMonth :array[1..12] of integer\r\n" +
" = (0 , 31 , 59 , 90 , 120 , 151 , 181 , 212 , 243 , 273 , 304 , 334);\r\n" +
" AlphaMonths :array[1..12] of string[3]\r\n" +
" = ('JAN' , 'FEB' , 'MAR' , 'APR' , 'MAY' , 'JUN' , 'JUL' ,\r\n" +
" 'AUG' , 'SEP' , 'OCT' , 'NOV' , 'DEC');\r\n" +
" AlphaDaysOfWeek :array[1..7] of string[3]\r\n" +
" = ('MON' , 'TUE' , 'WED' , 'THU' , 'FRI' , 'SAT' , 'SUN');\r\n" +
"var\r\n" +
" AllTimeIsUTCBased :boolean;\r\n" +
" FTestDate: string[7];\r\n" +
"{** 07-30-98 * ConvertDateTimeToUniversalDate *********************************}\r\n" +
"\r\n" +
"function ConvertDateTimeToUniversalDate(DateTime :TDateTime) :UniversalDateType;\r\n" +
"\r\n" +
"const\r\n" +
" MonthId :array[1..12] of string[3] =\r\n" +
" ('JAN' , 'FEB' , 'MAR' , 'APR' , 'MAY' , 'JUN' , 'JUL' , 'AUG' , 'SEP' , 'OCT' , 'NOV' , 'DEC');\r\n" +
"\r\n" +
"var\r\n" +
" Day :string[4];\r\n" +
" Year :string[4];\r\n" +
" wDay :word;\r\n" +
" wMonth :word;\r\n" +
" wYear :word;\r\n" +
"\r\n" +
"begin\r\n" +
" decodedate(DateTime , wYear , wMonth , wDay);\r\n" +
" str(wYear , Year);\r\n" +
" str((wDay + 1000) :4 , Day);\r\n" +
" Result := copy(Day , 3 , 2)\r\n" +
" + MonthId[wMonth]\r\n" +
" + copy(Year , 3 , 2);\r\n" +
"end; //ConvertDateTimeToUniversalDate\r\n" +
"\r\n" +
"function FormatToHHNNDDMMYY(const iDateTime :TDateTime): AnsiString;\r\n" +
"begin\r\n" +
" result := FormatDateTime('hhnnddmmyy', iDateTime);\r\n" +
"end;\r\n" +
"\r\n" +
"function ConvertToDateTime(const iEagleTime: EagleTimeType; const iNumericDate: NumericDateType):TDateTime;\r\n" +
"var\r\n" +
" Year, Month, Day :Word;\r\n" +
" Hour, Minute :Word;\r\n" +
"begin\r\n" +
" DateTime.DecodeNumericDate(iNumericDate, Year, Month, Day);\r\n" +
" DateTime.DecodeEagleTime(iEagleTime, Hour, Minute);\r\n" +
" Result := EncodeDateTime(Year, Month, Day, Hour, Minute, 0{Second}, 0{MilliSecond});\r\n" +
"end;\r\n" +
"\r\n" +
"procedure GetUTCDates\r\n" +
" (const iUTCNumericDepartureDate: NumericDateType;\r\n" +
" const iDepartureTime: EagleTimeType;\r\n" +
" const iArrivalTime: EagleTimeType;\r\n" +
" var iUTCDeparture: TDateTime;\r\n" +
" var iUTCArrival: TDateTime);\r\n" +
"begin\r\n" +
" iUTCDeparture := ConvertToDateTime(iDepartureTime, iUTCNumericDepartureDate);\r\n" +
" iUTCArrival := ConvertToDateTime(iArrivalTime, iUTCNumericDepartureDate);\r\n" +
"\r\n" +
" if (iUTCArrival > iUTCDeparture) then\r\n" +
" begin\r\n" +
" // ok\r\n" +
" end\r\n" +
" else begin\r\n" +
" iUTCArrival := IncDay(iUTCArrival, 1);\r\n" +
" end;\r\n" +
"\r\n" +
"end;\r\n" +
"\r\n" +
"\r\n" +
"procedure DecodeNumericDate(const iNumDate :string; var Year, Month, Day: Word);\r\n" +
"var\r\n" +
" vDateTime: TDateTime;\r\n" +
"begin\r\n" +
" vDateTime := NumericDateToDateTime(iNumDate);\r\n" +
" DecodeDate(vDateTime, Year, Month, Day);\r\n" +
"end;\r\n" +
"\r\n" +
"procedure DecodeEagleTime(iEagleTime:string; var Hour, Min: Word);\r\n" +
"\r\n" +
" function StrToWord(const str: string): word;\r\n" +
" var\r\n" +
" i: integer;\r\n" +
" begin\r\n" +
" result := 0;\r\n" +
" for i := 1 to 2 do // HH or MM\r\n" +
" begin\r\n" +
" if not (str[i] in ['0'..'9']) then\r\n" +
" begin\r\n" +
" result := 0;\r\n" +
" Break;\r\n" +
" end;\r\n" +
" result := (result*10) + ord(str[i]) - ord('0');\r\n" +
" end;\r\n" +
" end;\r\n" +
"\r\n" +
"var\r\n" +
" vHour :string[2];\r\n" +
" vMin :string[2];\r\n" +
"begin\r\n" +
" iEagleTime := iEagleTime + ' ';\r\n" +
"\r\n" +
" vHour := copy(iEagleTime, 1, 2);\r\n" +
" vMin := copy(iEagleTime, 3, 2);\r\n" +
"\r\n" +
" Hour := StrToWord(vHour);\r\n" +
" if (Hour > 23) then\r\n" +
" begin\r\n" +
" Hour := 0;\r\n" +
" end;\r\n" +
" Min := StrToWord(vMin);\r\n" +
" if (Min > 59) then\r\n" +
" begin\r\n" +
" Min := 0;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"function NumericToYYYYMMDD(iNumDate :string) :string;\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" Century ,\r\n" +
" Day , Month , Year :string[2];\r\n" +
" Date :string[8];\r\n" +
"begin\r\n" +
" str(ord(iNumDate[4]) :2 , Day);\r\n" +
" str(ord(iNumDate[3]) :2 , Month);\r\n" +
" str(ord(iNumDate[2]) :2 , Year);\r\n" +
" str(ord(iNumDate[1]) :2 , Century);\r\n" +
" Date := Century + Year + Month + Day;\r\n" +
" for i := 1 to 8 do\r\n" +
" begin\r\n" +
" if Date[i] = ' ' then\r\n" +
" Date[i] := '0';\r\n" +
" end;\r\n" +
" NumericToYYYYMMDD := Date;\r\n" +
"end;\r\n" +
"\r\n" +
"function YYYYMMDDtoNumericDate(iYYYYMMDD :string) :string;\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" NCentury , NYear , NMonth , NDay :ShortInt;\r\n" +
"begin\r\n" +
" val(copy(iYYYYMMDD , 1 , 2) , NCentury , i);\r\n" +
" val(copy(iYYYYMMDD , 3 , 2) , NYear , i);\r\n" +
" val(copy(iYYYYMMDD , 5 , 2) , NMonth , i);\r\n" +
" val(copy(iYYYYMMDD , 7 , 2) , NDay , i);\r\n" +
" YYYYMMDDtoNumericDate := chr(NCentury)\r\n" +
" + chr(NYear)\r\n" +
" + chr(NMonth)\r\n" +
" + chr(NDay);\r\n" +
"end;\r\n" +
"\r\n" +
"{** 05-24-96 * ValidUSDate ***********************************************}\r\n" +
"\r\n" +
"function ValidUSDate(\r\n" +
" USDate :USDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
" mm :integer;\r\n" +
" dd :integer;\r\n" +
" yy :integer;\r\n" +
" i :integer;\r\n" +
"\r\n" +
"begin { function ValidUSDate }\r\n" +
" valid := true;\r\n" +
" val(copy(USDate , 1 , 2) , mm , i);\r\n" +
" if i <> 0 then\r\n" +
" valid := false;\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" val(copy(USDate , 3 , 2) , dd , i);\r\n" +
" if i <> 0 then\r\n" +
" valid := false\r\n" +
" else if (dd < 1) then\r\n" +
" valid := false;\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" val(copy(USDate , 5 , 2) , yy , i);\r\n" +
" if i <> 0 then\r\n" +
" valid := false\r\n" +
" else if (yy < 0) then\r\n" +
" valid := false;\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" if (mm >= 1) and (mm <= 12) then\r\n" +
" begin\r\n" +
" case mm of\r\n" +
" 1 , 3 , 5 , 7 , 8 , 10 , 12\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 31 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" 4 , 6 , 9 , 11\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 30 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" 2\r\n" +
" :\r\n" +
" begin\r\n" +
" if (LeapYear(yy)) then\r\n" +
" begin\r\n" +
" if dd > 29 then\r\n" +
" valid := false;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if dd > 28 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" end;\r\n" +
" end; { case }\r\n" +
" end { if }\r\n" +
" else\r\n" +
" valid := false;\r\n" +
" end; { if }\r\n" +
" end; { if }\r\n" +
" end; { if }\r\n" +
" ValidUSDate := valid;\r\n" +
"end; { function ValidUSDate }\r\n" +
"\r\n" +
"{** 05-24-96 * UniversalToUSDate *****************************************}\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: Converts DDMMMYY to MMDDYY.\r\n" +
"\r\n" +
" PARAMETERS: UniversalDate Date in DDMMMYY format\r\n" +
" USDate Date in MMDDYY format\r\n" +
"\r\n" +
" RETURNS: TRUE Success\r\n" +
" FALSE Failure\r\n" +
"\r\n" +
" LOCAL: Valid Local flag\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"function UniversalToUSDate\r\n" +
" (\r\n" +
" UniversalDate :UniversalDateType;\r\n" +
" var USDate :USDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" valid :boolean;\r\n" +
" sMonth :string;\r\n" +
"\r\n" +
"begin { function UniversalToUSDate }\r\n" +
" valid := true;\r\n" +
" if (ValidUniversalDate(UniversalDate)) then\r\n" +
" begin\r\n" +
" sMonth := Copy(UniversalDate , 3 , 3);\r\n" +
" i := 0;\r\n" +
" repeat\r\n" +
" Inc(i);\r\n" +
" until (i > 12) or (sMonth = AlphaMonths[i]);\r\n" +
" if (i <= 12) then\r\n" +
" begin\r\n" +
" Str(i , sMonth);\r\n" +
" if (length(sMonth) = 1) then\r\n" +
" sMonth := '0' + sMonth;\r\n" +
" USDate := sMonth;\r\n" +
" USDate := USDate + Copy(UniversalDate , 1 , 2);\r\n" +
" USDate := USDate + Copy(UniversalDate , 6 , 2);\r\n" +
" end { if }\r\n" +
" else\r\n" +
" valid := false;\r\n" +
" end { if }\r\n" +
" else\r\n" +
" valid := false;\r\n" +
" UniversalToUSDate := valid;\r\n" +
"end; { function UniversalToUSDate }\r\n" +
"\r\n" +
"(**************************************************************************************************\r\n" +
"Converts the DDMONYY date & the time to TDATETIME format\r\n" +
"SB 09NOV1999\r\n" +
"**************************************************************************************************)\r\n" +
"\r\n" +
"function UniversalDateToTDATE(NumericDate :NumericDateType;\r\n" +
" APTime :integer;\r\n" +
" var DateTimeAsSysFormat :TDateTime) :boolean;\r\n" +
"var\r\n" +
" vDateIncrement :Integer;\r\n" +
" vCentury : Word;\r\n" +
" vYear : Word;\r\n" +
" vMonth : Word;\r\n" +
" vDay : Word;\r\n" +
" vHour : Word;\r\n" +
" vMinute : Word;\r\n" +
"begin\r\n" +
" vDateIncrement := 0;\r\n" +
"\r\n" +
" vHour := 0;\r\n" +
" vMinute := 0;\r\n" +
" if APTime <> 0 then\r\n" +
" begin\r\n" +
" vDateIncrement := APTime div 1440;\r\n" +
" APTime := APTime - (1440 * vDateIncrement);\r\n" +
" vHour := APTime div 60;\r\n" +
" vMinute := APTime - (60 * vHour);\r\n" +
" end;\r\n" +
" try\r\n" +
" vCentury := Ord(NumericDate[1]);\r\n" +
" vYear := Ord(NumericDate[2]);\r\n" +
" vMonth := Ord(NumericDate[3]);\r\n" +
" vDay := Ord(NumericDate[4]);\r\n" +
"\r\n" +
" DateTimeAsSysFormat := EncodeDateTime((vCentury * 100) + vYear, vMonth, vDay, vHour, vMinute, 0 , 0);\r\n" +
" if vDateIncrement <> 0 then\r\n" +
" DateTimeAsSysFormat := DateTimeAsSysFormat + vDateIncrement;\r\n" +
" Result := True;\r\n" +
" except on EConvertError do\r\n" +
" begin\r\n" +
" Result := False;\r\n" +
" end;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"{** 05-24-96 * USToUniversalDate *****************************************}\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: Converts MMDDYY to DDMMMYY.\r\n" +
"\r\n" +
" PARAMETERS: USDate Date in MMDDYY format\r\n" +
" UniversalDate Date in DDMMMYY format\r\n" +
"\r\n" +
" RETURNS: TRUE Success\r\n" +
" FALSE Failure\r\n" +
"\r\n" +
" LOCAL: Valid Local flag\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"function USToUniversalDate\r\n" +
" (\r\n" +
" USDate :USDateType;\r\n" +
" var UniversalDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" ErrorRet :integer;\r\n" +
" iMonth :integer;\r\n" +
" valid :boolean;\r\n" +
"\r\n" +
"begin { function USToUniversalDate }\r\n" +
" valid := ValidUSDate(USDate);\r\n" +
" if valid then\r\n" +
" begin\r\n" +
" { Convert to Input Date/Time to Universal Formats }\r\n" +
" val(Copy(USDate , 1 , 2) , iMonth , ErrorRet);\r\n" +
" if (ErrorRet <> 0) then\r\n" +
" valid := false\r\n" +
" else if (iMonth < 1) or (iMonth > 12) then\r\n" +
" valid := false\r\n" +
" else { valid }\r\n" +
" begin\r\n" +
" UniversalDate := Copy(USDate , 3 , 2);\r\n" +
" UniversalDate := UniversalDate + AlphaMonths[iMonth];\r\n" +
" UniversalDate := UniversalDate + Copy(USDate , 5 , 2);\r\n" +
" end; { else }\r\n" +
" end; { if }\r\n" +
" USToUniversalDate := valid;\r\n" +
"end; { function USToUniversalDate }\r\n" +
"\r\n" +
"{** 05-31-96 * ValidUniversalDate ****************************************}\r\n" +
"\r\n" +
"function ValidUniversalDate(\r\n" +
" ChkDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
" mm :integer;\r\n" +
" dd :integer;\r\n" +
" yy :integer;\r\n" +
" i :integer;\r\n" +
"\r\n" +
"begin { function ValidUniversalDate }\r\n" +
" valid := true;\r\n" +
" mm := 0;\r\n" +
" yy := 0;\r\n" +
" for i := 1 to 12 do\r\n" +
" if copy(ChkDate , 3 , 3) = AlphaMonths[i] then\r\n" +
" mm := i;\r\n" +
" if mm = 0 then\r\n" +
" valid := false;\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" val(copy(ChkDate , 1 , 2) , dd , i);\r\n" +
" if i <> 0 then\r\n" +
" valid := false\r\n" +
" else if dd < 1 then\r\n" +
" valid := false;\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" val(copy(ChkDate , 6 , 2) , yy , i);\r\n" +
" if i <> 0 then\r\n" +
" valid := false\r\n" +
" else if yy < 0 then\r\n" +
" valid := false;\r\n" +
" end; { if }\r\n" +
" if (valid) then\r\n" +
" begin\r\n" +
" case mm of\r\n" +
" 1 , 3 , 5 , 7 , 8 , 10 , 12\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 31 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" 4 , 6 , 9 , 11\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 30 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" 2\r\n" +
" :\r\n" +
" begin\r\n" +
" if (LeapYear(yy)) then\r\n" +
" begin\r\n" +
" if dd > 29 then\r\n" +
" valid := false;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if dd > 28 then\r\n" +
" valid := false;\r\n" +
" end;\r\n" +
" end;\r\n" +
" end; { case }\r\n" +
" end; { if }\r\n" +
" end; { if }\r\n" +
" ValidUniversalDate := valid;\r\n" +
"end; { function ValidUniveralDate }\r\n" +
"\r\n" +
"{** 05-01-96 * ValidEagleTime ********************************************}\r\n" +
"\r\n" +
"function ValidEagleTime(\r\n" +
" ChkTime :EagleTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
"\r\n" +
"begin { function ValidEagleTime }\r\n" +
" valid := true;\r\n" +
" if (ChkTime[1] < '0') or\r\n" +
" (ChkTime[1] > '2') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[2] < '0') or\r\n" +
" (ChkTime[2] > '9') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[1] = '2') and\r\n" +
" (ChkTime[2] > '3') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[3] < '0') or\r\n" +
" (ChkTime[3] > '5') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[4] < '0') or\r\n" +
" (ChkTime[4] > '9') then\r\n" +
" valid := false;\r\n" +
" ValidEagleTime := valid;\r\n" +
"end; { function ValidEagleTime }\r\n" +
"\r\n" +
"{** 05-01-96 * ValidUniversalTime ****************************************}\r\n" +
"\r\n" +
"function ValidUniversalTime(\r\n" +
" ChkTime :UniversalTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
"\r\n" +
"begin { function ValidUniversalTime }\r\n" +
" valid := true;\r\n" +
" if (ChkTime[1] < '0') or\r\n" +
" (ChkTime[1] > '2') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[2] < '0') or\r\n" +
" (ChkTime[2] > '9') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[1] = '2') and\r\n" +
" (ChkTime[2] > '3') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[3] < '0') or\r\n" +
" (ChkTime[3] > '5') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[4] < '0') or\r\n" +
" (ChkTime[4] > '9') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[5] < '0') or\r\n" +
" (ChkTime[5] > '5') then\r\n" +
" valid := false;\r\n" +
" if (ChkTime[6] < '0') or\r\n" +
" (ChkTime[6] > '9') then\r\n" +
" valid := false;\r\n" +
" ValidUniversalTime := valid;\r\n" +
"end; { function ValidUniversalTime }\r\n" +
"\r\n" +
"{** GetUniversalDateTime * 07-30-98 **************************************}\r\n" +
"\r\n" +
"function GetUniversalDateTime\r\n" +
" (\r\n" +
" var CurrDate :UniversalDateType;\r\n" +
" var CurrTime :UniversalTimeType;\r\n" +
" var wSec100 :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: GetUniversalDateTime returns the current DDMMMYY date,\r\n" +
" HHMMMSS time and hundreths of a second.\r\n" +
"\r\n" +
" PARAMETERS: CurrDate Current date in DDMMMYY format\r\n" +
" CurrTime Current time in HHMMSS format\r\n" +
" wSec100 Current hundredths of a second (0..99)\r\n" +
"\r\n" +
" RETURNS: TRUE Success\r\n" +
" FALSE Failure\r\n" +
"\r\n" +
" LOCAL: wHour Hour (0..23)\r\n" +
" wMinute Minute (0..59)\r\n" +
" wSecond Second (0..59)\r\n" +
" wSec100 Hundredth of second (0..99)\r\n" +
" Hour Hour ('000'..'023');\r\n" +
" Minute Minute ('000'..'059');\r\n" +
" Second Second ('000'..'059');\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" CurrentDateTime :TDateTime;\r\n" +
" wHour :word;\r\n" +
" wMinute :word;\r\n" +
" wSecond :word;\r\n" +
" wSec1000 :word;\r\n" +
" Hour :string[3];\r\n" +
" Minute :string[3];\r\n" +
" Second :string[3];\r\n" +
"\r\n" +
"begin { function GetUniversalDateTime }\r\n" +
"\r\n" +
" CurrentDateTime := GetUTCDateTime;\r\n" +
" CurrDate := ConvertDateTimeToUniversalDate(CurrentDateTime);\r\n" +
"\r\n" +
" decodetime(CurrentDateTime - Trunc(CurrentDateTime) , wHour , wMinute , wSecond , wSec1000);\r\n" +
" str((wHour + 100) :3 , Hour);\r\n" +
" str((wMinute + 100) :3 , Minute);\r\n" +
" str((wSecond + 100) :3 , Second);\r\n" +
" CurrTime := copy(Hour , 2 , 2) + copy(Minute , 2 , 2) +\r\n" +
" copy(Second , 2 , 2);\r\n" +
"\r\n" +
" if (ValidUniversalDate(CurrDate)) and\r\n" +
" (ValidUniversalTime(CurrTime)) then\r\n" +
" GetUniversalDateTime := true\r\n" +
" else\r\n" +
" GetUniversalDateTime := false;\r\n" +
"\r\n" +
"end; { function GetUniversalDateTime }\r\n" +
"\r\n" +
"{** GetCurrentDateTime * 07-30-98 ****************************************}\r\n" +
"\r\n" +
"procedure GetCurrentDateTime\r\n" +
" (\r\n" +
" var CurrDate :UniversalDateType;\r\n" +
" var wCurrHour :word;\r\n" +
" var wCurrMinute :word;\r\n" +
" var wCurrSecond :word;\r\n" +
" var wCurrSec100 :word\r\n" +
" );\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: GetCurrentDateTime returns the current DDMMMYY date,\r\n" +
" hours, minutes, seconds and hundredths of seconds.\r\n" +
"\r\n" +
" PARAMETERS: CurrDate Current date in DDMMMYY format\r\n" +
" wCurrHour Current hour (0..23)\r\n" +
" wCurrMinute Current minute (0..59)\r\n" +
" wCurrSecond Current second (0..59)\r\n" +
" wCurrSec100 Current hundredth of second (0..99)\r\n" +
"\r\n" +
" RETURNS: None ...\r\n" +
"\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" CurrentDateTime :TDateTime;\r\n" +
" wSec1000 :word;\r\n" +
"\r\n" +
"begin { procedure GetCurrentDateTime }\r\n" +
"\r\n" +
" CurrentDateTime := GetUTCDateTime;\r\n" +
" decodetime(CurrentDateTime - Trunc(CurrentDateTime) ,\r\n" +
" wCurrHour , wCurrMinute , wCurrSecond , wSec1000);\r\n" +
"\r\n" +
" wCurrSec100 := wSec1000 div 10;\r\n" +
" CurrDate := ConvertDateTimeToUniversalDate(CurrentDateTime);\r\n" +
"end; { procedure GetCurrentDateTime }\r\n" +
"\r\n" +
"{** 04-30-96 * ConvertUniversalTime **************************************}\r\n" +
"\r\n" +
"function ConvertUniversalTime\r\n" +
" (\r\n" +
" UniversalTime :UniversalTimeType;\r\n" +
" var wHour :word;\r\n" +
" var wMinute :word;\r\n" +
" var wSecond :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: ConvertUniversalTime converts a universal time HHMMSS to\r\n" +
" the component word hour, minute and second.\r\n" +
"\r\n" +
" PARAMETERS: UniversalTime UniversalTime (HHMMSS)\r\n" +
" wHour Hour (0..23)\r\n" +
" wMinute Minute (0..59)\r\n" +
" wSecond Second (0..59)\r\n" +
"\r\n" +
" RETURNS: TRUE Routine succeeded\r\n" +
" FALSE Routine failed (invalid time)\r\n" +
"\r\n" +
" LOCAL: err Hour ( hour: 0-23 )\r\n" +
" valid Minute ( minute: 0-59 )\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" err :integer;\r\n" +
"\r\n" +
"begin { function ConvertUniversalTime }\r\n" +
" Result := true;\r\n" +
" val(copy(UniversalTime , 1 , 2) , wHour , err);\r\n" +
" if (err <> 0) then\r\n" +
" Result := false;\r\n" +
" val(copy(UniversalTime , 3 , 2) , wMinute , err);\r\n" +
" if (err <> 0) then\r\n" +
" Result := false;\r\n" +
" val(copy(UniversalTime , 5 , 2) , wSecond , err);\r\n" +
" if (err <> 0) then\r\n" +
" Result := false;\r\n" +
"end; { function ConvertUniversalTime }\r\n" +
"\r\n" +
"{** UnivTimeDiff * 05-01-96 **********************************************}\r\n" +
"\r\n" +
"function UnivTimeDiff\r\n" +
" (\r\n" +
" var ErrorRet :integer;\r\n" +
" var Seconds :longint;\r\n" +
" FirstDate :UniversalDateType;\r\n" +
" FirstTime :UniversalTimeType;\r\n" +
" SecondDate :UniversalDateType;\r\n" +
" SecondTime :UniversalTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: UnivTimeDiff returns false if any of the passed date/time\r\n" +
" values are blank. If all values are not blank the routine\r\n" +
" calls standard routines to determine the time (in seconds)\r\n" +
" between the two passed date/times. By convention the\r\n" +
" second time should be after the first time.\r\n" +
"\r\n" +
" NOTES: 1. This routine uses library routines which work only\r\n" +
" in an assumed date range of 1950 to 2049.\r\n" +
"\r\n" +
" 2. The month in the the universal date (DDMMMYY) must\r\n" +
" be upper case.\r\n" +
"\r\n" +
" 3. The number of seconds in 68 years from the base\r\n" +
" date is too large to fit in a long integer - so\r\n" +
" this routine will only work on dates from 1950 to\r\n" +
" 2018 (1950+68).\r\n" +
"\r\n" +
" PARAMETERS: ErrorRet Error return code - unsed at this time\r\n" +
" Seconds Seconds difference between date/times\r\n" +
" FirstDate First date (DDMMMYY)\r\n" +
" FirstTime First time (HHMMSS)\r\n" +
" SecondDate Second date (DDMMMYY)\r\n" +
" SecondTime Second time (HHMMSS)\r\n" +
"\r\n" +
" RETURNS: TRUE Routine succeeded\r\n" +
" FALSE Routine failed (invalid date or time)\r\n" +
"\r\n" +
" LOCAL: valid Local function success\r\n" +
" wHour Hour ( hour: 0-23 )\r\n" +
" wMinute Minute ( minute: 0-59 )\r\n" +
" wSecond Second ( second: 0-59 )\r\n" +
" Days Number of days between dates\r\n" +
" FirstDayAD Days after death to first date\r\n" +
" SecondDayAD Days after death to second date\r\n" +
" NumericFirstDate First date in numeric format\r\n" +
" NumericSecondDate Second date in numeric format\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
" wHour :word;\r\n" +
" wMinute :word;\r\n" +
" wSecond :word;\r\n" +
" Days :longint;\r\n" +
" FirstDayAD :longint;\r\n" +
" SecondDayAD :longint;\r\n" +
" NumericFirstDate :NumericDateType;\r\n" +
" NumericSecondDate :NumericDateType;\r\n" +
"\r\n" +
"begin { function UnivTimeDiff }\r\n" +
" valid := false;\r\n" +
" if (ValidUniversalDate(FirstDate) and\r\n" +
" ValidUniversalDate(SecondDate) and\r\n" +
" ValidUniversalTime(FirstTime) and\r\n" +
" ValidUniversalTime(SecondTime)) then\r\n" +
" begin\r\n" +
" NumericFirstDate := NumericDate(FirstDate);\r\n" +
" NumericSecondDate := NumericDate(SecondDate);\r\n" +
" FirstDayAD := DayAD(NumericFirstDate);\r\n" +
" SecondDayAD := DayAD(NumericSecondDate);\r\n" +
" Days := SecondDayAD - FirstDayAD;\r\n" +
" Seconds := Days * SEC_PER_DAY;\r\n" +
"\r\n" +
" if (ConvertUniversalTime(SecondTime , wHour , wMinute , wSecond)) then\r\n" +
" begin\r\n" +
" Seconds := Seconds + (longint(wHour) * 3600) + (wMinute * 60) +\r\n" +
" wSecond;\r\n" +
" if (ConvertUniversalTime(FirstTime , wHour , wMinute , wSecond)) then\r\n" +
" begin\r\n" +
" Seconds := Seconds - (longint(wHour) * 3600) - (wMinute * 60) -\r\n" +
" wSecond;\r\n" +
" valid := true;\r\n" +
" end; { if }\r\n" +
" end; { if }\r\n" +
" end { if }\r\n" +
" else\r\n" +
" valid := false;\r\n" +
" UnivTimeDiff := valid;\r\n" +
"end; { function UnivTimeDiff }\r\n" +
"\r\n" +
"{** 01-15-97 * ConvertEagleTime ******************************************}\r\n" +
"\r\n" +
"function ConvertEagleTime\r\n" +
" (\r\n" +
" EagleTime :EagleTimeType;\r\n" +
" var wHour :word;\r\n" +
" var wMinute :word\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: ConvertEagleTime converts an Eagle time HHMM to the\r\n" +
" the component word hour and minute.\r\n" +
"\r\n" +
" PARAMETERS: EagleTime UniversalTime (HHMM)\r\n" +
" wHour Hour (0..23)\r\n" +
" wMinute Minute (0..59)\r\n" +
"\r\n" +
" RETURNS: TRUE Routine succeeded\r\n" +
" FALSE Routine failed (invalid time)\r\n" +
"\r\n" +
" LOCAL: err Hour ( hour: 0-23 )\r\n" +
" valid Minute ( minute: 0-59 )\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" err :integer;\r\n" +
"\r\n" +
"begin { function ConvertEagleTime }\r\n" +
" Result := true;\r\n" +
" Val(Copy(EagleTime , 1 , 2) , wHour , err);\r\n" +
" if (err <> 0) then\r\n" +
" Result := false;\r\n" +
" Val(Copy(EagleTime , 3 , 2) , wMinute , err);\r\n" +
" if (err <> 0) then\r\n" +
" Result := false;\r\n" +
"end; { function ConvertEagleTime }\r\n" +
"\r\n" +
"{** TimeDiff * 05-01-96 **************************************************}\r\n" +
"\r\n" +
"function TimeDiff\r\n" +
" (\r\n" +
" var ErrorRet :integer;\r\n" +
" var Minutes :longint;\r\n" +
" FirstDate :UniversalDateType;\r\n" +
" FirstTime :EagleTimeType;\r\n" +
" SecondDate :UniversalDateType;\r\n" +
" SecondTime :EagleTimeType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: TimeDiff returns false if any of the passed date/time values\r\n" +
" are blank. If all values are not blank the routine calls\r\n" +
" standard routines to determine the time (in seconds) between\r\n" +
" the two passed date/times. By convention the second time\r\n" +
" should be after the first time.\r\n" +
"\r\n" +
" NOTES: 1. This routine uses library routines which work only\r\n" +
" in an assumed date range of 1950 to 2049.\r\n" +
"\r\n" +
" 2. The month in the the universal date (DDMMMYY) must\r\n" +
" be upper case.\r\n" +
"\r\n" +
" PARAMETERS: ErrorRet Error return code - unsed at this time\r\n" +
" Minutes Minutes difference between date/times\r\n" +
" FirstDate First date (DDMMMYY)\r\n" +
" FirstTime First time (HHMM)\r\n" +
" SecondDate Second date (DDMMMYY)\r\n" +
" SecondTime Second time (HHMM)\r\n" +
"\r\n" +
" RETURNS: TRUE Routine succeeded\r\n" +
" FALSE Routine failed (invalid date or time)\r\n" +
"\r\n" +
" LOCAL: valid Local function success\r\n" +
" wHour Hour ( hour: 0-23 )\r\n" +
" wMinute Minute ( minute: 0-59 )\r\n" +
" Days Number of days between dates\r\n" +
" FirstDayAD Days after death to first date\r\n" +
" SecondDayAD Days after death to second date\r\n" +
" NumericFirstDate First date in numeric format\r\n" +
" NumericSecondDate Second date in numeric format\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" valid :boolean;\r\n" +
" wHour :word;\r\n" +
" wMinute :word;\r\n" +
" Days :longint;\r\n" +
" FirstDayAD :longint;\r\n" +
" SecondDayAD :longint;\r\n" +
" NumericFirstDate :NumericDateType;\r\n" +
" NumericSecondDate :NumericDateType;\r\n" +
"\r\n" +
"begin { function TimeDiff }\r\n" +
" valid := false;\r\n" +
" if (ValidUniversalDate(FirstDate) and\r\n" +
" ValidUniversalDate(SecondDate) and\r\n" +
" ValidEagleTime(FirstTime) and\r\n" +
" ValidEagleTime(SecondTime)) then\r\n" +
" begin\r\n" +
" NumericFirstDate := NumericDate(FirstDate);\r\n" +
" NumericSecondDate := NumericDate(SecondDate);\r\n" +
" FirstDayAD := DayAD(NumericFirstDate);\r\n" +
" SecondDayAD := DayAD(NumericSecondDate);\r\n" +
" Days := SecondDayAD - FirstDayAD;\r\n" +
" Minutes := Days * MIN_PER_DAY;\r\n" +
"\r\n" +
" if (ConvertEagleTime(SecondTime , wHour , wMinute)) then\r\n" +
" begin\r\n" +
" Minutes := Minutes + (wHour * 60) + wMinute;\r\n" +
" if (ConvertEagleTime(FirstTime , wHour , wMinute)) then\r\n" +
" begin\r\n" +
" Minutes := Minutes - (wHour * 60) - wMinute;\r\n" +
" valid := true;\r\n" +
" end; { if }\r\n" +
" end; { if }\r\n" +
"\r\n" +
" end { if }\r\n" +
" else\r\n" +
" valid := false;\r\n" +
" TimeDiff := valid;\r\n" +
"end; { function TimeDiff }\r\n" +
"\r\n" +
"{** SecSince01Jan1970 * 04-20-96 *****************************************}\r\n" +
"\r\n" +
"procedure SecSince01Jan1970\r\n" +
" (\r\n" +
" var Seconds :longint;\r\n" +
" var Sec1000 :longint\r\n" +
" );\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: SecSince01Jan1970 returns the number of seconds elapsed\r\n" +
" since Jan 01, 1970 at Midnight UTC. This routine was\r\n" +
" created to mimic the TIME function standard to most C\r\n" +
" implementation\r\n" +
"\r\n" +
"uses\r\n" +
" SYSUTILS,\r\n" +
" Classes;s. This function assumes that the\r\n" +
" workstations local, system-time is set for UTC.\r\n" +
"\r\n" +
" PARAMETERS: Seconds Seconds elapsed since Jan 1, 1970.\r\n" +
" Sec1000 Local system time in milliseconds to\r\n" +
" the nearest 10 milliseconds\r\n" +
"\r\n" +
" RETURNS: None\r\n" +
"\r\n" +
" LOCAL: wCurrHour Local system time ( hour: 0-23 )\r\n" +
" wCurrMinute Local system time ( minute: 0-59 )\r\n" +
" wCurrSecond Local system time ( second: 0-59 )\r\n" +
" wCurrSec100 Local system time ( hundredths of\r\n" +
" a second: 0-99 )\r\n" +
" Days Days since Jan 1, 1970\r\n" +
" BaseDateAD Days after death to Jan 1, 1970\r\n" +
" TodayAD Days after death to today\r\n" +
" Today Today's date in \"universal date\" format\r\n" +
" NumericBaseDate Base date Jan 1, 1970 in numeric format\r\n" +
" NumericToday Today's date in numeric format\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" wCurrHour :word;\r\n" +
" wCurrMinute :word;\r\n" +
" wCurrSecond :word;\r\n" +
" wCurrSec100 :word;\r\n" +
" Days :longint;\r\n" +
" BaseDateAD :longint;\r\n" +
" TodayAD :longint;\r\n" +
" CurrDate :UniversalDateType;\r\n" +
" NumericBaseDate :NumericDateType;\r\n" +
" NumericToday :NumericDateType;\r\n" +
"\r\n" +
"begin { procedure SecSince01Jan1970 }\r\n" +
"\r\n" +
" GetCurrentDateTime(CurrDate , wCurrHour , wCurrMinute , wCurrSecond ,\r\n" +
" wCurrSec100);\r\n" +
" NumericToday := NumericDate(CurrDate);\r\n" +
" TodayAD := DayAD(NumericToday);\r\n" +
" NumericBaseDate := chr(19) + chr(70) + chr(1) + chr(1);\r\n" +
" BaseDateAD := DayAD(NumericBaseDate);\r\n" +
" Days := TodayAD - BaseDateAD;\r\n" +
" Seconds := Days * SEC_PER_DAY;\r\n" +
" Seconds := Seconds + (Longint(wCurrHour) * 3600) +\r\n" +
" (wCurrMinute * 60) + wCurrSecond;\r\n" +
" Sec1000 := wCurrSec100 * 10;\r\n" +
"\r\n" +
"end; { procedure SecSince01Jan1970 }\r\n" +
"\r\n" +
"{** 03-22-97 * CheckDDMMMYYDate ******************************************}\r\n" +
"\r\n" +
"function CheckDDMMMYYDate\r\n" +
" (\r\n" +
" CheckDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: CheckDDMMMYYDate determines if a date in the format\r\n" +
" DDMMMYY is valid with all values in appropriate ranges.\r\n" +
"\r\n" +
" PARAMETERS: CheckDate Date to check - with format DDMMMYY\r\n" +
"\r\n" +
" RETURNS: Function True for valid date, false for an\r\n" +
" invalid date\r\n" +
"\r\n" +
" LOCAL: MaxStep Number of step in process\r\n" +
" iStep Step in progress\r\n" +
" Code Return code: string to int conversion\r\n" +
" Days31 Months with 31 days\r\n" +
" Days30 Months with 30 days\r\n" +
" Days29 Months with 28 or 29 days\r\n" +
" iDay Integer day\r\n" +
" iMonth Integer month\r\n" +
" iYear Integer year\r\n" +
" strMonth Date month - 3 char string format\r\n" +
" enumMonth Date month - enumerated: 0-11\r\n" +
" IsValid Local flag for date validity\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"type\r\n" +
" Months = (JAN , FEB , MAR , APR , MAY , JUN ,\r\n" +
" JUL , AUG , SEP , OCT , NOV , DEC);\r\n" +
"\r\n" +
" MonthSet = set of Months;\r\n" +
"\r\n" +
"const\r\n" +
" MaxStep = 6;\r\n" +
"\r\n" +
" Days31 :MonthSet = [JAN , MAR , MAY , JUL , AUG , OCT , DEC];\r\n" +
" Days30 :MonthSet = [APR , JUN , SEP , NOV];\r\n" +
" Days29 :MonthSet = [FEB];\r\n" +
"\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" iStep :integer;\r\n" +
" Code :integer;\r\n" +
" iDay :integer;\r\n" +
" iMonth :integer;\r\n" +
" iYear :integer;\r\n" +
" strMonth :string[3];\r\n" +
" enumMonth :Months;\r\n" +
" IsValid :boolean;\r\n" +
"\r\n" +
"begin { function CheckDDMMMYYDate }\r\n" +
" IsValid := true;\r\n" +
" iStep := 1;\r\n" +
" iDay := 0;\r\n" +
" iYear := 0;\r\n" +
" enumMonth := Months(0); { JAN }\r\n" +
" while (iStep <= MaxStep) and (IsValid) do\r\n" +
" begin\r\n" +
" case iStep of\r\n" +
" 1 :\r\n" +
" begin\r\n" +
" iMonth := 0;\r\n" +
" strMonth := copy(CheckDate , 3 , 3);\r\n" +
" for i := 1 to 12 do\r\n" +
" if (strMonth = AlphaMonths[i]) then\r\n" +
" iMonth := i;\r\n" +
" if (iMonth > 0) then\r\n" +
" enumMonth := Months(iMonth - 1)\r\n" +
" else\r\n" +
" IsValid := false;\r\n" +
" end;\r\n" +
" 2 :\r\n" +
" begin\r\n" +
" val(copy(CheckDate , 1 , 2) , iDay , Code);\r\n" +
" if (Code <> 0) or (iDay < 1) then\r\n" +
" IsValid := false;\r\n" +
" end;\r\n" +
" 3 :\r\n" +
" begin\r\n" +
" val(copy(CheckDate , 6 , 2) , iYear , Code);\r\n" +
" if (Code <> 0) or (iYear < 0) then\r\n" +
" IsValid := false;\r\n" +
" end;\r\n" +
" 4 :if (enumMonth in Days31) and (iDay > 31) then\r\n" +
" IsValid := false;\r\n" +
" 5 :if (enumMonth in Days30) and (iDay > 30) then\r\n" +
" IsValid := false;\r\n" +
" 6 :if (enumMonth in Days29) then\r\n" +
" begin\r\n" +
" if (LeapYear(iYear)) then\r\n" +
" begin\r\n" +
" if (iDay > 29) then\r\n" +
" IsValid := false;\r\n" +
" end\r\n" +
" else if (iDay > 28) then\r\n" +
" IsValid := false;\r\n" +
" end; // if\r\n" +
" end; { case }\r\n" +
" Inc(iStep);\r\n" +
" end; { while }\r\n" +
" CheckDDMMMYYDate := IsValid;\r\n" +
"end; { function CheckDDMMMYYDate }\r\n" +
"\r\n" +
"{** DivideUniversalDate * 02-17-95 ***************************************}\r\n" +
"\r\n" +
"function DivideUniversalDate\r\n" +
" (\r\n" +
" var UniversalDate :UniversalDateType;\r\n" +
" var SubYear :integer;\r\n" +
" var SubMonth :integer;\r\n" +
" var SubDay :integer\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: DivideUniversalDate converts a date in the format 05JAN95 to\r\n" +
" and integer components - in this case 95, 1, and 5. If the\r\n" +
" date does not include one of the three components the value\r\n" +
" will default to -1. The routine cannot identify invalid\r\n" +
" dates where the number of days exceeds a month maximum.\r\n" +
"\r\n" +
" PARAMETERS: UniversalDate Date in the format DDMMMYY\r\n" +
" SubYear 0 to 99 or -1 for error\r\n" +
" SubMonth 1 to 12 or -1 for error\r\n" +
" SubDay 1 to 99 or -1 for error\r\n" +
"\r\n" +
" RETURNS: FUNCTION Returns true if the date is successfully\r\n" +
" divided or false if a DOS error occurs\r\n" +
" or a value is \"grossly\" out of range\r\n" +
"\r\n" +
" LOCAL: SubDayStr Local string used to identify day\r\n" +
" SubMonthStr Local string used to identify month\r\n" +
" SubYearStr Local string used to identify year\r\n" +
" Code Error return for string to integer\r\n" +
" conversion. Any non-zero value\r\n" +
" indicates an error\r\n" +
" IsValid Local flag for date validity\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" SubDayStr :string[2];\r\n" +
" SubMonthStr :string[3];\r\n" +
" SubYearStr :string[2];\r\n" +
" Code :integer;\r\n" +
" IsValid :boolean;\r\n" +
"\r\n" +
"begin { function DivideUniversalDate }\r\n" +
" IsValid := true;\r\n" +
" SubYearStr := copy(UniversalDate , 6 , 2);\r\n" +
" if (SubYearStr = ' ') then\r\n" +
" SubYear := -1\r\n" +
" else\r\n" +
" begin\r\n" +
" val(SubYearStr , SubYear , Code);\r\n" +
" if (Code <> 0) or (SubYear < 0) then\r\n" +
" IsValid := false;\r\n" +
" end; { else }\r\n" +
" SubMonthStr := copy(UniversalDate , 3 , 3);\r\n" +
" if (SubMonthStr = ' ') then\r\n" +
" SubMonth := -1\r\n" +
" else if (SubMonthStr = 'JAN') then\r\n" +
" SubMonth := 1\r\n" +
" else if (SubMonthStr = 'FEB') then\r\n" +
" SubMonth := 2\r\n" +
" else if (SubMonthStr = 'MAR') then\r\n" +
" SubMonth := 3\r\n" +
" else if (SubMonthStr = 'APR') then\r\n" +
" SubMonth := 4\r\n" +
" else if (SubMonthStr = 'MAY') then\r\n" +
" SubMonth := 5\r\n" +
" else if (SubMonthStr = 'JUN') then\r\n" +
" SubMonth := 6\r\n" +
" else if (SubMonthStr = 'JUL') then\r\n" +
" SubMonth := 7\r\n" +
" else if (SubMonthStr = 'AUG') then\r\n" +
" SubMonth := 8\r\n" +
" else if (SubMonthStr = 'SEP') then\r\n" +
" SubMonth := 9\r\n" +
" else if (SubMonthStr = 'OCT') then\r\n" +
" SubMonth := 10\r\n" +
" else if (SubMonthStr = 'NOV') then\r\n" +
" SubMonth := 11\r\n" +
" else if (SubMonthStr = 'DEC') then\r\n" +
" SubMonth := 12\r\n" +
" else\r\n" +
" IsValid := false;\r\n" +
" SubDayStr := copy(UniversalDate , 1 , 2);\r\n" +
" if (SubDayStr = ' ') then\r\n" +
" IsValid := false\r\n" +
" else\r\n" +
" begin\r\n" +
" val(SubDayStr , SubDay , Code);\r\n" +
" if (Code <> 0) or (SubDay < 1) or (SubDay > 31) then\r\n" +
" IsValid := false;\r\n" +
" end; { else }\r\n" +
" DivideUniversalDate := IsValid;\r\n" +
"end; { function DivideUniversalDate }\r\n" +
"\r\n" +
"{** BuildUniversalDate * 02-17-95 ****************************************}\r\n" +
"\r\n" +
"function BuildUniversalDate\r\n" +
" (\r\n" +
" var UniversalDate :UniversalDateType;\r\n" +
" var SubYear :integer;\r\n" +
" var SubMonth :integer;\r\n" +
" var SubDay :integer\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: BuildUniversalDate converts a date in the form of three\r\n" +
" integer components (95, 1, 5) into the date '05JAN95'.\r\n" +
" The procedure does not perform any error checking and\r\n" +
" expects all three passed integer fields to be included\r\n" +
" and valid.\r\n" +
"\r\n" +
" PARAMETERS: UniversalDate Date in the format DDMMMYY - '05JAN95'\r\n" +
" SubYear 0 to 99 - no check performed\r\n" +
" SubMonth 1 to 12 - no check performed\r\n" +
" SubDay 1 to 31 - no check performed\r\n" +
"\r\n" +
" RETURNS: FUNCTION True for valid date, false for invalid\r\n" +
" date\r\n" +
"\r\n" +
" LOCAL: SubYearStr String version of year - '95'\r\n" +
" SubMonthStr String version of month - 'JAN'\r\n" +
" SubDayStr String version of day - '05'\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" SubYearStr :string;\r\n" +
" SubMonthStr :string;\r\n" +
" SubDayStr :string;\r\n" +
"\r\n" +
"begin { function BuildUniversalDate }\r\n" +
" str(SubYear :2 , SubYearStr);\r\n" +
" if (SubYearStr[1] = ' ') then\r\n" +
" SubYearStr[1] := '0';\r\n" +
" case (SubMonth) of\r\n" +
" 1 :SubMonthStr := 'JAN';\r\n" +
" 2 :SubMonthStr := 'FEB';\r\n" +
" 3 :SubMonthStr := 'MAR';\r\n" +
" 4 :SubMonthStr := 'APR';\r\n" +
" 5 :SubMonthStr := 'MAY';\r\n" +
" 6 :SubMonthStr := 'JUN';\r\n" +
" 7 :SubMonthStr := 'JUL';\r\n" +
" 8 :SubMonthStr := 'AUG';\r\n" +
" 9 :SubMonthStr := 'SEP';\r\n" +
" 10 :SubMonthStr := 'OCT';\r\n" +
" 11 :SubMonthStr := 'NOV';\r\n" +
" 12 :SubMonthStr := 'DEC';\r\n" +
" end; { case }\r\n" +
" str(SubDay :2 , SubDayStr);\r\n" +
" if (SubDayStr[1] = ' ') then\r\n" +
" SubDayStr[1] := '0';\r\n" +
" UniversalDate := SubDayStr + SubMonthStr + SubYearStr;\r\n" +
" BuildUniversalDate := CheckDDMMMYYDate(UniversalDate);\r\n" +
"end; { function BuildUniversalDate }\r\n" +
"\r\n" +
"{** 11-04-98 * CompleteDate **********************************************}\r\n" +
"\r\n" +
"function CompleteDate\r\n" +
" (\r\n" +
" var ReferenceDate :UniversalDateType;\r\n" +
" var PartialDate :UniversalDateType\r\n" +
" )\r\n" +
" :boolean;\r\n" +
"\r\n" +
"{ FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: CompleteDate compares information from a partial date to\r\n" +
" a reference date which is expected to be near the partial\r\n" +
" date. The procedure then makes a best guess as the\r\n" +
" complete form of the partial date. For example, a partial\r\n" +
" date of '26 ' with a reference date of '05JAN95' will\r\n" +
" produce a date of 26DEC94.\r\n" +
"\r\n" +
" Notes: The reference date must be a complete valid date.\r\n" +
" The partial date must include at least a day.\r\n" +
"\r\n" +
" PARAMETERS: ReferenceDate Date in the format DDMMMYY - '05JAN95'\r\n" +
" PartialDate Partial date, format DDMMMYY - '04JAN '\r\n" +
"\r\n" +
" RETURNS: FUNCTION The function returns true if a\r\n" +
" valid (though not necessarily\r\n" +
" correct) date is created from\r\n" +
" the partial and reference dates.\r\n" +
"\r\n" +
" LOCAL: ReferenceYear Integer year for reference date\r\n" +
" ReferenceMonth Integer month for reference date\r\n" +
" ReferenceDay Integer day for reference date\r\n" +
" PartialYear Integer year for partial date\r\n" +
" PartialMonth Integer month for partial date\r\n" +
" PartailDay Integer day for partial date\r\n" +
" IsValid Local funciton success flag\r\n" +
"\r\n" +
"--------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" ReferenceYear :integer;\r\n" +
" ReferenceMonth :integer;\r\n" +
" ReferenceDay :integer;\r\n" +
" PartialYear :integer;\r\n" +
" PartialMonth :integer;\r\n" +
" PartialDay :integer;\r\n" +
" IsValid :boolean;\r\n" +
"\r\n" +
"begin { function CompleteDate }\r\n" +
"\r\n" +
" IsValid := true;\r\n" +
"\r\n" +
" if (not CheckDDMMMYYDate(PartialDate)) then\r\n" +
" if (CheckDDMMMYYDate(ReferenceDate)) then\r\n" +
" begin\r\n" +
" if (DivideUniversalDate(ReferenceDate , ReferenceYear ,\r\n" +
" ReferenceMonth , ReferenceDay)) and\r\n" +
" (DivideUniversalDate(PartialDate , PartialYear ,\r\n" +
" PartialMonth , PartialDay)) then\r\n" +
" begin\r\n" +
" if (ReferenceDay = PartialDay) and\r\n" +
" (PartialMonth = -1) then\r\n" +
" begin\r\n" +
" PartialYear := ReferenceYear;\r\n" +
" PartialMonth := ReferenceMonth;\r\n" +
" end { if }\r\n" +
" else if (ReferenceMonth = 12) and (PartialMonth = 1) then\r\n" +
" PartialYear := ReferenceYear + 1\r\n" +
" else if (ReferenceMonth = 1) and (PartialMonth = 12) then\r\n" +
" PartialYear := ReferenceYear - 1\r\n" +
" else if (PartialMonth = -1) then\r\n" +
" begin\r\n" +
" if (Abs(ReferenceDay - PartialDay) <= 14) then\r\n" +
" begin\r\n" +
" PartialMonth := ReferenceMonth;\r\n" +
" PartialYear := ReferenceYear;\r\n" +
" end { if }\r\n" +
" else if (ReferenceDay > PartialDay) then\r\n" +
" begin\r\n" +
" PartialMonth := ReferenceMonth + 1;\r\n" +
" if (PartialMonth > 12) then\r\n" +
" begin\r\n" +
" PartialMonth := 1;\r\n" +
" PartialYear := ReferenceYear + 1;\r\n" +
" end { if }\r\n" +
" else\r\n" +
" PartialYear := ReferenceYear;\r\n" +
" end { else }\r\n" +
" else { ReferenceDay < PartialDay }\r\n" +
" begin\r\n" +
" PartialMonth := ReferenceMonth - 1;\r\n" +
" if (PartialMonth < 1) then\r\n" +
" begin\r\n" +
" PartialMonth := 12;\r\n" +
" PartialYear := ReferenceYear - 1;\r\n" +
" end { if }\r\n" +
" else\r\n" +
" PartialYear := ReferenceYear;\r\n" +
" end; { else }\r\n" +
" end { if }\r\n" +
" else\r\n" +
" PartialYear := ReferenceYear;\r\n" +
" IsValid := BuildUniversalDate\r\n" +
" (PartialDate , PartialYear , PartialMonth , PartialDay);\r\n" +
" end { if }\r\n" +
" else\r\n" +
" IsValid := false;\r\n" +
" end { if }\r\n" +
" else\r\n" +
" IsValid := false;\r\n" +
"\r\n" +
" CompleteDate := IsValid;\r\n" +
"\r\n" +
"end; { function CompleteDate }\r\n" +
"\r\n" +
"{** 07-30-98 * SecondsSinceMidnight **************************************}\r\n" +
"\r\n" +
"function SecondsSinceMidnight :longint;\r\n" +
"\r\n" +
"var\r\n" +
" Hours :word;\r\n" +
" Minutes :word;\r\n" +
" Seconds :word;\r\n" +
" Sec1000 :word;\r\n" +
"\r\n" +
" lHours :longint;\r\n" +
" lMinutes :longint;\r\n" +
" lSeconds :longint;\r\n" +
"\r\n" +
"begin { function SecondSinceMidnight }\r\n" +
"\r\n" +
" decodetime(GetUTCTime , Hours , Minutes , Seconds , Sec1000);\r\n" +
"\r\n" +
" lHours := Hours;\r\n" +
" lMinutes := Minutes;\r\n" +
" lSeconds := Seconds;\r\n" +
"\r\n" +
" SecondsSinceMidnight := (lHours * SEC_PER_HR) +\r\n" +
" (lMinutes * SEC_PER_MIN) +\r\n" +
" lSeconds;\r\n" +
"\r\n" +
"end; { function SecondSinceMidnight }\r\n" +
"\r\n" +
"{** GetUniversalTime * 07-30-98 ******************************************}\r\n" +
"\r\n" +
"function GetUniversalTime :UniversalTimeType;\r\n" +
"var\r\n" +
" Hours , Minutes , Seconds :string[3];\r\n" +
" wHours , wMinutes , wSeconds , wSec1000 :word;\r\n" +
"begin\r\n" +
" decodetime(GetUTCTime , wHours , wMinutes , wSeconds , wSec1000);\r\n" +
" str((wHours + 100) :3 , Hours);\r\n" +
" str((wMinutes + 100) :3 , Minutes);\r\n" +
" str((wSeconds + 100) :3 , Seconds);\r\n" +
" GetUniversalTime := copy(Hours , 2 , 2) + copy(Minutes , 2 , 2) + copy(Seconds , 2 , 2);\r\n" +
"end; {GetUniversalTime }\r\n" +
"\r\n" +
"{** GetUniversalTimeMS * 01-04-02 ******************************************}\r\n" +
"\r\n" +
"function GetUniversalTimeMS :UniversalTimeTypeMS;\r\n" +
"var\r\n" +
" Hours , Minutes , Seconds :string[3];\r\n" +
" MSSeconds :string[4];\r\n" +
" wHours , wMinutes , wSeconds , wSec1000 :word;\r\n" +
"begin\r\n" +
" decodetime(GetUTCTime , wHours , wMinutes , wSeconds , wSec1000);\r\n" +
" str((wHours + 100) :3 , Hours);\r\n" +
" str((wMinutes + 100) :3 , Minutes);\r\n" +
" str((wSeconds + 100) :3 , Seconds);\r\n" +
" str((wSec1000 + 1000) :4 , MSSeconds);\r\n" +
" GetUniversalTimeMS := copy(Hours , 2 , 2) + copy(Minutes , 2 , 2)\r\n" +
" + copy(Seconds , 2 , 2) + copy(MSSeconds , 2 , 3);\r\n" +
"end; {GetUniversalTimeMS }\r\n" +
"\r\n" +
"{** 08-05-98 * GetUniversalDate *******************************************}\r\n" +
"\r\n" +
"function GetUniversalDate :UniversalDateType;\r\n" +
"begin\r\n" +
" Result := ConvertDateTimeToUniversalDate(GetUTCDateTime());\r\n" +
" if FTestDate <> '' then\r\n" +
" Result := FTestDate;\r\n" +
"end; {GetUniversalDate }\r\n" +
"\r\n" +
"function GetCrewDate(RefDateTime: TDateTime = 0) :CrewDateType;\r\n" +
"var\r\n" +
" S: AnsiString;\r\n" +
"begin\r\n" +
" if RefDateTime = 0 then\r\n" +
" RefDateTime := GetUTCDateTime;\r\n" +
" S := FormatDateTime('YYYYMMDD', RefDateTime);\r\n" +
" Move(S[1], Result, Length(S));\r\n" +
"end; {GetCrewDate }\r\n" +
"\r\n" +
"function GetUniversalYear :string;\r\n" +
"var\r\n" +
" wYear , wMonth , wDay :word;\r\n" +
" Year :string[4];\r\n" +
"begin\r\n" +
" decodedate(GetUTCDateTime , wYear , wMonth , wDay);\r\n" +
" str(wYear , Year);\r\n" +
" GetUniversalYear := Year;\r\n" +
"end; {GetUniversalYear}\r\n" +
"\r\n" +
"function AddCenturyToYear(YearOfCentury :string) :string;\r\n" +
"{Adds the appropriate 2 digit century prefix to a 2 digit year}\r\n" +
"var\r\n" +
" Century :string[2];\r\n" +
" CurrentNYear :string[2];\r\n" +
" Year :string[4];\r\n" +
" NCentury :integer;\r\n" +
" rc :integer;\r\n" +
"\r\n" +
"begin\r\n" +
" Year := GetUniversalYear;\r\n" +
" if YearOfCentury = copy(Year , 3 , 2) then\r\n" +
" AddCenturyToYear := Year\r\n" +
" else\r\n" +
" begin\r\n" +
" CurrentNYear := copy(Year , 3 , 2);\r\n" +
" val(copy(Year , 1 , 2) , NCentury , rc);\r\n" +
" if YearOfCentury > '75' then\r\n" +
" begin\r\n" +
" if CurrentNYear < '25' then\r\n" +
" dec(NCentury);\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if (YearOfCentury < '25')\r\n" +
" and (CurrentNYear > '75') then\r\n" +
" inc(NCentury);\r\n" +
" end;\r\n" +
" Century := Int2FullStr(NCentury , 2);\r\n" +
" AddCenturyToYear := Century + YearOfCentury\r\n" +
" end; //else not current year\r\n" +
"end; {AddCenturytoYear}\r\n" +
"\r\n" +
"{** 04-23-97 * NumericDate ***********************************************}\r\n" +
"\r\n" +
"function IsValidInteger(S: String): Boolean;\r\n" +
"var\r\n" +
" Value: Integer;\r\n" +
"begin\r\n" +
" Result := TryStrToInt(S, Value);\r\n" +
"end;\r\n" +
"\r\n" +
"function NumericDate\r\n" +
" (\r\n" +
" const iDate :UniversalDateType\r\n" +
" )\r\n" +
" :NumericDateType;\r\n" +
"\r\n" +
" { if s = '00XXX00' the function will set the date to the maximum\r\n" +
" date allowed with this logic - MAY 15, 9999 }\r\n" +
"\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" NCentury , NYear , NMonth , NDay :ShortInt;\r\n" +
" Year :string[4];\r\n" +
" s :UniversalDateType;\r\n" +
"begin { function NumericDate }\r\n" +
" if (iDate = '00XXX00') then\r\n" +
" begin\r\n" +
" NCentury := 99;\r\n" +
" NYear := 99;\r\n" +
" NMonth := 05;\r\n" +
" NDay := 15;\r\n" +
" end { if }\r\n" +
" else\r\n" +
" begin\r\n" +
" s := iDate;\r\n" +
" if not ValidateDate(s) then\r\n" +
" begin\r\n" +
" NCentury := 0;\r\n" +
" NYear := 0;\r\n" +
" NMonth := 0;\r\n" +
" NDay := 0;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" NMonth := 0;\r\n" +
" for i := 1 to 12 do\r\n" +
" if copy(s , 3 , 3) = AlphaMonths[i] then\r\n" +
" NMonth := i;\r\n" +
" val(copy(s , 1 , 2) , NDay , i);\r\n" +
" if i <> 0 then\r\n" +
" NDay := 0;\r\n" +
" if not IsValidInteger(copy(s , 6 , 2)) then\r\n" +
" begin\r\n" +
" NYear := 0;\r\n" +
" NCentury := 0;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" Year := AddCenturyToYear(copy(s , 6 , 2));\r\n" +
" val(copy(Year , 1 , 2) , NCentury , i);\r\n" +
" val(copy(Year , 3 , 2) , NYear , i);\r\n" +
" end;\r\n" +
" if (NMonth = 0)\r\n" +
" or (NDay = 0) then\r\n" +
" NCentury := 0;\r\n" +
" end; // valid date\r\n" +
" end; // not 00XXX00\r\n" +
"\r\n" +
" NumericDate := chr(NCentury) + chr(NYear) + chr(NMonth) + chr(NDay);\r\n" +
"end; { function NumericDate }\r\n" +
"\r\n" +
"function ValidateDate(var s :string) :boolean;\r\n" +
"var\r\n" +
" mm , dd , yy , i :integer;\r\n" +
" wDate :UniversalDateType;\r\n" +
"begin\r\n" +
" Result := True;\r\n" +
" if (s = '00XXX00') then\r\n" +
" EXIT;\r\n" +
" wDate := GetUniversalDate;\r\n" +
" mm := 0;\r\n" +
" i := 1;\r\n" +
" s := JustData(s);\r\n" +
" while (i <= 12) and\r\n" +
" (pos(AlphaMonths[i] , s) = 0) do\r\n" +
" inc(i);\r\n" +
" if i <= 12 then\r\n" +
" begin\r\n" +
" mm := i;\r\n" +
" i := pos(AlphaMonths[i] , s);\r\n" +
" if i < 3 then\r\n" +
" s := '0' + s;\r\n" +
" if length(s) < 7 then\r\n" +
" s := s + copy(wDate , 6 , 2);\r\n" +
" end //valid month found\r\n" +
" else\r\n" +
" Result := false;\r\n" +
" val(copy(s , 1 , 2) , dd , i);\r\n" +
" if i <> 0 then\r\n" +
" Result := false;\r\n" +
" if dd < 1 then\r\n" +
" Result := false;\r\n" +
" val(copy(s , 6 , 2) , yy , i);\r\n" +
" if yy < 0 then\r\n" +
" Result := false;\r\n" +
" if i <> 0 then\r\n" +
" Result := false;\r\n" +
" case mm of\r\n" +
" 1 , 3 , 5 , 7 , 8 , 10 , 12\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 31 then\r\n" +
" Result := false;\r\n" +
" end;\r\n" +
" 4 , 6 , 9 , 11\r\n" +
" :\r\n" +
" begin\r\n" +
" if dd > 30 then\r\n" +
" Result := false;\r\n" +
" end;\r\n" +
" 2\r\n" +
" :\r\n" +
" begin\r\n" +
" if LeapYear(yy) then\r\n" +
" begin\r\n" +
" if dd > 29 then\r\n" +
" Result := false;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if dd > 28 then\r\n" +
" Result := false;\r\n" +
" end;\r\n" +
" end;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"function ValidateTime(s :string): Boolean;\r\n" +
"begin\r\n" +
" Result := True;\r\n" +
" if (s[1] < '0')\r\n" +
" or (s[1] > '2') then\r\n" +
" Result := false;\r\n" +
" if (s[2] < '0')\r\n" +
" or (s[2] > '9') then\r\n" +
" Result := false;\r\n" +
" if (s[1] = '2')\r\n" +
" and (s[2] > '3') then\r\n" +
" Result := false;\r\n" +
" if (s[3] < '0')\r\n" +
" or (s[3] > '5') { was 'and' should be 'or' ktj 5/1/96 } then\r\n" +
" Result := false;\r\n" +
" if (s[4] < '0')\r\n" +
" or (s[4] > '9') { was 'and' should be 'or' ktj 5/1/96 } then\r\n" +
" Result := false;\r\n" +
"end;\r\n" +
"\r\n" +
"function ValidateGMTVariance(s :string): Boolean;\r\n" +
"begin\r\n" +
" Result := True;\r\n" +
" if (s[1] <> ' ')\r\n" +
" and (s[1] <> '+')\r\n" +
" and (s[1] <> '-') then\r\n" +
" Result := false;\r\n" +
" if (s[2] < '0')\r\n" +
" or (s[2] > '1') then\r\n" +
" Result := false;\r\n" +
" if (s[3] < '0')\r\n" +
" or (s[3] > '9') then\r\n" +
" Result := false;\r\n" +
" if (s[2] = '1')\r\n" +
" and (s[3] > '4') {3 instead of 2 to allow for DST at Dateline} {now 4 for Tonga} then\r\n" +
" Result := false;\r\n" +
" if (s[4] < '0')\r\n" +
" and (s[4] > '5') then\r\n" +
" Result := false;\r\n" +
" if (s[5] < '0')\r\n" +
" and (s[5] > '9') then\r\n" +
" Result := false;\r\n" +
"end; {ValidateGMTVariance}\r\n" +
" {unit DateTime}\r\n" +
"\r\n" +
"function ValidateDateChange(s :string): Boolean;\r\n" +
"begin\r\n" +
" Result := True;\r\n" +
" if (s[1] <> ' ')\r\n" +
" and (s[1] <> '+')\r\n" +
" and (s[1] <> '-') then\r\n" +
" Result := false;\r\n" +
" if s[2] <> ' ' then\r\n" +
" begin\r\n" +
" if (s[2] < '0')\r\n" +
" or (s[2] > '2') then\r\n" +
" Result := false;\r\n" +
" end;\r\n" +
"end; {ValidateDateChange}\r\n" +
"\r\n" +
"function ValidateDailyFrequency(s :string): Boolean;\r\n" +
"var\r\n" +
" i ,\r\n" +
" FirstBlank :integer;\r\n" +
" PreviousChar :char;\r\n" +
"begin\r\n" +
" Result := True;\r\n" +
" FirstBlank := pos(' ' , s);\r\n" +
" if FirstBlank = 0 then\r\n" +
" FirstBlank := 8;\r\n" +
" if s[1] = 'X' then\r\n" +
" i := 2\r\n" +
" else\r\n" +
" i := 1;\r\n" +
" PreviousChar := '0';\r\n" +
" while i < FirstBlank do\r\n" +
" begin\r\n" +
" if (s[i] <= PreviousChar)\r\n" +
" or (s[i] > '7') then\r\n" +
" Result := false;\r\n" +
" PreviousChar := s[i];\r\n" +
" inc(i);\r\n" +
" end;\r\n" +
" while i <= 7 do\r\n" +
" begin\r\n" +
" if s[i] <> ' ' then\r\n" +
" Result := false;\r\n" +
" inc(i);\r\n" +
" end;\r\n" +
"end; {ValidateDailyFrequency}\r\n" +
" {unit DateTime}\r\n" +
"\r\n" +
"function LeapYear(YearAD :integer) :boolean;\r\n" +
"begin\r\n" +
" if YearAD < 100 then\r\n" +
" YearAD := Str2Int(AddCenturyToYear(Int2FullStr(YearAD , 2)));\r\n" +
" if copy(Int2IntStr(YearAD , 4) , 3 , 2) = '00' then\r\n" +
" begin\r\n" +
" if (YearAD mod 400) = 0 then\r\n" +
" LeapYear := true\r\n" +
" else\r\n" +
" LeapYear := false;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if (YearAD mod 4) = 0 then\r\n" +
" LeapYear := true\r\n" +
" else\r\n" +
" LeapYear := false;\r\n" +
" end;\r\n" +
"end; {LeapYear}\r\n" +
"\r\n" +
"function JulianDay(DateNumeric :string) :longint;\r\n" +
"var\r\n" +
" Century , Year , Month , DayOfMonth :integer;\r\n" +
" YearsAD , DayOfYear :longint;\r\n" +
"begin\r\n" +
" JulianDay := 0;\r\n" +
" Century := ord(DateNumeric[1]);\r\n" +
" Year := ord(DateNumeric[2]);\r\n" +
" Month := ord(DateNumeric[3]);\r\n" +
" DayOfMonth := ord(DateNumeric[4]);\r\n" +
" if (Month < 1) or (Month > 12) then\r\n" +
" EXIT;\r\n" +
" if (DayOfMonth < 1) or (DayOfMonth > 31) then\r\n" +
" EXIT;\r\n" +
" YearsAD := (Century * 100) + (Year - 1);\r\n" +
" if (Month > 2)\r\n" +
" and (LeapYear(YearsAD + 1)) then\r\n" +
" DayOfYear := AnnualDaysToMonth[Month] + DayOfMonth + 1\r\n" +
" else\r\n" +
" DayOfYear := AnnualDaysToMonth[Month] + DayOfMonth;\r\n" +
" JulianDay := DayOfYear;\r\n" +
"end; {JulianDay}\r\n" +
"\r\n" +
"function DayAD(DateNumeric :string) :longint;\r\n" +
"var\r\n" +
" Century , Year , Month , DayOfMonth :integer;\r\n" +
" YearsAD , DayOfYear :longint;\r\n" +
"begin\r\n" +
" DayAD := 1;\r\n" +
" Century := ord(DateNumeric[1]);\r\n" +
" Year := ord(DateNumeric[2]);\r\n" +
" Month := ord(DateNumeric[3]);\r\n" +
" DayOfMonth := ord(DateNumeric[4]);\r\n" +
" if (Month < 1) or (Month > 12) then\r\n" +
" EXIT;\r\n" +
" if (DayOfMonth < 1) or (DayOfMonth > 31) then\r\n" +
" EXIT;\r\n" +
" YearsAD := (Century * 100) + (Year - 1);\r\n" +
" if (Month > 2)\r\n" +
" and (LeapYear(YearsAD + 1)) then\r\n" +
" DayOfYear := AnnualDaysToMonth[Month] + DayOfMonth + 1\r\n" +
" else\r\n" +
" DayOfYear := AnnualDaysToMonth[Month] + DayOfMonth;\r\n" +
" DayAD := (YearsAD * 365)\r\n" +
" + (YearsAD div 4) {number of leap years}\r\n" +
" + DayOfYear;\r\n" +
"end; {DayAD}\r\n" +
"\r\n" +
"function DayOfWeekAD(DayAD :longint) :shortint;\r\n" +
"begin\r\n" +
" DayOfWeekAD := ((DayAD - 2) mod 7) + 1;\r\n" +
"end; {DayOfWeekAD}\r\n" +
"\r\n" +
"function DayOfWeekAlpha(DayOfWeek :shortint) :string;\r\n" +
"begin\r\n" +
" DayOfWeekAlpha := AlphaDaysOfWeek[DayOfWeek];\r\n" +
"end; {DayOfWeekAlpha}\r\n" +
"\r\n" +
"function NumericDayOfWeek(Date :TDateTime) :integer;\r\n" +
"var\r\n" +
" DayOfWeek :string;\r\n" +
" I :integer;\r\n" +
"\r\n" +
"begin\r\n" +
" try //if FormatDateTime throws an exception\r\n" +
" DayOfWeek := FormatDateTime('ddd' , Date);\r\n" +
" result := 0; //no match\r\n" +
" for I := 1 to 7 do\r\n" +
" begin\r\n" +
" if (UpperCase(DayOfWeek) = AlphaDaysOfWeek[I]) then\r\n" +
" begin\r\n" +
" result := I;\r\n" +
" break;\r\n" +
" end;\r\n" +
" end;\r\n" +
" except\r\n" +
" result := -1; //bad day of week\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"function DayADToDate(DayAD :longint) :string;\r\n" +
"var\r\n" +
" DaysOverQuad , YearsOverQuad , YearAD , i ,\r\n" +
" Month , DayOfMonth :integer;\r\n" +
" DayOfYear , Quad :longint;\r\n" +
" DayString , YearString :string[5];\r\n" +
"begin\r\n" +
" DayADToDate := ' ';\r\n" +
" Month := 0;\r\n" +
" if (DayAD < 1461) or (DayAD > 2000000) then\r\n" +
" EXIT;\r\n" +
" Quad := (DayAD - 1) div 1461;\r\n" +
" DaysOverQuad := DayAD mod 1461;\r\n" +
" if DaysOverQuad = 0 then\r\n" +
" YearsOverQuad := 3\r\n" +
" else\r\n" +
" YearsOverQuad := (DaysOverQuad - 1) div 365;\r\n" +
" YearAD := Quad * 4\r\n" +
" + YearsOverQuad\r\n" +
" + 1;\r\n" +
" DayOfYear := DayAD\r\n" +
" - Quad * 1461\r\n" +
" - YearsOverQuad * 365;\r\n" +
" if DayOfYear = 60 then\r\n" +
" begin\r\n" +
" if LeapYear(YearAD) then\r\n" +
" begin\r\n" +
" Month := 2;\r\n" +
" DayOfMonth := 29;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" Month := 3;\r\n" +
" DayOfMonth := 1;\r\n" +
" end;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if LeapYear(YearAD)\r\n" +
" and (DayOfYear > 60) then\r\n" +
" DayOfYear := DayOfYear - 1;\r\n" +
" for i := 1 to 12 do\r\n" +
" begin\r\n" +
" if DayOfYear > AnnualDaysToMonth[i] then\r\n" +
" Month := i;\r\n" +
" end;\r\n" +
" DayOfMonth := DayOfYear - AnnualDaysToMonth[Month];\r\n" +
" end;\r\n" +
" str(YearAD :5 , YearString);\r\n" +
" str((DayOfMonth + 1000) :5 , DayString);\r\n" +
" DayADToDate := copy(DayString , 4 , 2)\r\n" +
" + AlphaMonths[Month]\r\n" +
" + copy(YearString , 4 , 2);\r\n" +
"end; {DayADToDate}\r\n" +
"\r\n" +
"function NumericMonth(Month :string) :shortint;\r\n" +
"var\r\n" +
" i :integer;\r\n" +
"begin\r\n" +
" NumericMonth := 0;\r\n" +
" for i := 1 to 12 do\r\n" +
" if Month = AlphaMonths[i] then\r\n" +
" NumericMonth := i;\r\n" +
"end;\r\n" +
"\r\n" +
"function AlphaMonth(MonthNumeric :shortint) :string;\r\n" +
"begin\r\n" +
" if (MonthNumeric < 13) and\r\n" +
" (MonthNumeric > 0) then\r\n" +
" AlphaMonth := AlphaMonths[MonthNumeric]\r\n" +
" else\r\n" +
" AlphaMonth := 'UNK';\r\n" +
"end;\r\n" +
"\r\n" +
"function TimeToMinutes(Time :string) :integer;\r\n" +
"var\r\n" +
" NumHours , NumMinutes , rc :integer;\r\n" +
"begin\r\n" +
" if Time[1] = ' ' then\r\n" +
" Time[1] := '0';\r\n" +
" if Time[2] = ' ' then\r\n" +
" Time[2] := '0';\r\n" +
" if Time[3] = ' ' then\r\n" +
" Time[3] := '0';\r\n" +
" if Time[4] = ' ' then\r\n" +
" Time[4] := '0';\r\n" +
" val(copy(Time , 1 , 2) , NumHours , rc);\r\n" +
" val(copy(Time , 3 , 2) , NumMinutes , rc);\r\n" +
" TimeToMinutes := NumHours * MIN_PER_HR + NumMinutes;\r\n" +
"end; {TimeToMinutes}\r\n" +
"\r\n" +
"function MinutesToTime(Minutes :integer) :string;\r\n" +
"var\r\n" +
" NumHours , NumMinutes :integer;\r\n" +
" CorrectedMinutes :integer;\r\n" +
" wTime :string[6];\r\n" +
"begin\r\n" +
" if (Minutes > 1440) then\r\n" +
" CorrectedMinutes := Minutes - 1440\r\n" +
" else\r\n" +
" CorrectedMinutes := Minutes;\r\n" +
" NumHours := CorrectedMinutes div MIN_PER_HR;\r\n" +
" NumMinutes := CorrectedMinutes mod MIN_PER_HR;\r\n" +
" if (NumHours = 24) and (NumMinutes = 0) then\r\n" +
" NumHours := 0;\r\n" +
" { Make sure it is left justified with zeros... }\r\n" +
" str((NumHours * 100 + NumMinutes + 10000) :6 , wTime);\r\n" +
" MinutesToTime := copy(wTime , 3 , 4);\r\n" +
"end; {MinutesToTime}\r\n" +
"\r\n" +
"function MinutesToTime5H(Minutes :LongInt) :string;\r\n" +
"var\r\n" +
" NumHours , NumMinutes :LongInt;\r\n" +
" wTime :string[9];\r\n" +
"begin\r\n" +
" NumHours := Minutes div MIN_PER_HR;\r\n" +
" NumMinutes := Minutes mod MIN_PER_HR;\r\n" +
" if (NumHours = 24) and (NumMinutes = 0) then\r\n" +
" NumHours := 0;\r\n" +
" { Make sure it is left justified with zeros... }\r\n" +
" str((NumHours * 100 + NumMinutes + 100000000) :9 , wTime);\r\n" +
" MinutesToTime5H := copy(wTime , 3 , 7);\r\n" +
"end; {MinutesToTime5H}\r\n" +
"\r\n" +
"function SecondsToTime(Seconds :integer) :string;\r\n" +
"var\r\n" +
" NumHours , NumMinutes , NumSeconds :integer;\r\n" +
" CorrectedSeconds :integer;\r\n" +
" SecondsRemaining :integer;\r\n" +
" wTime :string[8];\r\n" +
"begin\r\n" +
" if (Seconds > SEC_PER_DAY) then\r\n" +
" CorrectedSeconds := Seconds - SEC_PER_DAY\r\n" +
" else\r\n" +
" CorrectedSeconds := Seconds;\r\n" +
" NumHours := CorrectedSeconds div SEC_PER_HR;\r\n" +
" SecondsRemaining := CorrectedSeconds mod SEC_PER_HR;\r\n" +
" NumMinutes := SecondsRemaining div SEC_PER_MIN;\r\n" +
" NumSeconds := SecondsRemaining mod SEC_PER_MIN;\r\n" +
" if (NumHours = 24) and (NumMinutes = 0) and (NumSeconds = 0) then\r\n" +
" NumHours := 0;\r\n" +
" { Make sure it is left justified with zeros... }\r\n" +
" str(((NumHours * 10000) + (NumMinutes * 100) + NumSeconds + 10000000) :8 , wTime);\r\n" +
" SecondsToTime := copy(wTime , 3 , 6);\r\n" +
"end; {SecondsToTime}\r\n" +
"\r\n" +
"function GMTMinuteAD(NumericLocalDate\r\n" +
" , LocalTime\r\n" +
" , GMTVariance\r\n" +
" , DateChange :string) :longint;\r\n" +
"var\r\n" +
" Accumulator :longint;\r\n" +
" ReturnCode :integer;\r\n" +
"begin\r\n" +
" val(DateChange , Accumulator , ReturnCode);\r\n" +
" if ReturnCode = 0 then\r\n" +
" Accumulator := DayAD(NumericLocalDate) + Accumulator\r\n" +
" else\r\n" +
" Accumulator := DayAD(NumericLocalDate);\r\n" +
" Accumulator := Accumulator * MIN_PER_DAY\r\n" +
" + TimeToMinutes(LocalTime);\r\n" +
" if GMTVariance[1] = '-' then\r\n" +
" GMTMinuteAD := Accumulator + TimeToMinutes(copy(GMTVariance , 2 , 4))\r\n" +
" else\r\n" +
" GMTMinuteAD := Accumulator - TimeToMinutes(copy(GMTVariance , 2 , 4));\r\n" +
"end; {GMTMinuteAD}\r\n" +
"\r\n" +
"function MinAdToTime(i :longint) :string;\r\n" +
"begin\r\n" +
" Result := MinutesToTime(i mod MIN_PER_DAY);\r\n" +
" if (ValidEAGLETime(Result) = false) then\r\n" +
" Result := ' ';\r\n" +
"end; // MinAdToTime\r\n" +
"\r\n" +
"function MinAdToDate(i: longint; var ivIsOK: Boolean): string;\r\n" +
"begin\r\n" +
" Result := DayAdToDate(i div MIN_PER_DAY);\r\n" +
" ivIsOK := ValidateDate(Result);\r\n" +
" if (not ivIsOK) then\r\n" +
" Result := ' ';\r\n" +
"end; // MinAdToTime\r\n" +
"\r\n" +
"function MinAdToDate(i: longint): string;\r\n" +
"var\r\n" +
" vIsOK: Boolean;\r\n" +
"begin\r\n" +
" Result := MinAdToDate(i, vIsOK);\r\n" +
"end;\r\n" +
"\r\n" +
"procedure CalculateNextMonth(Date :string;\r\n" +
" var NextMonth , Year :string);\r\n" +
"var\r\n" +
" NMonth , NYear , i :integer;\r\n" +
"begin\r\n" +
" NMonth := 0;\r\n" +
" for i := 1 to 12 do\r\n" +
" if copy(Date , 3 , 3) = AlphaMonths[i] then\r\n" +
" NMonth := i;\r\n" +
" if NMonth = 0 then\r\n" +
" NextMonth := ' '\r\n" +
" else\r\n" +
" begin\r\n" +
" inc(NMonth);\r\n" +
" val(copy(Date , 6 , 2) , NYear , i);\r\n" +
" if i <> 0 then\r\n" +
" NYear := 99;\r\n" +
" if NYear < 50 then\r\n" +
" NYear := NYear + 2000\r\n" +
" else\r\n" +
" NYear := NYear + 1900;\r\n" +
" if NMonth > 12 then\r\n" +
" begin\r\n" +
" NMonth := 1;\r\n" +
" inc(NYear);\r\n" +
" end;\r\n" +
" NextMonth := AlphaMonths[NMonth];\r\n" +
" str(NYear :4 , Year);\r\n" +
" end;\r\n" +
"end; {NextMonth}\r\n" +
"\r\n" +
"function LocalToGMT(LocalTime , GMTVariance :string) :string;\r\n" +
"var\r\n" +
" GMT :integer;\r\n" +
"begin\r\n" +
" if GMTVariance[1] = '-' then\r\n" +
" GMT := TimeToMinutes(LocalTime)\r\n" +
" + TimeToMinutes(copy(GMTVariance , 2 , 4))\r\n" +
" else\r\n" +
" GMT := TimeToMinutes(LocalTime)\r\n" +
" - TimeToMinutes(copy(GMTVariance , 2 , 4));\r\n" +
" if GMT < 0 then\r\n" +
" begin\r\n" +
" LocalToGMT := MinutesToTime(GMT + MIN_PER_DAY);\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if GMT >= MIN_PER_DAY then\r\n" +
" begin\r\n" +
" LocalToGMT := MinutesToTime(GMT - MIN_PER_DAY);\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" LocalToGMT := MinutesToTime(GMT);\r\n" +
" end;\r\n" +
" end;\r\n" +
"end; {LocalToGMT}\r\n" +
"\r\n" +
"function GMTtoLocal(GMT , GMTVariance :string) :string;\r\n" +
"var\r\n" +
" Local :integer;\r\n" +
"begin\r\n" +
" if GMTVariance[1] = '-' then\r\n" +
" Local := TimeToMinutes(GMT)\r\n" +
" - TimeToMinutes(copy(GMTVariance , 2 , 4))\r\n" +
" else\r\n" +
" Local := TimeToMinutes(GMT)\r\n" +
" + TimeToMinutes(copy(GMTVariance , 2 , 4));\r\n" +
" if Local < 0 then\r\n" +
" begin\r\n" +
" GMTtoLocal := MinutesToTime(Local + MIN_PER_DAY);\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if Local >= MIN_PER_DAY then\r\n" +
" begin\r\n" +
" GMTtoLocal := MinutesToTime(Local - MIN_PER_DAY);\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" GMTtoLocal := MinutesToTime(local);\r\n" +
" end;\r\n" +
" end;\r\n" +
"end; {GMTtoLocal}\r\n" +
"\r\n" +
"function TimeToAMPM(Time :string) :string;\r\n" +
"var\r\n" +
" iTime , rc :integer;\r\n" +
"begin\r\n" +
" val(copy(Time , 1 , 2) , iTime , rc);\r\n" +
" if (rc = 0)\r\n" +
" and (iTime >= 1200) then\r\n" +
" begin\r\n" +
" iTime := iTime - 1200;\r\n" +
" str(iTime :4 , Time);\r\n" +
" TimeToAMPM := Time + 'P';\r\n" +
" end\r\n" +
" else\r\n" +
" TimeToAMPM := Time + 'A';\r\n" +
"end; {TimeToAMPM}\r\n" +
"\r\n" +
"function TimeToAMPM1(Time :string) :string;\r\n" +
"var\r\n" +
" TempHour :string[2];\r\n" +
"{ AMPM :Char;}\r\n" +
" AMPM :string[1];\r\n" +
" iTime :integer;\r\n" +
" oTime :string[5];\r\n" +
"begin\r\n" +
" AMPM := ' ';\r\n" +
" TempHour := copy(Time , 1 , 2);\r\n" +
" iTime := Str2Int(TempHour);\r\n" +
" if iTime > 12 then\r\n" +
" begin\r\n" +
" iTime := iTime - 12;\r\n" +
" if iTime = 12 then\r\n" +
" begin\r\n" +
" iTime := 0;\r\n" +
" AMPM := 'A';\r\n" +
" end\r\n" +
" else\r\n" +
" AMPM := 'P';\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if iTime = 12 then\r\n" +
" AMPM := 'P'\r\n" +
" else\r\n" +
" AMPM := 'A';\r\n" +
" end;\r\n" +
" TempHour := ' ';\r\n" +
" TempHour := Int2IntStr(iTime , 2);\r\n" +
" if TempHour[1] = ' ' then\r\n" +
" TempHour[1] := '0';\r\n" +
" if TempHour[2] = ' ' then\r\n" +
" TempHour[2] := '0';\r\n" +
" oTime := TempHour[1]\r\n" +
" + TempHour[2]\r\n" +
" + Time[3]\r\n" +
" + Time[4]\r\n" +
" + AMPM[1];\r\n" +
" TimeToAMPM1 := oTime;\r\n" +
"end; {TimeToAMPM1}\r\n" +
"\r\n" +
"function TimeToAMPM2(Time :string) :string;\r\n" +
"var\r\n" +
" TempHour :string[2];\r\n" +
"{ AMPM :Char;}\r\n" +
" AMPM :string[1];\r\n" +
" iTime :integer;\r\n" +
" oTime :string[5];\r\n" +
"begin\r\n" +
" AMPM := ' ';\r\n" +
" TempHour := copy(Time , 1 , 2);\r\n" +
" iTime := Str2Int(TempHour);\r\n" +
" if iTime > 12 then\r\n" +
" begin\r\n" +
" iTime := iTime - 12;\r\n" +
" if iTime = 12 then\r\n" +
" begin\r\n" +
" iTime := 0;\r\n" +
" AMPM := 'A';\r\n" +
" end\r\n" +
" else\r\n" +
" AMPM := 'P';\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" if iTime = 12 then\r\n" +
" AMPM := 'P'\r\n" +
" else\r\n" +
" AMPM := 'A';\r\n" +
" end;\r\n" +
" TempHour := ' ';\r\n" +
" TempHour := Int2IntStr(iTime , 2);\r\n" +
" if TempHour[2] = ' ' then\r\n" +
" begin\r\n" +
" TempHour[1] := '1';\r\n" +
" TempHour[2] := '2';\r\n" +
" end;\r\n" +
" oTime := TempHour[1]\r\n" +
" + TempHour[2]\r\n" +
" + Time[3]\r\n" +
" + Time[4]\r\n" +
" + AMPM[1];\r\n" +
" if oTime = '1200P' then\r\n" +
" oTime := '1200N';\r\n" +
" if oTime = '1200A' then\r\n" +
" oTime := '1200M';\r\n" +
"\r\n" +
" TimeToAMPM2 := oTime;\r\n" +
"end; {TimeToAMPM2}\r\n" +
"\r\n" +
"function TimeAMToTime(Time :string) :string;\r\n" +
"var\r\n" +
" iTime :integer;\r\n" +
" oTime :string[4];\r\n" +
"begin\r\n" +
" if Time[5] = 'P' then\r\n" +
" begin\r\n" +
" iTime := TimeToMinutes(copy(Time , 1 , 4)) + 720;\r\n" +
" oTime := MinutesToTime(iTime);\r\n" +
" if (oTime[1] = '2') and (oTime[2] = '4') then\r\n" +
" begin\r\n" +
" oTime[1] := '1';\r\n" +
" oTime[2] := '2';\r\n" +
" end;\r\n" +
" end\r\n" +
" else\r\n" +
" begin\r\n" +
" oTime := copy(Time , 1 , 4);\r\n" +
" end;\r\n" +
" TimeAMToTime := oTime;\r\n" +
"end; {TimeAMToTime}\r\n" +
"\r\n" +
"function TimeToTimeMaintenance(iTime :integer) :string;\r\n" +
"var\r\n" +
" oTime :real;\r\n" +
"begin\r\n" +
" oTime := iTime / MIN_PER_HR;\r\n" +
" TimeToTimeMaintenance := Real2Str(oTime , 4);\r\n" +
"end; { TimeToTimeMaintenance }\r\n" +
"\r\n" +
"function EagleToCCYYMMDDDate(EagleDate :UniversalDateType) : CCYYMMDDDateType;\r\n" +
"var\r\n" +
" S: AnsiString;\r\n" +
"begin\r\n" +
" S := Format('%s%.2d%s', [AddCenturyToYear(copy(EagleDate , 6 , 2)),\r\n" +
" NumericMonth(copy(EagleDate , 3 , 3)),\r\n" +
" Copy(EagleDate, 1, 2)]);\r\n" +
" Move(S[1], Result, Length(S));\r\n" +
"end; {EagleToCCYYMMDDDate}\r\n" +
"\r\n" +
"procedure EagleToCrewTracDate\r\n" +
" (EagleDate :UniversalDateType;\r\n" +
" var StartCrewTracDate :CrewDateType);\r\n" +
"begin\r\n" +
" StartCrewTracDate := EagleToCCYYMMDDDate(EagleDate);\r\n" +
"end; {EagleToCrewTracDate}\r\n" +
"\r\n" +
"{** 04-10-95 * FlightEventUTCToLt ****************************************}\r\n" +
"\r\n" +
"procedure FlightEventUTCToLt\r\n" +
" (\r\n" +
" sNumFltDateUTC :NumericDateType;\r\n" +
" sSTDUTC :EagleTimeType;\r\n" +
" sFltEventUTC :EagleTimeType;\r\n" +
" sUTCVariance :UTCVarianceType;\r\n" +
" var stFltEventLt :FlightTimeType\r\n" +
" );\r\n" +
"\r\n" +
"{\r\n" +
" FILENAME: datetime.pas\r\n" +
"\r\n" +
" DESCRIPTION: FlightEventUTCToLt\r\n" +
"\r\n" +
" PARAMETERS: sNumFltDateUTC UTC flight date (numeric)\r\n" +
" sSTDUTC UTC schedule time of departure\r\n" +
" sFltEventUTC UTC flight time\r\n" +
" sUTCVariance UTC time variance for input time\r\n" +
" stFltEventLt Lt flight Time\r\n" +
"\r\n" +
" RETURNS: None NA\r\n" +
"\r\n" +
" LOCAL: iMinDifference Time difference in minutes\r\n" +
" iMinFltTimeUTC UTC flight time (0-1439); minutes\r\n" +
" since UTC \"midnight\"\r\n" +
" iMinSTDUTC UTC scheduled departure time (0-1439);\r\n" +
" minutes since UTC \"midnight\"\r\n" +
" iDayADFltDateLt Local date; days since base date\r\n" +
" iDayADFltDateUTC UTC date; days since base date\r\n" +
" sFltDateLt Local flight date string (ex. 02MAR95)\r\n" +
"\r\n" +
"-------------------------------------------------------------------------}\r\n" +
"\r\n" +
"var\r\n" +
" iMinDifference :integer;\r\n" +
" iMinFltTimeUTC :integer;\r\n" +
" iMinSTDUTC :integer;\r\n" +
" lDayADFltDateLt :longint;\r\n" +
" lDayADFltDateUTC :longint;\r\n" +
" sFltDateLt :UniversalDateType;\r\n" +
" sFltEventDate :CrewDateType;\r\n" +
"\r\n" +
"begin { procedure FlightEventUTCToLt }\r\n" +
"\r\n" +
" lDayADFltDateUTC := DayAD(sNumFltDateUTC);\r\n" +
" iMinSTDUTC := TimeToMinutes(sSTDUTC);\r\n" +
" iMinFltTimeUTC := TimeToMinutes(sFltEventUTC);\r\n" +
"\r\n" +
" iMinDifference := iMinFltTimeUTC - iMinSTDUTC;\r\n" +
" if (iMinDifference < -MAX_EARLY_DEP_MINS) then\r\n" +
" Inc(lDayADFltDateUTC)\r\n" +
" else if (iMinDifference > MAX_FLT_LENGTH_MINS) then\r\n" +
" Dec(lDayADFltDateUTC);\r\n" +
"\r\n" +
" { Convert to local date and time }\r\n" +
" stFltEventLt.UTCVariance := TimeToMinutes(Copy(sUTCVariance , 2 , 4));\r\n" +
" if (sUTCVariance[1] = '-') then\r\n" +
" stFltEventLt.UTCVariance := -stFltEventLt.UTCVariance;\r\n" +
"\r\n" +
" stFltEventLt.Time := iMinFltTimeUTC + stFltEventLt.UTCVariance;\r\n" +
" if (stFltEventLt.Time >= MIN_PER_DAY) then\r\n" +
" begin\r\n" +
" Dec(stFltEventLt.Time , MIN_PER_DAY);\r\n" +
" lDayADFltDateLt := lDayADFltDateUTC + 1;\r\n" +
" end { then }\r\n" +
" else if (stFltEventLt.Time < 0) then\r\n" +
" begin\r\n" +
" Inc(stFltEventLt.Time , MIN_PER_DAY);\r\n" +
" lDayADFltDateLt := lDayADFltDateUTC - 1;\r\n" +
" end { then }\r\n" +
" else\r\n" +
" lDayADFltDateLt := lDayADFltDateUTC;\r\n" +
"\r\n" +
" sFltDateLt := DayADtoDate(lDayADFltDateLt);\r\n" +
" EagleToCrewTracDate(sFltDateLt , sFltEventDate);\r\n" +
" move(sFltEventDate , stFltEventLt.Date , 9);\r\n" +
"\r\n" +
"end; { procedure FlightEventUTCToLt }\r\n" +
"\r\n" +
"{** 04-07-95 * GMTToOUTOFFONINMVTCrewTracTime ****************************}\r\n" +
"\r\n" +
"procedure GMTtoOUTOFFONINMVTCrewTracTime\r\n" +
" (EagleNumGMTDate ,\r\n" +
" EagleSTDudt ,\r\n" +
" EagleETDudt ,\r\n" +
" EagleGMTTime ,\r\n" +
" EagleGMTVariance :string;\r\n" +
" var CrewTracTime :FlightTimeType);\r\n" +
"var\r\n" +
" LocalDayAD :longint;\r\n" +
" GMTDayAD :longint;\r\n" +
" GMTTime :integer;\r\n" +
" LocalDate :string[7];\r\n" +
" CrewTracDate :CrewDateType;\r\n" +
"begin\r\n" +
" with CrewTracTime do\r\n" +
" begin\r\n" +
" GMTDayAD := DayAD(EagleNumGMTDate);\r\n" +
" GMTTime := TimeToMinutes(EagleGMTTime);\r\n" +
" {Convert to local}\r\n" +
" UTCVariance := TimeToMinutes(copy(EagleGMTVariance , 2 , 4));\r\n" +
" if EagleGMTVariance[1] = '-' then\r\n" +
" UTCVariance := -UTCVariance;\r\n" +
" Time := GMTTime + UTCVariance;\r\n" +
" LocalDayAD := GMTDayAD;\r\n" +
" if Time >= MIN_PER_DAY then\r\n" +
" begin\r\n" +
" inc(LocalDayAD);\r\n" +
" Time := Time - MIN_PER_DAY;\r\n" +
" end;\r\n" +
" if Time < 0 then\r\n" +
" begin\r\n" +
" dec(LocalDayAD);\r\n" +
" Time := Time + MIN_PER_DAY;\r\n" +
" end;\r\n" +
" LocalDate := DayADtoDate(LocalDayAD);\r\n" +
" EagleToCrewTracDate(LocalDate , CrewTracDate);\r\n" +
" move(CrewTracDate[1] , Date[1] , 8);\r\n" +
" end;\r\n" +
"end; {OUTOFFONINMVTCrewTracTime}\r\n" +
"\r\n" +
"function YMD2DMYEagle(inDate :string) :string;\r\n" +
"begin\r\n" +
" YMD2DMYEagle := copy(inDate , 7 , 2)\r\n" +
" + AlphaMonth(Str2Int(copy(inDate , 5 , 2)))\r\n" +
" + copy(inDate , 3 , 2);\r\n" +
"end;\r\n" +
"\r\n" +
"function ZIPDate(iNumDate :string) :string;\r\n" +
"var\r\n" +
" i :integer;\r\n" +
" Day , Month , Year :string[2];\r\n" +
" Date :string[6];\r\n" +
"begin\r\n" +
" str(ord(iNumDate[4]) :2 , Day);\r\n" +
" str(ord(iNumDate[3]) :2 , Month);\r\n" +
" str(ord(iNumDate[2]) :2 , Year);\r\n" +
" Date := Month + Day + Year;\r\n" +
" for i := 1 to 6 do\r\n" +
" begin\r\n" +
" if Date[i] = ' ' then\r\n" +
" Date[i] := '0';\r\n" +
" end;\r\n" +
" ZIPDate := Date;\r\n" +
"end;\r\n" +
"\r\n" +
"function ComputeElapsedMinutes(Time1udt , Time2udt :string) :integer;\r\n" +
"var\r\n" +
" dMin :integer;\r\n" +
"begin\r\n" +
" dMin := TimeToMinutes(Time2udt) - TimeToMinutes(Time1udt);\r\n" +
" if dMin < 0 then\r\n" +
" ComputeElapsedMinutes := dMin + MIN_PER_DAY\r\n" +
" else\r\n" +
" ComputeElapsedMinutes := dMin;\r\n" +
"end; {ComputeElapsedMinutes}\r\n" +
"\r\n" +
"procedure Delay(DelayAmount :word);\r\n" +
"\r\n" +
"var\r\n" +
" EndTime :TDateTime;\r\n" +
" FirstTime :TDateTime;\r\n" +
" DelayTime :double;\r\n" +
"\r\n" +
"begin\r\n" +
" { This has a resolution of 1/4 second because of the Sleep(250) but it\r\n" +
" is much easier on resources }\r\n" +
" FirstTime := Time;\r\n" +
" DelayTime := DelayAmount / 86400000;\r\n" +
" repeat\r\n" +
" Sleep(250);\r\n" +
" EndTime := Time;\r\n" +
" Application.ProcessMessages;\r\n" +
" until ((EndTime - FirstTime) > DelayTime) or (EndTime < FirstTime);\r\n" +
"end; {Delay}\r\n" +
"\r\n" +
"{** 02-24-99 * NowUTC *****************************************************}\r\n" +
"\r\n" +
"Function NowUTC : TDateTime;\r\n" +
"Var\r\n" +
" sysTime : TSystemTime;\r\n" +
"Begin\r\n" +
" GetSystemTime(sysTime); //on Windows, always returns current UTC Time - Windows internally works only in UTC.\r\n" +
" Result := SystemTimeToDateTime(sysTime);\r\n" +
"End;\r\n" +
"\r\n" +
"function nowUTCMinute: TDateTime;\r\n" +
"\r\n" +
"var\r\n" +
" SystemTime : TSystemTime;\r\n" +
" CurrentTime : TDateTime;\r\n" +
" CurrentDate : TDateTime;\r\n" +
"\r\n" +
"begin // nowUTCMinute\r\n" +
" GetSystemTime(SystemTime); // GetSystemTime gets time in UTC\r\n" +
" CurrentTime := EncodeTime(\r\n" +
" SystemTime.wHour,\r\n" +
" SystemTime.wMinute,\r\n" +
" 0, //Second\r\n" +
" 0); //MilliSeconds\r\n" +
"\r\n" +
" CurrentDate := EncodeDate(\r\n" +
" SystemTime.wYear,\r\n" +
" SystemTime.wMonth,\r\n" +
" SystemTime.wDay);\r\n" +
"\r\n" +
" Result := CurrentDate + CurrentTime;\r\n" +
"end; // nowUTCMinute\r\n" +
"\r\n" +
"{** 08-05-98 * GetUTCDate *****************************************************}\r\n" +
"\r\n" +
"function GetUTCDate :TDateTime;\r\n" +
"begin // GetUTCDate\r\n" +
" Result := Trunc(GetUTCDateTime);\r\n" +
"end; // GetUTCDate\r\n" +
"\r\n" +
"{** 07-30-98 * GetUTCTime *****************************************************}\r\n" +
"\r\n" +
"function GetUTCTime :TDateTime;\r\n" +
"begin // GetUTCTime\r\n" +
" Result := GetUTCDateTime;\r\n" +
" Result := Result - Trunc(Result);\r\n" +
"end; // GetUTCTime\r\n" +
"\r\n" +
"{** 07-30-98 * GetUTCDateTime *************************************************}\r\n" +
"\r\n" +
"function GetUTCDateTime :TDateTime;\r\n" +
"\r\n" +
"var\r\n" +
" SystemTime :TSystemTime;\r\n" +
" CurrentTime :TDateTime;\r\n" +
" CurrentDate :TDateTime;\r\n" +
"\r\n" +
"begin // GetUTCDateTime\r\n" +
" if (not AllTimeIsUTCBased) then\r\n" +
" Result := Now // get time from system clock without regard for utc time zone\r\n" +
" else\r\n" +
" begin\r\n" +
" GetSystemTime(SystemTime); // GetSystemTime gets time in UTC\r\n" +
"\r\n" +
" CurrentTime := EncodeTime(\r\n" +
" SystemTime.wHour ,\r\n" +
" SystemTime.wMinute ,\r\n" +
" SystemTime.wSecond ,\r\n" +
" SystemTime.wMilliSeconds);\r\n" +
"\r\n" +
" CurrentDate := EncodeDate(\r\n" +
" SystemTime.wYear ,\r\n" +
" SystemTime.wMonth ,\r\n" +
" SystemTime.wDay);\r\n" +
"\r\n" +
" Result := CurrentDate + CurrentTime;\r\n" +
" end; // else\r\n" +
"end; // GetUTCDateTime\r\n" +
"\r\n" +
"procedure TimeIsUTCBased(Value :boolean);\r\n" +
"begin\r\n" +
" AllTimeIsUTCBased := Value;\r\n" +
"end; // TimeIsUTCBased\r\n" +
"\r\n" +
"function NumToDate(DateNumeric :string) :string;\r\n" +
"begin\r\n" +
" Result := DayADToDate(DayAD(DateNumeric));\r\n" +
"end; // NumToDate\r\n" +
"\r\n" +
"// =============================================================================\r\n" +
"// DMB - this is a new function\r\n" +
"\r\n" +
"function EagleDateToDateTime(const StringDateTime: ShortString; var ivIsOK: Boolean): TDateTime;\r\n" +
"var\r\n" +
" Hour :integer;\r\n" +
" Min :integer;\r\n" +
" TempDate :UniversalDateType;\r\n" +
" Day , Month , Year :Word;\r\n" +
"begin\r\n" +
" TempDate := StringDateTime;\r\n" +
" ivIsOK := ValidateDate(TempDate);\r\n" +
" if ivIsOK then\r\n" +
" begin\r\n" +
" Hour := StrToIntDef(copy(StringDateTime , 9 , 2) , 0);\r\n" +
" Min := StrToIntDef(copy(StringDateTime , 11 , 2) , 0);\r\n" +
" Day := StrToIntDef(Copy(TempDate , 1 , 2), 0);\r\n" +
" Month := NumericMonth(Copy(TempDate , 3 , 3));\r\n" +
" Year := StrToIntDef(AddCenturyToYear(Copy(TempDate , 6 , 2)), 0);\r\n" +
" Result := Trunc(EncodeDate(Year, Month, Day)) + EncodeTime(Hour , Min , 0 , 0); // DMB\r\n" +
" end\r\n" +
" else\r\n" +
" Result := 0.0;\r\n" +
"end;\r\n" +
"\r\n" +
"function EagleDateToDateTime(const StringDateTime: ShortString): TDateTime;\r\n" +
"var\r\n" +
" vIsOK: Boolean;\r\n" +
"begin\r\n" +
" Result := EagleDateToDateTime(StringDateTime, vIsOK);\r\n" +
"end;\r\n" +
"\r\n" +
"function DateTimetoEagleDate(const DateTimeIn :TDateTime) :shortstring;\r\n" +
"var\r\n" +
" Day, Month, Year : Word;\r\n" +
" DayStr, YearStr : shortstring;\r\n" +
"begin\r\n" +
" if DateTimeIn = 0.0 then\r\n" +
" Result := ' ' //blank date\r\n" +
" else begin\r\n" +
" DecodeDate( DateTimeIn, Year, Month, Day );\r\n" +
"\r\n" +
" DayStr := PadL( IntToStr( Day ), 2, '0' );\r\n" +
" YearStr := PadL( IntToStr( Year ), 2, '0' );\r\n" +
"\r\n" +
" Result := DayStr + AlphaMonth(Month) + copy( YearStr, 3, 2 );\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"function EagleDateTimeToDateTime(const iDate, iTime: ShortString; var ivIsOK: Boolean): TDateTime;\r\n" +
"begin\r\n" +
" Result := EagleDateToDateTime(iDate, ivIsOK) + EagleTimeToDateTime(iTime);\r\n" +
"end;\r\n" +
"\r\n" +
"function EagleDateTimeToDateTime(const iDate, iTime: ShortString): TDateTime;\r\n" +
"var\r\n" +
" vIsOK: Boolean;\r\n" +
"begin\r\n" +
" Result := EagleDateTimeToDateTime(iDate, iTime, vIsOK);\r\n" +
"end;\r\n" +
"\r\n" +
"function EagleTimeToDateTime(const iTime: ShortString; const iFixTime : Boolean = False): TDateTime;\r\n" +
"var\r\n" +
" vHH, vMM: Word;\r\n" +
"begin\r\n" +
" vHH := StrToIntDef(Copy(iTime, 1, 2), 0);\r\n" +
" vMM := StrToIntDef(Copy(iTime, 3, 2), 0);\r\n" +
" if (iFixTime) and (vMM = 60) then //used when time is equal to e.g. 2160 - should be 2200\r\n" +
" begin\r\n" +
" vMM := 0;\r\n" +
" Result := EncodeTime(vHH, vMM, 0, 0);\r\n" +
" Result := IncHour(Result, 1)\r\n" +
" end\r\n" +
" else\r\n" +
" Result := EncodeTime(vHH, vMM, 0, 0);\r\n" +
"end;\r\n" +
"\r\n" +
"function DateTimeToEagleTime(const iDateTime: TDateTime) : ShortString;\r\n" +
"var\r\n" +
" vHours, vMins, vSecs, vMsecs : Word;\r\n" +
" vHoursStr, vMinsStr : ShortString;\r\n" +
"begin\r\n" +
" Result := ' '; //blank time\r\n" +
" if iDateTime = 0.0 then\r\n" +
" exit;\r\n" +
"\r\n" +
" DecodeTime( iDateTime, vHours, vMins, vSecs, vMsecs );\r\n" +
" vHoursStr := PadL( IntToStr( vHours ), 2, '0' );\r\n" +
" vMinsStr := PadL( IntToStr( vMins ), 2, '0' );\r\n" +
" Result := vHoursStr + vMinsStr;\r\n" +
"end;\r\n" +
"\r\n" +
"function NumericYesterday :string;\r\n" +
"begin\r\n" +
" Result := NumericDate(DayADtoDate(DayAD(NumericDate(GetUniversalDate)) - 1));\r\n" +
"end; // NumericYesterday\r\n" +
"\r\n" +
"function NumericDateToUniversalDate(iNumDate :string) :UniversalDateType;\r\n" +
"begin\r\n" +
" NumericDateToUniversalDate := copy(NumericToYYYYMMDD(iNumDate) , 7 , 2) +\r\n" +
" AlphaMonth(StrToIntDef(copy(NumericToYYYYMMDD(iNumDate) , 5 , 2), 0)) +\r\n" +
" copy(NumericToYYYYMMDD(iNumDate) , 3 , 2);\r\n" +
"end;\r\n" +
"\r\n" +
"Function UniversalDateTimeToTDateTime\r\n" +
" ( UniversalDate: UniversalDateType;\r\n" +
" HHMM : EagleTimeType;\r\n" +
" var iTDateTime : TDateTime ) : boolean;\r\n" +
"var\r\n" +
" MMDDYY :string[6];\r\n" +
" WorkDate :TDateTime;\r\n" +
" WorkTime :TDateTime;\r\n" +
"Begin\r\n" +
" Result := false;\r\n" +
" iTDateTime := 0;\r\n" +
" if ValidEagleTime(HHMM) then\r\n" +
" if UniversalToUSDate(UniversalDate,MMDDYY) then\r\n" +
" begin\r\n" +
" WorkDate := EncodeDate(StrToInt(AddCenturyToYear(copy(MMDDYY,5,2))),\r\n" +
" StrToInt(copy(MMDDYY,1,2)),\r\n" +
" StrToInt(copy(MMDDYY,3,2)));\r\n" +
" WorkTime := EncodeTime(StrToInt(copy(HHMM,1,2)),\r\n" +
" StrToInt(copy(HHMM,3,2)),\r\n" +
" 0,\r\n" +
" 0);\r\n" +
"\r\n" +
" iTDateTime := WorkDate + WorkTime;\r\n" +
" Result := true;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"Function TDateTimeToUniversalDateTime\r\n" +
" ( iTDateTime : TDateTime;\r\n" +
" var UniversalDate: UniversalDateType;\r\n" +
" var HHMM : EagleTimeType ) : boolean;\r\n" +
"var\r\n" +
" Hour, Min, Sec, MSec :word;\r\n" +
"begin\r\n" +
" UniversalDate := ConvertDateTimeToUniversalDate(iTDateTime);\r\n" +
" decodetime(iTDateTime,Hour, Min, Sec, MSec);\r\n" +
" HHMM := int2fullstr(Hour,2) + int2fullstr(Min,2);\r\n" +
" result := true;\r\n" +
"end;\r\n" +
"\r\n" +
"function TDateTimeToDDHHMM (iTDateTime : TDateTime) :string;\r\n" +
"var\r\n" +
" Hour, Min, Sec, MSec :word;\r\n" +
" Year, Month, Day: Word;\r\n" +
"begin\r\n" +
" decodetime(iTDateTime,Hour, Min, Sec, MSec);\r\n" +
" decodedate(iTDateTime, Year, Month, Day);\r\n" +
" result := int2fullstr(Day,2) + int2fullstr(Hour,2) + int2fullstr(Min,2);\r\n" +
"end;\r\n" +
"\r\n" +
"function DDHHMMToTDateTime (iDDHHMM : string; iRefTimestamp: TDateTime = -1) :TDateTime;\r\n" +
"var\r\n" +
" DD: word;\r\n" +
" Hour, Min, Sec, MSec :word;\r\n" +
" Year, Month, Day: Word;\r\n" +
" DateDateTime: TDateTime;\r\n" +
" TimeDateTime: TDateTime;\r\n" +
"begin\r\n" +
" if iRefTimestamp = -1 then\r\n" +
" iRefTimestamp := Now;\r\n" +
" DD := Str2Int(copy(iDDHHMM,1,2));\r\n" +
" decodedate(iRefTimestamp, Year, Month, Day);\r\n" +
" if Day <> DD\r\n" +
" then begin\r\n" +
" if (Day > 20)\r\n" +
" and (DD < 10)\r\n" +
" then begin\r\n" +
" if Month = 12\r\n" +
" then begin\r\n" +
" Month := 1;\r\n" +
" inc(Year);\r\n" +
" end\r\n" +
" else inc(Month);\r\n" +
" end\r\n" +
" else begin\r\n" +
" if (Day < 20)\r\n" +
" and (DD > 10)\r\n" +
" then begin\r\n" +
" if Month = 1\r\n" +
" then begin\r\n" +
" Month := 12;\r\n" +
" dec(Year);\r\n" +
" end\r\n" +
" else dec(Month);\r\n" +
" end;\r\n" +
" end;\r\n" +
" Day := DD;\r\n" +
" end;\r\n" +
" DateDateTime := encodedate(Year, Month, Day);\r\n" +
" Hour := Str2Int(copy(iDDHHMM,3,2));\r\n" +
" Min := Str2Int(copy(iDDHHMM,5,2));\r\n" +
" Sec := 0;\r\n" +
" MSec := 0;\r\n" +
" TimeDateTime := encodetime(Hour, Min, Sec, MSec);\r\n" +
" result := DateDateTime + TimeDateTime;\r\n" +
"end;\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }\r\n" +
"\r\n" +
"{** 10-27-99 * NumericDateToDDMMMYY **************************************}\r\n" +
"Function NumericDateToDDMMMYY (NumericDateIn : String) : String;\r\n" +
"Var\r\n" +
" i : Integer;\r\n" +
" Day, Year : String[2];\r\n" +
" Month : String[3];\r\n" +
" Date : String[7];\r\n" +
"\r\n" +
"Begin // NumericDateToDDMMMYY\r\n" +
"\r\n" +
" Str (Ord (NumericDateIn[4]):2, Day);\r\n" +
" Month := AlphaMonth (Ord (NumericDateIn[3]));\r\n" +
" Str (Ord (NumericDateIn[2]):2, Year);\r\n" +
"\r\n" +
" Date := Day + Month + Year;\r\n" +
"\r\n" +
" For i := 1 to 7 Do\r\n" +
" If Date[i] = ' ' then\r\n" +
" Date[i] := '0';\r\n" +
"\r\n" +
" Result := Date;\r\n" +
"\r\n" +
"end; // NumericDateToDDMMMYY\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }\r\n" +
"{** 11-04-99 * ValidNumericDate ***********************************************}\r\n" +
"Function ValidNumericDate (Const NumericDateIn : String) : Boolean;\r\n" +
"Var\r\n" +
" ValidCentury,\r\n" +
" ValidYear,\r\n" +
" ValidMonth,\r\n" +
" ValidDay : Boolean;\r\n" +
"\r\n" +
"Begin // ValidNumericDate\r\n" +
"\r\n" +
" ValidCentury := (NumericDateIn[1] >= #19) and (NumericDateIn[1] <= #99);\r\n" +
" ValidYear := (NumericDateIn[2] >= #0) and (NumericDateIn[2] <= #99);\r\n" +
" ValidMonth := (NumericDateIn[3] >= #1) and (NumericDateIn[3] <= #12);\r\n" +
" ValidDay := (NumericDateIn[4] >= #1) and (NumericDateIn[4] <= #31);\r\n" +
"\r\n" +
" Result := ValidCentury and ValidYear and ValidMonth and ValidDay;\r\n" +
"\r\n" +
"end; // ValidNumericDate\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }{** 07-30-98 * DateTimeToDDMMMYY ************************************************}\r\n" +
"function DateTimeToDDMMMYY( NewDate : TDateTime ) : string;\r\n" +
"\r\n" +
"var\r\n" +
" Year : word;\r\n" +
" Month : word;\r\n" +
" Day : word;\r\n" +
" YearStr : string;\r\n" +
" DayStr : string;\r\n" +
"\r\n" +
"begin // DateTimeToDDMMMYY\r\n" +
" try\r\n" +
" try\r\n" +
" DecodeDate(NewDate, Year, Month, Day);\r\n" +
" except\r\n" +
" DecodeDate(GetUTCDateTime, Year, Month, Day);\r\n" +
" end; // try\r\n" +
"\r\n" +
" DayStr := IntToStr(Day);\r\n" +
" if Length(DayStr) < 2 then\r\n" +
" DayStr := '0'+DayStr;\r\n" +
"\r\n" +
" YearStr := Copy(IntToStr(Year),3,2);\r\n" +
"\r\n" +
" Result := DayStr+ DateTime.AlphaMonth(Month) + YearStr;\r\n" +
" except\r\n" +
" Result := coBlankDate;\r\n" +
" end;\r\n" +
"end; // DateTimeToDDMMMYY\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }\r\n" +
"function NumericDateToDateTime(const iNumericDate : string): TDatetime;\r\n" +
"begin\r\n" +
" Result := DDMMMYYDateToDateTime(NumericDateToDDMMMYY(iNumericDate));\r\n" +
"end;\r\n" +
"\r\n" +
"{ TODO : Copied from Drb\\DateTime.pas }\r\n" +
"{** 04-20-04 * DDMMMYYDateToDateTime ******************************************}\r\n" +
"function DDMMMYYDateToDateTime( DDMMMYYDate : string ) : TDateTime;\r\n" +
"\r\n" +
"var\r\n" +
" YearStr : string[4];\r\n" +
" Year : word;\r\n" +
" Month : word;\r\n" +
" Day : word;\r\n" +
"\r\n" +
"begin // DDMMMYYDateToDateTime\r\n" +
" try\r\n" +
" Day := StrToInt(Copy(DDMMMYYDate,1,2));\r\n" +
" except\r\n" +
" on E : EConvertError do\r\n" +
" raise Exception.Create( Copy(DDMMMYYDate,1,2) + ' is not a valid day' );\r\n" +
" end;\r\n" +
"\r\n" +
" try\r\n" +
" YearStr := DateTime.AddCenturyToYear( Copy(DDMMMYYDate,6,2) );\r\n" +
" Year := StrToInt( YearStr );\r\n" +
" except\r\n" +
" on E : EConvertError do\r\n" +
" raise Exception.Create( YearStr + ' is not a valid year' );\r\n" +
" end;\r\n" +
"\r\n" +
" Month := DateTime.NumericMonth( Copy(DDMMMYYDate,3,3) );\r\n" +
"\r\n" +
" try\r\n" +
" Result := EncodeDate( Year, Month, Day);\r\n" +
" except\r\n" +
" Result := GetUTCDateTime;\r\n" +
" end; // try\r\n" +
"end; // DDMMMYYDateToDateTime\r\n" +
"\r\n" +
"function IsFakeDateEnabled: Boolean;\r\n" +
"begin\r\n" +
" Result := FileExists('FakeDate.txt');\r\n" +
"end;\r\n" +
"\r\n" +
"procedure FakeDate;\r\n" +
"begin\r\n" +
" FTestDate := '';\r\n" +
" with TStringList.Create do\r\n" +
" try\r\n" +
" LoadFromFile('FakeDate.txt');\r\n" +
" if Count <> 1 then\r\n" +
" Exit;\r\n" +
"\r\n" +
" FTestDate := Strings[0];\r\n" +
" if not ValidateDate(FTestDate) then\r\n" +
" begin\r\n" +
" ShowMessageFmt('Error in format (DDMMMYY) of fake date of - \"%s\"'#13#10' from \"%s\\FakeDate.txt\"', [\r\n" +
" FTestDate,\r\n" +
" GetCurrentDir\r\n" +
" ]);\r\n" +
" FTestDate := '';\r\n" +
" end\r\n" +
" else\r\n" +
" ShowMessageFmt('Running with fake date of - \"%s\" from \"%s\\FakeDate.txt\"', [\r\n" +
" FTestDate,\r\n" +
" GetCurrentDir\r\n" +
" ]);\r\n" +
" finally\r\n" +
" Free;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"function DateTimeToNumericDate(const DateTimeIn :TDateTime) :NumericDateType;\r\n" +
"var\r\n" +
" vEagleDate : UniversalDateType;\r\n" +
"begin\r\n" +
" vEagleDate := DateTimetoEagleDate(DateTimeIn);\r\n" +
" Result := NumericDate(vEagleDate);\r\n" +
"end;\r\n" +
"\r\n" +
"function NumericDateWithTimeToDateTime(iNumericDateTime: ShortString): TDateTime;\r\n" +
"var\r\n" +
" MessageDate: UniversalDateType;\r\n" +
" MessageTime: EagleTimeType;\r\n" +
" MessageDateTime: TDateTime;\r\n" +
"begin\r\n" +
" MessageDate := DayADtoDate(DayAD(copy(iNumericDateTime, 1, 4)));\r\n" +
" MessageTime := MinutesToTime(ord(iNumericDateTime[5])*60+ord(iNumericDateTime[6]));\r\n" +
" if not UniversalDateTimeToTDateTime(MessageDate, MessageTime, MessageDateTime) then\r\n" +
" MessageDateTime := Now;\r\n" +
" Result := MessageDateTime;\r\n" +
"end;\r\n" +
"\r\n" +
"function DateTimeToNumericDateWithTime(iValue: TDateTime): ShortString;\r\n" +
"var\r\n" +
" vHours, vMinutes, vSeconds, vMillis: Word;\r\n" +
"begin\r\n" +
" DecodeTime(iValue, vHours, vMinutes, vSeconds, vMillis);\r\n" +
" Result := DateTimeToNumericDate(iValue) + Chr(vHours) + Chr(vMinutes);\r\n" +
"end;\r\n" +
"\r\n" +
"function YYYYMMDDToTDateTime(iYYYYMMDD: AnsiString): TDateTime;\r\n" +
"begin\r\n" +
" Result := NumericDateToDateTime(YYYYMMDDtoNumericDate(iYYYYMMDD));\r\n" +
"end;\r\n" +
"\r\n" +
"function HHMMToTTime(iHHMM: AnsiString): TDateTime;\r\n" +
"begin\r\n" +
" Result := TimeOf(DDHHMMToTDateTime('01' + iHHMM));\r\n" +
"end;\r\n" +
"\r\n" +
"initialization\r\n" +
" // Default to always use UTC time\r\n" +
" TimeIsUTCBased(true);\r\n" +
"{ TODO -oMPL : Copied from DRB DateTime }\r\n" +
" coMaxDate := EncodeDate(9999, 12, 31);\r\n" +
" if IsFakeDateEnabled then\r\n" +
" FakeDate;\r\n" +
"end. // Unit DateTime\r\n" +
"\r\n" +
"\r\n";
#endregion
TestGetUnits(cDateTime,
new string[] {"SysUtils", "Classes", "Math", "Windows"},
new string[] {"Mystd", "Forms", "Dialogs", "DateUtils"});
}
[Test]
public void GetUnits_Login()
{
#region (Test value)
const string cLogin =
"interface\r\n" +
"\r\n" +
"uses\r\n" +
" Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,\r\n" +
" Dialogs,\r\n" +
" MYSTD, DATETIME, OPERio, TimeSync, AdminOptionsInfo, ChangePassword,\r\n" +
" DRBCryptography, codeio, GDeclare, Errorsio, FILEVIEW, {TraditionalLoginFrm,}\r\n" +
" GuggenheimLoginFrm;\r\n" +
"\r\n" +
"type\r\n" +
"// TDefaultLoginForm = TTraditionalLoginForm;\r\n" +
" TDefaultLoginForm = TGuggenheimLoginForm;\r\n" +
"\r\n" +
" TLogin = class(TInterfacedObject)\r\n" +
" private\r\n" +
" FAdminOptionsInfoRec :TPasswordOptionsInfoRec;\r\n" +
" FNoNeedToValidate :Boolean;\r\n" +
" FUserID: string[4];\r\n" +
" FCheckDPMAIL :boolean;\r\n" +
" FirstTime :boolean;\r\n" +
" procedure ShowDPMAIL(OperatorRecord: OperatorRecordType);\r\n" +
" procedure SetDataPath(const Value: AnsiString);\r\n" +
" private\r\n" +
" FSigninForm: TForm;\r\n" +
" FSigninFormClass: TFormClass;\r\n" +
" procedure SetSigninFormClass(const Value: TFormClass);\r\n" +
" protected\r\n" +
" function SignInFormNeeded: TForm; virtual;\r\n" +
" function GetPassword: AnsiString;\r\n" +
" function GetCompanyCode: AnsiString;\r\n" +
" function GetLocalDisk: AnsiString;\r\n" +
" function GetMasterDisk: AnsiString;\r\n" +
" function GetMasterExeDisk: AnsiString;\r\n" +
" function GetOperatorId: AnsiString;\r\n" +
" function GetSystemName: AnsiString;\r\n" +
" function GetWorkstation: AnsiString;\r\n" +
" function GetDataDisk: AnsiString;\r\n" +
" procedure SetPassword(const Value: AnsiString);\r\n" +
" procedure SetCompanyCode(const Value: AnsiString);\r\n" +
" procedure SetLocalDisk(const Value: AnsiString);\r\n" +
" procedure SetMasterDisk(const Value: AnsiString);\r\n" +
" procedure SetMasterExeDisk(const Value: AnsiString);\r\n" +
" procedure SetOperatorId(const Value: AnsiString);\r\n" +
" procedure SetSystemName(const Value: AnsiString);\r\n" +
" procedure SetWorkstation(const Value: AnsiString);\r\n" +
" procedure SetDataDisk(const Value: AnsiString);\r\n" +
" function MissingData: boolean;\r\n" +
" function GetDataPath: AnsiString;\r\n" +
" function CalcDataPath :ShortString;\r\n" +
" procedure FocusField(Field: AnsiString); virtual;\r\n" +
" function OtherChecks :boolean; virtual;\r\n" +
" function CheckPasswordRules(var OperInfoRec :OPERATORRecordType) :boolean;\r\n" +
" procedure ProcessFieldError(Field, ErrorMessage: AnsiString); virtual;\r\n" +
" procedure SetCheckDPMAIL(Value: Boolean);\r\n" +
" property Password: AnsiString read GetPassword write SetPassword;\r\n" +
" property CompanyCode: AnsiString read GetCompanyCode write SetCompanyCode;\r\n" +
" property Workstation: AnsiString read GetWorkstation write SetWorkstation;\r\n" +
" property MasterExeDisk: AnsiString read GetMasterExeDisk write SetMasterExeDisk;\r\n" +
" property MasterDisk: AnsiString read GetMasterDisk write SetMasterDisk;\r\n" +
" property LocalDisk: AnsiString read GetLocalDisk write SetLocalDisk;\r\n" +
" property SystemName: AnsiString read GetSystemName write SetSystemName;\r\n" +
" property OperatorId: AnsiString read GetOperatorId write SetOperatorId;\r\n" +
" property DataDisk: AnsiString read GetDataDisk write SetDataDisk;\r\n" +
" property NoNeedToValidate: Boolean read FNoNeedToValidate write FNoNeedToValidate;\r\n" +
" property DataPath: AnsiString read GetDataPath write SetDataPath;\r\n" +
" procedure Initialize;\r\n" +
" procedure VerifyPassword;\r\n" +
" public\r\n" +
" AOK :boolean;\r\n" +
" constructor Create(const SigninFormClass: TFormClass = nil);\r\n" +
" destructor Destroy; override;\r\n" +
" procedure Execute;\r\n" +
" function CheckPassword( Password :shortstring;\r\n" +
" OperInfoRec :OperatorRecordType;\r\n" +
" var PasswordValid :boolean) :ShortString;\r\n" +
" property CheckDPMAIL: Boolean read FCheckDPMAIL write SetCheckDPMAIL;\r\n" +
" property SigninFormClass: TFormClass read FSigninFormClass write SetSigninFormClass;\r\n" +
" end;\r\n" +
"\r\n" +
"function ShowLoginDialog(DoDPMailCheck: Boolean = False): Boolean;\r\n" +
"\r\n" +
"implementation\r\n" +
"\r\n" +
"uses\r\n" +
" CommonTypes, CommonConsts,\r\n" +
" ReceiveMAIL ,\r\n" +
" DMGlobals, LoginFrm;\r\n" +
"\r\n" +
"{$I ERRMSGS.INC}\r\n" +
"\r\n" +
"function ShowLoginDialog(DoDPMailCheck: Boolean = False): Boolean;\r\n" +
"begin\r\n" +
" with TLogin.Create do\r\n" +
" try\r\n" +
" CheckDPMAIL := DoDPMailCheck;\r\n" +
" Execute;\r\n" +
" Result := AOK;\r\n" +
" finally\r\n" +
" Free;\r\n" +
" end;\r\n" +
"end;\r\n" +
"\r\n" +
"{ TLogin }\r\n";
#endregion
TestGetUnits(cLogin,
new string[] {"Windows", "Messages", "SysUtils", "Variants", "Classes", "Graphics", "Controls",
"Forms", "Dialogs", "MYSTD", "DATETIME", "OPERio", "TimeSync", "AdminOptionsInfo", "ChangePassword",
"DRBCryptography", "codeio", "GDeclare", "Errorsio", "FILEVIEW", "GuggenheimLoginFrm"},
new string[] {"CommonTypes", "CommonConsts", "ReceiveMAIL", "DMGlobals", "LoginFrm"});
}
[Test]
public void GetUnits_Mqin_zzz()
{
#region (Test value)
const string cMqin_zzz =
"{*******************************************************************\r\n" +
"$History: Mqin_zzz.pas $\r\n" +
"//\r\n" +
"// ***************** Version 17 *****************\r\n" +
"// User: 893894 Date: 1/09/06 Time: 2:01p\r\n" +
"// Updated in $/_Patch_Staging/5.4.0/U\r\n" +
"// Never call FindClose without corresponding FindFirst. It causes serious\r\n" +
"// problems because FindClose tries to free some resources that have not\r\n" +
"// been allocated.\r\n" +
"//\r\n" +
"// ***************** Version 15 *****************\r\n" +
"// User: 899482 Date: 6/01/05 Time: 12:37a\r\n" +
"// Updated in $/DISPMGR/5.3/U\r\n" +
"// Remove global declaration of CodeRecord from GDCL_ALL (HAL 57104)\r\n" +
"//\r\n" +
"// ***************** Version 13 *****************\r\n" +
"// User: Dmscm Date: 8/09/04 Time: 4:23p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// ASD Enhancement (ANZ 87743)\r\n" +
"//\r\n" +
"// ***************** Version 12 *****************\r\n" +
"// User: 899469 Date: 4/01/04 Time: 11:59p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Modified GetTransactions to process AMDAR documents (JZA 66709)\r\n" +
"//\r\n" +
"// ***************** Version 11 *****************\r\n" +
"// User: 618382 Date: 3/05/04 Time: 2:51p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Fixed CommDrvr Crash when an .err file exists in EIA SITA format\r\n" +
"// message(EIA 68049)\r\n" +
"//\r\n" +
"// ***************** Version 10 *****************\r\n" +
"// User: 618382 Date: 2/12/04 Time: 2:23p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Added procedure MoveSitaFileToIATAFolder(68049,77312 EIA)\r\n" +
"//\r\n" +
"// ***************** Version 9 *****************\r\n" +
"// User: 618382 Date: 1/20/04 Time: 3:23p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Changed StrToInt to StrToIntDef(SBG 71732)\r\n" +
"//\r\n" +
"// ***************** Version 8 *****************\r\n" +
"// User: 618382 Date: 10/10/03 Time: 12:59p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Functionality added to do Automatic Schedule load\r\n" +
"//\r\n" +
"// ***************** Version 7 *****************\r\n" +
"// User: 899480 Date: 9/19/03 Time: 6:25p\r\n" +
"// Updated in $/DISPMGR/_AllSource/U\r\n" +
"// Remove reference to EAGLE and AIRPATH (DDTS 69217)\r\n" +
"//\r\n" +
"// ***************** Version 6 *****************\r\n" +
"// User: 618382 Date: 7/28/03 Time: 4:52p\r\n" +
"// Updated in $/AP360T/_AllSource/U\r\n" +
"// Added EIA SITA message type processing\r\n" +
"//\r\n" +
"// ***************** Version 5 *****************\r\n" +
"// User: 982760 Date: 5/22/03 Time: 12:14a\r\n" +
"// Updated in $/AP360T/_AllSource/U\r\n" +
"// Correction to CPA's Email to MSSend. (2244 CPA)\r\n" +
"//\r\n" +
"// ***************** Version 4 *****************\r\n" +
"// User: 982760 Date: 11/19/02 Time: 7:06p\r\n" +
"// Updated in $/FP1/_AllSource/U\r\n" +
"// Merged with V3.6.3 - KB\r\n" +
"//\r\n" +
"// ***************** Version 3 *****************\r\n" +
"// User: 899480 Date: 11/06/02 Time: 5:27p\r\n" +
"// Updated in $/FP1/_AllSource/U\r\n" +
"// Add logic to receive Email messages from EmailInPath and\r\n" +
"// output to EmailOutPath (CPAMerge-SL).\r\n" +
" *\r\n" +
" * ***************** Version 2 *****************\r\n" +
" * User: 982760 Date: 4/24/02 Time: 6:38a\r\n" +
" * Updated in $/FP1/FDCOMM/U\r\n" +
" * Merged - KB\r\n" +
"//\r\n" +
"// ***************** Version 19 *****************\r\n" +
"// User: Wek Date: 10/15/01 Time: 1:37p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Hermes ACARS interface(AWE1635).\r\n" +
"//\r\n" +
"// ***************** Version 18 *****************\r\n" +
"// User: Wek Date: 4/20/00 Time: 11:46a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Added processing of Canadian NOTAMS. (WJA 694)\r\n" +
"//\r\n" +
"// ***************** Version 17 *****************\r\n" +
"// User: Jmk Date: 11/30/99 Time: 10:32a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Kerry's 30 Nov 99 update\r\n" +
"//\r\n" +
"// ***************** Version 16 *****************\r\n" +
"// User: Jmk Date: 7/29/99 Time: 2:02p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Kerry's 29Jul99 update\r\n" +
"//\r\n" +
"// ***************** Version 15 *****************\r\n" +
"// User: Jmk Date: 7/19/99 Time: 9:26a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Kerry Update 19Jul99\r\n" +
"//\r\n" +
"// ***************** Version 14 *****************\r\n" +
"// User: Jmk Date: 6/25/99 Time: 11:32a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// OAS 25Jun99 Updates from Kerry\r\n" +
"//\r\n" +
"// ***************** Version 13 *****************\r\n" +
"// User: Jmk Date: 6/02/99 Time: 11:43a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Updates from Kerry 1 jun 99\r\n" +
"//\r\n" +
"// ***************** Version 12 *****************\r\n" +
"// User: Jmk Date: 5/04/99 Time: 1:50p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// OAS changes may 5 1999\r\n" +
"//\r\n" +
"// ***************** Version 11 *****************\r\n" +
"// User: Jmk Date: 4/20/99 Time: 3:06p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Kerry update apr20 99\r\n" +
"//\r\n" +
"// ***************** Version 10 *****************\r\n" +
"// User: Wek Date: 2/22/99 Time: 1:07p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// OAS Washington Resync\r\n" +
"//\r\n" +
"// ***************** Version 9 *****************\r\n" +
"// User: Wek Date: 1/07/99 Time: 3:58p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// dRb 837 Remove all hardcoding of \\EAGLE\\ and use SystemPath field from\r\n" +
"// GDECLARE\r\n" +
"//\r\n" +
"// ***************** Version 8 *****************\r\n" +
"// User: Wek Date: 9/23/98 Time: 2:11p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Ron's Labor Day Update\r\n" +
"//\r\n" +
"// ***************** Version 7 *****************\r\n" +
"// User: Wek Date: 7/04/98 Time: 6:09p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// REG Independence Day Synchronization\r\n" +
"//\r\n" +
"// ***************** Version 6 *****************\r\n" +
"// User: Wek Date: 5/24/98 Time: 6:32p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// Ron's Memorial Day Offering\r\n" +
"//\r\n" +
"// ***************** Version 5 *****************\r\n" +
"// User: Imp Date: 4/02/98 Time: 4:18p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// oas files 4-2-98\r\n" +
"//\r\n" +
"// ***************** Version 4 *****************\r\n" +
"// User: Imp Date: 2/05/98 Time: 9:53a\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// RG changes sent 02-05-98\r\n" +
"//\r\n" +
"// ***************** Version 3 *****************\r\n" +
"// User: Shl Date: 1/08/98 Time: 4:52p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// RG-OASNEW Changes sent on 02-01-98\r\n" +
"//\r\n" +
"// ***************** Version 2 *****************\r\n" +
"// User: Imp Date: 12/16/97 Time: 4:48p\r\n" +
"// Updated in $/GUI/eaglegui/u\r\n" +
"// dRb72 Added History stamp\r\n" +
"*******************************************************************}\r\n" +
"Unit MQIN_ZZZ;\r\n" +
"\r\n" +
"Interface\r\n" +
"\r\n" +
"uses\r\n" +
" Windows,\r\n" +
" Classes,\r\n" +
" SysUtils,\r\n" +
" Dialogs;\r\n" +
"\r\n" +
"\r\n" +
"{BEGIN COMMENTS\r\n" +
"\r\n" +
"TITLE: System Message Transmitter and Receiver for ANZ teletype messages\r\n" +
"\r\n" +
"PURPOSE:\r\n" +
"\r\n" +
"History\r\n" +
" DATE WHO VER DESCRIPTION\r\n" +
" ====== === === =========================================================\r\n" +
" 22Sep00 KB Handle Graphical files in TRAN\r\n" +
" 21Jul99 KB 2.63 Ignore AFTN Check messages\r\n" +
" 05Jul99 KB 2.62 Process X25 Sita messages through SITA processing rather than IATA\r\n" +
" 10Jun99 KB 2.61 If files a Tran Directory needs to go through the Scansmi processing\r\n" +
" in RECV then write them to a SCAN subdirectory of TranoutPath.\r\n" +
" 22Apr99 KB 2.60 Ignore zero length TRAN messages.\r\n" +
" 21Apr99 KB 2.59 Change the way we ensure each part is for the same schedule\r\n" +
" 12Apr99 KB 2.58 Ansett to use Air NZ format Schedules\r\n" +
" 31Mar99 KB 2.57 Default TranMsgtype to blank if not 3 chars after the '.'\r\n" +
" 2Feb99 TD 2.56 Provide for Code Record Specification of the OPMET\r\n" +
" Source Directory\r\n" +
" 27Jan99 TD 2.55 Extract OPMET Messages and Write as Transactions Out\r\n" +
" 26Jan99 TD 2.54 Retain last char of Transaction file name for\r\n" +
" Ansett message type identification\r\n" +
" Disable DuplicateMessageCheck for Transactions\r\n" +
" 01Jan99 KB 2.53 Added CheckCircuitSequenceNo for all circuits. Uses MQIN_ZZZ\r\n" +
" ..../ORIG. alternateCode.\r\n" +
" 30Dec98 TD 2.53 Use Global Variable 'SystemPath' Instead of ':\\EAGLE\\'\r\n" +
" 22Jun98 KB 2.52 Removed CheckCarinaCircuitSequenceNo\r\n" +
" 4Jun98 KB 2.51 Changes for processing Schedule files for the ICOC project\r\n" +
" 1May98 KB 2.50 If a message has an envelope, strip it off and then process the\r\n" +
" message in the format of the enveloped message.\r\n" +
" 28Apr98 KB 2.49 Don't check for duplicate or add to savemsgs if Sita message\r\n" +
" has echo status of 'S'.\r\n" +
" 20Apr98 KB 2.48 Allow for multiple input directories. These are defined in\r\n" +
" MQIN_ZZZ code records. eg IATA/ORIG1, IATA/ORIG2, ...\r\n" +
" 8Apr98 KB 2.47 Use FindOldestFile to process in the correct order\r\n" +
" 17Mar98 KB 2.46 Changes for filtering out duplicate messages\r\n" +
" 3Feb98 KB 2.45 Change Code Record CodeReference from RECV_ZZZ to COMMDRVR\r\n" +
" 11Aug97 TD 2.44 Corection to Error Locating POSWX KeyWord.\r\n" +
"END COMMENTS}\r\n" +
"\r\n" +
"Procedure MQIN_ZZZMainProcedure;\r\n" +
"\r\n" +
"Implementation\r\n" +
"\r\n" +
"Uses\r\n" +
" AMDARMsgIO, CommonConsts, CommonTypes, DMGlobals, GDeclare,\r\n" +
" GDCL_ALL, DateTime, MySTD, Codeio, CARINAio, MMATEZZZ, {AFTN Message Mate Handler....}\r\n" +
" QIO_AAA, OPMETAAA, POSTLOG, QMSGDESK, QMSGRESP, OASFiles, oCOMMCTL,\r\n" +
" FILEUNIT, GATEWYio, CompList, SCHFiles, FileCtrl, FunctionalityProvider,\r\n" +
" FunctionalityInterface, FlightWxImagesFunctionalityInterface, MessageTypeRecognizer;\r\n" +
"\r\n" +
"Const\r\n" +
" ProgramName = 'MQIN_ZZZ';\r\n" +
" ProgramVersion = '2.61';\r\n" +
" MaxSITAElapsedTime = 5;\r\n" +
"\r\n";
#endregion
TestGetUnits(cMqin_zzz,
new string[] {"Windows", "Classes", "SysUtils", "Dialogs"},
new string[] {"AMDARMsgIO", "CommonConsts", "CommonTypes", "DMGlobals", "GDeclare",
"GDCL_ALL", "DateTime", "MySTD", "Codeio", "CARINAio", "MMATEZZZ", "QIO_AAA", "OPMETAAA",
"POSTLOG", "QMSGDESK", "QMSGRESP", "OASFiles", "oCOMMCTL", "FILEUNIT", "GATEWYio",
"CompList", "SCHFiles", "FileCtrl", "FunctionalityProvider", "FunctionalityInterface",
"FlightWxImagesFunctionalityInterface", "MessageTypeRecognizer"});
}
[Test]
public void GetUnits_Log4D()
{
#region (Test value)
const string cLog4D =
"unit Log4D;\r\n" +
"\r\n" +
"{\r\n" +
" Logging for Delphi.\r\n" +
" Based on log4j Java package from Apache\r\n" +
" (http://jakarta.apache.org/log4j/docs/index.html).\r\n" +
" Currently based on log4j 1.2.8.\r\n" +
"\r\n" +
" Written by Keith Wood (kbwood@iprimus.com.au).\r\n" +
" Version 1.0 - 29 April 2001.\r\n" +
" Version 1.2 - 9 September 2003.\r\n" +
" Version 1.3 - 24 July 2004.\r\n" +
" Version 1.4 - 19 January 2007.\r\n" +
"}\r\n" +
"\r\n" +
"interface\r\n" +
"\r\n" +
"{$H+}\r\n" +
"\r\n" +
"{$IFDEF VER130} { Delphi 5 }\r\n" +
"{$DEFINE DELPHI5}\r\n" +
"{$DEFINE DELPHI4_UP}\r\n" +
"{$DEFINE DELPHI5_UP}\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"{$IFDEF VER140} { Delphi 6 }\r\n" +
"{$DEFINE DELPHI6}\r\n" +
"{$DEFINE DELPHI4_UP}\r\n" +
"{$DEFINE DELPHI5_UP}\r\n" +
"{$DEFINE DELPHI6_UP}\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"{$IFDEF VER150} { Delphi 7 }\r\n" +
"{$DEFINE DELPHI7}\r\n" +
"{$DEFINE DELPHI4_UP}\r\n" +
"{$DEFINE DELPHI5_UP}\r\n" +
"{$DEFINE DELPHI6_UP}\r\n" +
"{$DEFINE DELPHI7_UP}\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"{$IFDEF VER180} { Delphi 2006 }\r\n" +
"{$DEFINE DELPHI7}\r\n" +
"{$DEFINE DELPHI4_UP}\r\n" +
"{$DEFINE DELPHI5_UP}\r\n" +
"{$DEFINE DELPHI6_UP}\r\n" +
"{$DEFINE DELPHI7_UP}\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"uses\r\n" +
" Classes,\r\n" +
"{$IFDEF LINUX}\r\n" +
" SyncObjs,\r\n" +
"{$ELSE}\r\n" +
" Windows, Winsock,\r\n" +
"{$ENDIF}\r\n" +
"{$IFDEF DELPHI5_UP}\r\n" +
" Contnrs,\r\n" +
"{$ENDIF}\r\n" +
" SysUtils;\r\n" +
"\r\n" +
"const\r\n" +
" Log4DVersion = '1.4';\r\n" +
"\r\n" +
" { Default pattern string for log output.\r\n" +
" Shows the application supplied message. }\r\n" +
" DefaultPattern = '%m%n';\r\n" +
" { A conversion pattern equivalent to the TTCC layout.\r\n" +
" Shows runtime, thread, level, logger, NDC, and message. }\r\n" +
" TTCCPattern = '%r [%t] %p %c %x - %m%n';\r\n" +
"\r\n" +
" { Common prefix for option names in an initialisation file.\r\n" +
" Note that the search for all option names is case sensitive. }\r\n" +
" KeyPrefix = 'log4d';\r\n" +
" { Specify the additivity of a logger's appenders. }\r\n" +
" AdditiveKey = KeyPrefix + '.additive.';\r\n" +
" { Define a named appender. }\r\n" +
" AppenderKey = KeyPrefix + '.appender.';\r\n" +
" { Nominate a factory to use to generate loggers.\r\n" +
" This factory must have been registered with RegisterLoggerFactory.\r\n" +
" If none is specified, then the default factory is used. }\r\n" +
" LoggerFactoryKey = KeyPrefix + '.loggerFactory';\r\n" +
" { Define a new logger, and set its logging level and appenders. }\r\n" +
" LoggerKey = KeyPrefix + '.logger.';\r\n" +
" { Defining this value as true makes log4d print internal debug\r\n" +
" statements to debug output. }\r\n" +
" DebugKey = KeyPrefix + '.configDebug';\r\n" +
" { Specify the error handler to be used with an appender. }\r\n" +
" ErrorHandlerKey = '.errorHandler';\r\n" +
" { Specify the filters to be used with an appender. }\r\n" +
" FilterKey = '.filter';\r\n" +
" { Specify the layout to be used with an appender. }\r\n" +
" LayoutKey = '.layout';\r\n" +
" { Associate an object renderer with the class to be rendered. }\r\n" +
" RendererKey = KeyPrefix + '.renderer.';\r\n" +
" { Set the logging level and appenders for the root. }\r\n" +
" RootLoggerKey = KeyPrefix + '.rootLogger';\r\n" +
" { Set the overall logging level. }\r\n" +
" ThresholdKey = KeyPrefix + '.threshold';\r\n" +
"\r\n" +
" { Special level value signifying inherited behaviour. }\r\n" +
" InheritedLevel = 'inherited';\r\n" +
"\r\n" +
" { Accept option for TLog*Filter. }\r\n" +
" AcceptMatchOpt = 'acceptOnMatch';\r\n" +
" { Appending option for TLogFileAppender. }\r\n" +
" AppendOpt = 'append';\r\n" +
" { Common date format option for layouts. }\r\n" +
" DateFormatOpt = 'dateFormat';\r\n" +
" { File name option for TLogFileAppender. }\r\n" +
" FileNameOpt = 'fileName';\r\n" +
" { Case-sensitivity option for TLogStringFilter. }\r\n" +
" IgnoreCaseOpt = 'ignoreCase';\r\n" +
" { Match string option for TLogLevelMatchFilter and TLogStringFilter. }\r\n" +
" MatchOpt = 'match';\r\n" +
" { Maximum string option for TLogLevelRangeFilter. }\r\n" +
" MaxOpt = 'maximum';\r\n" +
" { Minimum string option for TLogLevelRangeFilter. }\r\n" +
" MinOpt = 'minimum';\r\n" +
" { Pattern option for TLogPatternLayout. }\r\n" +
" PatternOpt = 'pattern';\r\n" +
" { Title option for TLogHTMLLayout. }\r\n" +
" TitleOpt = 'title';\r\n" +
"\r\n" +
"type\r\n" +
"{$IFDEF DELPHI4}\r\n" +
" TClassList = TList;\r\n" +
" TObjectList = TList;\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"{$IFDEF LINUX}\r\n" +
" TRTLCriticalSection = TCriticalSection;\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
" { Log-specific exceptions. }\r\n" +
" ELogException = class(Exception);\r\n" +
"\r\n" +
" { Allow for initialisation of a dynamically created object. }\r\n" +
" ILogDynamicCreate = interface(IUnknown)\r\n" +
" ['{287DAA34-3A9F-45C6-9417-1B0D4DFAC86C}']\r\n" +
" procedure Init;\r\n" +
" end;\r\n" +
"\r\n" +
" { Get/set arbitrary options on an object. }\r\n" +
" ILogOptionHandler = interface(ILogDynamicCreate)\r\n" +
" ['{AC1C0E30-2DBF-4C55-9C2E-9A0F1A3E4F58}']\r\n" +
" function GetOption(const Name: string): string;\r\n" +
" procedure SetOption(const Name, Value: string);\r\n" +
" property Options[const Name: string]: string Read GetOption Write SetOption;\r\n" +
" procedure OnSetOptionsComplete;\r\n" +
" end;\r\n" +
"\r\n" +
" { Base class for handling options. }\r\n" +
" TLogOptionHandler = class(TInterfacedObject, ILogOptionHandler)\r\n" +
" private\r\n" +
" FOptions: TStringList;\r\n" +
" protected\r\n" +
" function GetOption(const Name: string): string; virtual;\r\n" +
" procedure SetOption(const Name, Value: string); virtual;\r\n" +
" procedure OnSetOptionsComplete; virtual;\r\n" +
" public\r\n" +
" constructor Create; virtual;\r\n" +
" destructor Destroy; override;\r\n" +
" property Options[const Name: string]: string Read GetOption Write SetOption;\r\n" +
" procedure Init; virtual;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Levels ----------------------------------------------------------------------}\r\n" +
"\r\n" +
" { Levels of messages for logging.\r\n" +
" The Level property identifies increasing severity of messages.\r\n" +
" All those above or equal to a particular setting are logged. }\r\n" +
" TLogLevel = class(TObject)\r\n" +
" private\r\n" +
" FLevel: integer;\r\n" +
" FName: string;\r\n" +
" protected\r\n" +
" constructor Create(Name: string; Level: integer);\r\n" +
" public\r\n" +
" property Level: integer Read FLevel;\r\n" +
" property Name: string Read FName;\r\n" +
" function IsGreaterOrEqual(LogLevel: TLogLevel): boolean;\r\n" +
" { Retrieve a level object given its level. }\r\n" +
" class function GetLevel(LogLevel: integer): TLogLevel; overload;\r\n" +
" { Retrieve a level object given its level, or default if not valid. }\r\n" +
" class function GetLevel(LogLevel: integer; DefaultLevel: TLogLevel): TLogLevel;\r\n" +
" overload;\r\n" +
" { Retrieve a level object given its name. }\r\n" +
" class function GetLevel(Name: string): TLogLevel; overload;\r\n" +
" { Retrieve a level object given its name, or default if not valid. }\r\n" +
" class function GetLevel(Name: string; DefaultLevel: TLogLevel): TLogLevel;\r\n" +
" overload;\r\n" +
" end;\r\n" +
"\r\n" +
"const\r\n" +
" { Levels of logging as integer values. }\r\n" +
" OffValue = High(integer);\r\n" +
" FatalValue = 50000;\r\n" +
" ErrorValue = 40000;\r\n" +
" WarnValue = 30000;\r\n" +
" InfoValue = 20000;\r\n" +
" DebugValue = 10000;\r\n" +
" AllValue = Low(integer);\r\n" +
"\r\n" +
"var\r\n" +
" { Standard levels are automatically created (in decreasing severity):\r\n" +
" Off, Fatal, Error, Warn, Info, Debug, All. }\r\n" +
" Off: TLogLevel;\r\n" +
" Fatal: TLogLevel;\r\n" +
" Error: TLogLevel;\r\n" +
" Warn: TLogLevel;\r\n" +
" Info: TLogLevel;\r\n" +
" Debug: TLogLevel;\r\n" +
" All: TLogLevel;\r\n" +
"\r\n" +
"{ NDC -------------------------------------------------------------------------}\r\n" +
"\r\n" +
"type\r\n" +
" { Keep track of the nested diagnostic context (NDC). }\r\n" +
" TLogNDC = class(TObject)\r\n" +
" private\r\n" +
" class function GetNDCIndex: integer;\r\n" +
" class function GetThreadId: string;\r\n" +
" public\r\n" +
" class procedure Clear;\r\n" +
" class procedure CloneStack(const Context: TStringList);\r\n" +
" class function GetDepth: integer;\r\n" +
" class procedure Inherit(const Context: TStringList);\r\n" +
" class function Peek: string;\r\n" +
" class function Pop: string;\r\n" +
" class procedure Push(const Context: string);\r\n" +
" class procedure Remove;\r\n" +
" class procedure SetMaxDepth(const MaxDepth: integer);\r\n" +
" end;\r\n" +
"\r\n" +
"{ Events ----------------------------------------------------------------------}\r\n" +
"\r\n" +
" TLogLogger = class;\r\n" +
"\r\n" +
" { An event to be logged. }\r\n" +
" TLogEvent = class(TPersistent)\r\n" +
" private\r\n" +
" FError: Exception;\r\n" +
" FLevel: TLogLevel;\r\n" +
" FLogger: TLogLogger;\r\n" +
" FMessage: string;\r\n" +
" FTimeStamp: TDateTime;\r\n" +
" FFileName: string;\r\n" +
" FMethod: string;\r\n" +
" function GetElapsedTime: longint;\r\n" +
" function GetErrorClass: string;\r\n" +
" function GetErrorMessage: string;\r\n" +
" function GetLoggerName: string;\r\n" +
" function GetNDC: string;\r\n" +
" function GetThreadId: longint;\r\n" +
" function GetProcessId: longint;\r\n" +
" public\r\n" +
" constructor Create(const Logger: TLogLogger; const Level: TLogLevel; const FileName, Method, Message: string; const Err: Exception; const TimeStamp: TDateTime = 0); overload;\r\n" +
" constructor Create(const Logger: TLogLogger; const Level: TLogLevel; const FileName, Method: string; const Message: TObject; const Err: Exception; const TimeStamp: TDateTime = 0); overload;\r\n" +
" property ElapsedTime: longint Read GetElapsedTime;\r\n" +
" property Error: Exception Read FError;\r\n" +
" property ErrorClass: string Read GetErrorClass;\r\n" +
" property ErrorMessage: string Read GetErrorMessage;\r\n" +
" property Level: TLogLevel Read FLevel;\r\n" +
" property LoggerName: string Read GetLoggerName;\r\n" +
" property Message: string Read FMessage;\r\n" +
" property NDC: string Read GetNDC;\r\n" +
" property ThreadId: longint Read GetThreadId;\r\n" +
" property ProcessId: longint Read GetProcessId;\r\n" +
" property TimeStamp: TDateTime Read FTimeStamp;\r\n" +
" property FileName: string Read FFileName;\r\n" +
" property Method: string Read FMethod;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Logger factory --------------------------------------------------------------}\r\n" +
"\r\n" +
" { Factory for creating loggers. }\r\n" +
" ILogLoggerFactory = interface(IUnknown)\r\n" +
" ['{AEE5E86C-B708-45B2-BEAD-B370D71CAA2F}']\r\n" +
" function MakeNewLoggerInstance(const Name: string): TLogLogger;\r\n" +
" end;\r\n" +
"\r\n" +
" { Default implementation of a logger factory. }\r\n" +
" TLogDefaultLoggerFactory = class(TInterfacedObject, ILogLoggerFactory)\r\n" +
" public\r\n" +
" function MakeNewLoggerInstance(const Name: string): TLogLogger;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Loggers ---------------------------------------------------------------------}\r\n" +
"\r\n" +
" ILogAppender = interface;\r\n" +
" ILogRenderer = interface;\r\n" +
" TLogHierarchy = class;\r\n" +
"\r\n" +
" { This is the central class in the Log4D package. One of the distinctive\r\n" +
" features of Log4D is hierarchical loggers and their evaluation. }\r\n" +
" TLogLogger = class(TLogOptionHandler, ILogOptionHandler)\r\n" +
" private\r\n" +
" FAdditive: boolean;\r\n" +
" FAppenders: TInterfaceList;\r\n" +
" FHierarchy: TLogHierarchy;\r\n" +
" FLevel: TLogLevel;\r\n" +
" FName: string;\r\n" +
" FParent: TLogLogger;\r\n" +
" protected\r\n" +
" FCriticalLogger: TRTLCriticalSection;\r\n" +
" procedure CallAppenders(const Event: TLogEvent);\r\n" +
" procedure CloseAllAppenders;\r\n" +
" function CountAppenders: integer;\r\n" +
" procedure DoLog(const LogLevel: TLogLevel; const FileName, Method, Message: string; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure DoLog(const LogLevel: TLogLevel; const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" function GetLevel: TLogLevel; virtual;\r\n" +
" public\r\n" +
" constructor Create(const Name: string); reintroduce;\r\n" +
" destructor Destroy; override;\r\n" +
" property Additive: boolean Read FAdditive Write FAdditive;\r\n" +
" property Appenders: TInterfaceList Read FAppenders;\r\n" +
" property Hierarchy: TLogHierarchy Read FHierarchy Write FHierarchy;\r\n" +
" property Level: TLogLevel Read GetLevel Write FLevel;\r\n" +
" property Name: string Read FName;\r\n" +
" property Parent: TLogLogger Read FParent;\r\n" +
" procedure AddAppender(const Appender: ILogAppender);\r\n" +
" procedure AssertLog(const Assertion: boolean; const FileName, Method, Message: string); overload;\r\n" +
" procedure AssertLog(const Assertion: boolean; const FileName, Method, Message: string; Params: array of const); overload;\r\n" +
" procedure AssertLog(const Assertion: boolean; const FileName, Method: string; const Message: TObject); overload;\r\n" +
" procedure Debug(const FileName, Method, Message: string; const Err: Exception = nil);\r\n" +
" overload; virtual;\r\n" +
" procedure Debug(const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Debug(const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Error(const FileName, Method, Message: string; const Err: Exception = nil);\r\n" +
" overload; virtual;\r\n" +
" procedure Error(const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Error(const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Fatal(const FileName, Method, Message: string; const Err: Exception = nil);\r\n" +
" overload; virtual;\r\n" +
" procedure Fatal(const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Fatal(const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" function GetAppender(const Name: string): ILogAppender;\r\n" +
" class function GetLogger(const Clazz: TClass; const Factory: ILogLoggerFactory = nil): TLogLogger; overload;\r\n" +
" class function GetLogger(const Name: string; const Factory: ILogLoggerFactory = nil): TLogLogger; overload;\r\n" +
" class function GetRootLogger: TLogLogger;\r\n" +
" procedure Info(const FileName, Method, Message: string; const Err: Exception = nil);\r\n" +
" overload; virtual;\r\n" +
" procedure Info(const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Info(const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" function IsAppender(const Appender: ILogAppender): boolean;\r\n" +
" function IsDebugEnabled: boolean;\r\n" +
" function IsEnabledFor(const LogLevel: TLogLevel): boolean;\r\n" +
" function IsErrorEnabled: boolean;\r\n" +
" function IsFatalEnabled: boolean;\r\n" +
" function IsInfoEnabled: boolean;\r\n" +
" function IsWarnEnabled: boolean;\r\n" +
" procedure LockLogger;\r\n" +
" procedure Log(const LogLevel: TLogLevel; const FileName, Method, Message: string; const Err: Exception = nil); overload;\r\n" +
" procedure Log(const LogLevel: TLogLevel; const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload;\r\n" +
" procedure Log(const LogLevel: TLogLevel; const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload;\r\n" +
" procedure RemoveAllAppenders;\r\n" +
" procedure RemoveAppender(const Appender: ILogAppender); overload;\r\n" +
" procedure RemoveAppender(const Name: string); overload;\r\n" +
" procedure UnlockLogger;\r\n" +
" procedure Warn(const FileName, Method, Message: string; const Err: Exception = nil);\r\n" +
" overload; virtual;\r\n" +
" procedure Warn(const FileName, Method, Message: string; Params: array of const; const Err: Exception = nil); overload; virtual;\r\n" +
" procedure Warn(const FileName, Method: string; const Message: TObject; const Err: Exception = nil); overload; virtual;\r\n" +
" end;\r\n" +
"\r\n" +
" { The specialised root logger - cannot have a nil level. }\r\n" +
" TLogRoot = class(TLogLogger)\r\n" +
" private\r\n" +
" procedure SetLevel(const Level: TLogLevel);\r\n" +
" public\r\n" +
" constructor Create(const Level: TLogLevel);\r\n" +
" property Level: TLogLevel Read GetLevel Write SetLevel;\r\n" +
" end;\r\n" +
"\r\n" +
" { Specialised logger for internal logging. }\r\n" +
" TLogLog = class(TLogLogger)\r\n" +
" private\r\n" +
" FInternalDebugging: boolean;\r\n" +
" protected\r\n" +
" procedure DoLog(const LogLevel: TLogLevel; const FileName, Method, Message: string; const Err: Exception); override;\r\n" +
" procedure DoLog(const LogLevel: TLogLevel; const FileName, Method: string; const Message: TObject; const Err: Exception); override;\r\n" +
" public\r\n" +
" constructor Create;\r\n" +
" property InternalDebugging: boolean Read FInternalDebugging Write FInternalDebugging;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Hierarchy -------------------------------------------------------------------}\r\n" +
"\r\n" +
" { Listen to events occuring within a hierarchy. }\r\n" +
" ILogHierarchyEventListener = interface\r\n" +
" ['{A216D50F-B9A5-4871-8EE3-CB55C41E138B}']\r\n" +
" procedure AddAppenderEvent(const Logger: TLogLogger; const Appender: ILogAppender);\r\n" +
" procedure RemoveAppenderEvent(const Logger: TLogLogger; const Appender: ILogAppender);\r\n" +
" end;\r\n" +
"\r\n" +
" { This class is specialised in retreiving loggers by name and\r\n" +
" also maintaining the logger hierarchy.\r\n" +
"\r\n" +
" The casual user should not have to deal with this class directly.\r\n" +
"\r\n" +
" The structure of the logger hierachy is maintained by the GetInstance\r\n" +
" method. The hierarchy is such that children link to their parent but\r\n" +
" parents do not have any pointers to their children. Moreover, loggers\r\n" +
" can be instantiated in any order, in particular descendant before ancestor.\r\n" +
"\r\n" +
" In case a descendant is created before a particular ancestor, then it creates\r\n" +
" an empty node for the ancestor and adds itself to it. Other descendants\r\n" +
" of the same ancestor add themselves to the previously created node. }\r\n" +
" TLogHierarchy = class(TObject)\r\n" +
" private\r\n" +
" FEmittedNoAppenderWarning: boolean;\r\n" +
" FListeners: TInterfaceList;\r\n" +
" FLoggers: TStringList;\r\n" +
" FRenderedClasses: TClassList;\r\n" +
" FRenderers: TInterfaceList;\r\n" +
" FRoot: TLogLogger;\r\n" +
" FThreshold: TLogLevel;\r\n" +
" procedure SetThreshold(const Level: TLogLevel); overload;\r\n" +
" procedure UpdateParent(const Logger: TLogLogger);\r\n" +
" protected\r\n" +
" FCriticalHierarchy: TRTLCriticalSection;\r\n" +
" public\r\n" +
" constructor Create(Root: TLogLogger);\r\n" +
" destructor Destroy; override;\r\n" +
" property Root: TLogLogger Read FRoot;\r\n" +
" property Threshold: TLogLevel Read FThreshold Write SetThreshold;\r\n" +
" procedure AddHierarchyEventListener(const Listener: ILogHierarchyEventListener);\r\n" +
" procedure AddRenderer(RenderedClass: TClass; Renderer: ILogRenderer);\r\n" +
" procedure Clear;\r\n" +
" procedure EmitNoAppenderWarning(const Logger: TLogLogger);\r\n" +
" function Exists(const Name: string): TLogLogger;\r\n" +
" procedure FireAppenderEvent(const Adding: boolean; const Logger: TLogLogger; const Appender: ILogAppender);\r\n" +
" procedure GetCurrentLoggers(const List: TStringList);\r\n" +
" function GetLogger(const Name: string; const Factory: ILogLoggerFactory = nil): TLogLogger;\r\n" +
" function GetRenderer(const RenderedClass: TClass): ILogRenderer;\r\n" +
" function IsDisabled(const LogLevel: integer): boolean;\r\n" +
" procedure RemoveHierarchyEventListener(const Listener: ILogHierarchyEventListener);\r\n" +
" procedure ResetConfiguration;\r\n" +
" procedure Shutdown;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Layouts ---------------------------------------------------------------------}\r\n" +
"\r\n" +
" { Functional requirements for a layout. }\r\n" +
" ILogLayout = interface(ILogOptionHandler)\r\n" +
" ['{87FDD680-96D7-45A0-A135-CB88ABAD5519}']\r\n" +
" function Format(const Event: TLogEvent): string;\r\n" +
" function GetContentType: string;\r\n" +
" function GetFooter: string;\r\n" +
" function GetHeader: string;\r\n" +
" function IgnoresException: boolean;\r\n" +
" property ContentType: string Read GetContentType;\r\n" +
" property Footer: string Read GetFooter;\r\n" +
" property Header: string Read GetHeader;\r\n" +
" end;\r\n" +
"\r\n" +
" { Abstract base for layouts.\r\n" +
" Subclasses must at least override Format.\r\n" +
"\r\n" +
" Accepts the following options:\r\n" +
"\r\n" +
" # Format for date and time stamps, string, optional, defaults to ShortDateFormat\r\n" +
" # See FormatDateTime function for more details\r\n" +
" log4d.appender.<name>.layout.dateFormat=yyyy/mm/dd hh:nn:ss.zzz\r\n" +
" }\r\n" +
" TLogCustomLayout = class(TLogOptionHandler, ILogDynamicCreate,\r\n" +
" ILogOptionHandler, ILogLayout)\r\n" +
" private\r\n" +
" FDateFormat: string;\r\n" +
" protected\r\n" +
" property DateFormat: string Read FDateFormat Write FDateFormat;\r\n" +
" function GetContentType: string; virtual;\r\n" +
" function GetHeader: string; virtual;\r\n" +
" function GetFooter: string; virtual;\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" property ContentType: string Read GetContentType;\r\n" +
" property Footer: string Read GetFooter;\r\n" +
" property Header: string Read GetHeader;\r\n" +
" function Format(const Event: TLogEvent): string; virtual; abstract;\r\n" +
" function IgnoresException: boolean; virtual;\r\n" +
" procedure Init; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Basic implementation of a layout. }\r\n" +
" TLogSimpleLayout = class(TLogCustomLayout)\r\n" +
" public\r\n" +
" function Format(const Event: TLogEvent): string; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { This layout outputs events in a HTML table.\r\n" +
"\r\n" +
" Accepts the following options:\r\n" +
"\r\n" +
" # Title for HTML page, string, optional\r\n" +
" log4d.appender.<name>.layout.title=Logging Messages\r\n" +
" }\r\n" +
" TLogHTMLLayout = class(TLogCustomLayout)\r\n" +
" private\r\n" +
" FTitle: string;\r\n" +
" protected\r\n" +
" function GetContentType: string; override;\r\n" +
" function GetFooter: string; override;\r\n" +
" function GetHeader: string; override;\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" property Title: string Read FTitle Write FTitle;\r\n" +
" function Format(const Event: TLogEvent): string; override;\r\n" +
" function IgnoresException: boolean; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Layout based on specified pattern.\r\n" +
"\r\n" +
" Accepts the following options:\r\n" +
"\r\n" +
" # Format for rendering the log event, string, optional, defaults to %m%n\r\n" +
" # See comments of Format method for more details\r\n" +
" log4d.appender.<name>.layout.pattern=%r [%t] %p %c %x - %m%n\r\n" +
" }\r\n" +
" TLogPatternLayout = class(TLogCustomLayout)\r\n" +
" private\r\n" +
" FPattern: string;\r\n" +
" FPatternParts: TStringList;\r\n" +
" procedure SetPattern(const Pattern: string);\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" constructor Create(const Pattern: string = DefaultPattern); reintroduce;\r\n" +
" destructor Destroy; override;\r\n" +
" property Pattern: string Read FPattern Write SetPattern;\r\n" +
" function Format(const Event: TLogEvent): string; override;\r\n" +
" procedure Init; override;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Renderers -------------------------------------------------------------------}\r\n" +
"\r\n" +
" { Renderers transform an object into a string message for display. }\r\n" +
" ILogRenderer = interface(ILogOptionHandler)\r\n" +
" ['{169B03C6-E2C7-4F62-AD19-17408AB30681}']\r\n" +
" function Render(const Message: TObject): string;\r\n" +
" end;\r\n" +
"\r\n" +
" { Abstract base class for renderers - handles basic option setting.\r\n" +
" Subclasses must at least override Render. }\r\n" +
" TLogCustomRenderer = class(TLogOptionHandler, ILogDynamicCreate,\r\n" +
" ILogOptionHandler, ILogRenderer)\r\n" +
" public\r\n" +
" function Render(const Message: TObject): string; virtual; abstract;\r\n" +
" end;\r\n" +
"\r\n" +
"{ ErrorHandler ----------------------------------------------------------------}\r\n" +
"\r\n" +
" { Appenders may delegate their error handling to ErrorHandlers.\r\n" +
"\r\n" +
" Error handling is a particularly tedious to get right because by\r\n" +
" definition errors are hard to predict and to reproduce. }\r\n" +
" ILogErrorHandler = interface(ILogOptionHandler)\r\n" +
" ['{B902C52A-5E4E-47A8-B291-BE8E7660F754}']\r\n" +
" procedure SetAppender(const Appender: ILogAppender);\r\n" +
" procedure SetBackupAppender(const BackupAppender: ILogAppender);\r\n" +
" procedure SetLogger(const Logger: TLogLogger);\r\n" +
" { The appender for which errors are handled. }\r\n" +
" property Appender: ILogAppender Write SetAppender;\r\n" +
" { The appender to use in case of failure. }\r\n" +
" property BackupAppender: ILogAppender Write SetBackupAppender;\r\n" +
" { The logger that the failing appender might be attached to. }\r\n" +
" property Logger: TLogLogger Write SetLogger;\r\n" +
" { This method prints the error message passed as a parameter. }\r\n" +
" procedure Error(const Message: string); overload;\r\n" +
" { This method should handle the error. Information about the error\r\n" +
" condition is passed a parameter. }\r\n" +
" procedure Error(const Message: string; const Err: Exception; const ErrorCode: integer; const Event: TLogEvent = nil); overload;\r\n" +
" end;\r\n" +
"\r\n" +
" { Abstract base class for error handlers - handles basic option setting.\r\n" +
" Subclasses must at least override Error. }\r\n" +
" TLogCustomErrorHandler = class(TLogOptionHandler, ILogDynamicCreate,\r\n" +
" ILogOptionHandler, ILogErrorHandler)\r\n" +
" private\r\n" +
" FAppender: ILogAppender;\r\n" +
" FBackupAppender: ILogAppender;\r\n" +
" FLogger: TLogLogger;\r\n" +
" protected\r\n" +
" procedure SetAppender(const Appender: ILogAppender); virtual;\r\n" +
" procedure SetBackupAppender(const BackupAppender: ILogAppender); virtual;\r\n" +
" procedure SetLogger(const Logger: TLogLogger); virtual;\r\n" +
" public\r\n" +
" property Appender: ILogAppender Write SetAppender;\r\n" +
" property BackupAppender: ILogAppender Write SetBackupAppender;\r\n" +
" property Logger: TLogLogger Write SetLogger;\r\n" +
" procedure Error(const Message: string); overload; virtual; abstract;\r\n" +
" procedure Error(const Message: string; const Err: Exception; const ErrorCode: integer; const Event: TLogEvent = nil); overload;\r\n" +
" virtual; abstract;\r\n" +
" end;\r\n" +
"\r\n" +
" { Fallback on an alternative appender if an error arises. }\r\n" +
" TLogFallbackErrorHandler = class(TLogCustomErrorHandler)\r\n" +
" private\r\n" +
" FLoggers: TObjectList;\r\n" +
" protected\r\n" +
" procedure SetLogger(const Logger: TLogLogger); override;\r\n" +
" public\r\n" +
" constructor Create; override;\r\n" +
" destructor Destroy; override;\r\n" +
" procedure Error(const Message: string); overload; override;\r\n" +
" procedure Error(const Message: string; const Err: Exception; const ErrorCode: integer; const Event: TLogEvent = nil); overload;\r\n" +
" override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Displays only the first error sent to it to debugging output. }\r\n" +
" TLogOnlyOnceErrorHandler = class(TLogCustomErrorHandler)\r\n" +
" private\r\n" +
" FSeenError: boolean;\r\n" +
" public\r\n" +
" procedure Error(const Message: string); overload; override;\r\n" +
" procedure Error(const Message: string; const Err: Exception; const ErrorCode: integer; const Event: TLogEvent = nil); overload;\r\n" +
" override;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Filters ---------------------------------------------------------------------}\r\n" +
"\r\n" +
" TLogFilterDecision = (fdDeny, fdNeutral, fdAccept);\r\n" +
"\r\n" +
" { Filters can control to a finer degree of detail which messages get logged. }\r\n" +
" ILogFilter = interface(ILogOptionHandler)\r\n" +
" ['{B28213D7-ACE2-4C44-B820-D9437D44F8DA}']\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision;\r\n" +
" end;\r\n" +
"\r\n" +
" { Abstract base class for filters - handles basic option setting.\r\n" +
" Subclasses must at least override Decide.\r\n" +
"\r\n" +
" Accepts the following options:\r\n" +
"\r\n" +
" # Class identification\r\n" +
" log4d.appender.<name>.filter1=TLogCustomFilter\r\n" +
" # Accept or reject the log event when deciding, Boolean, optional, default true\r\n" +
" log4d.appender.<name>.filter1.acceptOnMatch=true\r\n" +
" }\r\n" +
" TLogCustomFilter = class(TLogOptionHandler, ILogDynamicCreate,\r\n" +
" ILogOptionHandler, ILogFilter)\r\n" +
" private\r\n" +
" FAcceptOnMatch: boolean;\r\n" +
" protected\r\n" +
" property AcceptOnMatch: boolean Read FAcceptOnMatch Write FAcceptOnMatch;\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" constructor Create(const AcceptOnMatch: boolean = True); reintroduce;\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision; virtual;\r\n" +
" abstract;\r\n" +
" end;\r\n" +
"\r\n" +
" { Deny all messages. }\r\n" +
" TLogDenyAllFilter = class(TLogCustomFilter)\r\n" +
" public\r\n" +
" property AcceptOnMatch;\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Filter by the message's level.\r\n" +
"\r\n" +
" Accepts the following options (as well as the standard acceptOnMatch one):\r\n" +
"\r\n" +
" # Class identification\r\n" +
" log4d.appender.<name>.filter1=TLogLevelMatchFilter\r\n" +
" # Logging level to match on, Level, mandatory\r\n" +
" log4d.appender.<name>.filter1.match=warn\r\n" +
" }\r\n" +
" TLogLevelMatchFilter = class(TLogCustomFilter)\r\n" +
" private\r\n" +
" FMatchLevel: TLogLevel;\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" constructor Create(const MatchLevel: TLogLevel; const AcceptOnMatch: boolean = True); reintroduce;\r\n" +
" property AcceptOnMatch;\r\n" +
" property MatchLevel: TLogLevel Read FMatchLevel Write FMatchLevel;\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Filter by the message's level being within a range.\r\n" +
"\r\n" +
" Accepts the following options (as well as the standard acceptOnMatch one):\r\n" +
"\r\n" +
" # Class identification\r\n" +
" log4d.appender.<name>.filter1=TLogLevelRangeFilter\r\n" +
" # Minimum logging level to match on, Level, mandatory\r\n" +
" log4d.appender.<name>.filter1.minimum=warn\r\n" +
" # Maximum logging level to match on, Level, mandatory\r\n" +
" log4d.appender.<name>.filter1.maximum=error\r\n" +
" }\r\n" +
" TLogLevelRangeFilter = class(TLogCustomFilter)\r\n" +
" private\r\n" +
" FMaxLevel: TLogLevel;\r\n" +
" FMinLevel: TLogLevel;\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" constructor Create(const MaxLevel, MinLevel: TLogLevel; const AcceptOnMatch: boolean = True); reintroduce;\r\n" +
" property AcceptOnMatch;\r\n" +
" property MaxLevel: TLogLevel Read FMaxLevel Write FMaxLevel;\r\n" +
" property MinLevel: TLogLevel Read FMinLevel Write FMinLevel;\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Filter by text within the message.\r\n" +
"\r\n" +
" Accepts the following options (as well as the standard acceptOnMatch one):\r\n" +
"\r\n" +
" # Class identification\r\n" +
" log4d.appender.<name>.filter1=TLogStringFilter\r\n" +
" # Text to match on anywhere in message, string, mandatory\r\n" +
" log4d.appender.<name>.filter1.match=xyz\r\n" +
" # Whether match is case-sensitive, Boolean, optional, defaults to false\r\n" +
" log4d.appender.<name>.filter1.ignoreCase=true\r\n" +
" }\r\n" +
" TLogStringFilter = class(TLogCustomFilter)\r\n" +
" private\r\n" +
" FIgnoreCase: boolean;\r\n" +
" FMatch: string;\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" public\r\n" +
" constructor Create(const Match: string; const IgnoreCase: boolean = False; const AcceptOnMatch: boolean = True); reintroduce;\r\n" +
" property AcceptOnMatch;\r\n" +
" property IgnoreCase: boolean Read FIgnoreCase Write FIgnoreCase;\r\n" +
" property Match: string Read FMatch Write FMatch;\r\n" +
" function Decide(const Event: TLogEvent): TLogFilterDecision; override;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Appenders -------------------------------------------------------------------}\r\n" +
"\r\n" +
" { Implement this interface for your own strategies\r\n" +
" for printing log statements. }\r\n" +
" ILogAppender = interface(ILogOptionHandler)\r\n" +
" ['{E1A06EA7-34CA-4DA4-9A8A-C76CF34257AC}']\r\n" +
" procedure AddFilter(const Filter: ILogFilter);\r\n" +
" procedure Append(const Event: TLogEvent);\r\n" +
" procedure Close;\r\n" +
" function GetErrorHandler: ILogErrorHandler;\r\n" +
" function GetFilters: TInterfaceList;\r\n" +
" function GetLayout: ILogLayout;\r\n" +
" function GetName: string;\r\n" +
" procedure RemoveAllFilters;\r\n" +
" procedure RemoveFilter(const Filter: ILogFilter);\r\n" +
" function RequiresLayout: boolean;\r\n" +
" procedure SetErrorHandler(const ErrorHandler: ILogErrorHandler);\r\n" +
" procedure SetLayout(const Layout: ILogLayout);\r\n" +
" procedure SetName(const Name: string);\r\n" +
" property ErrorHandler: ILogErrorHandler Read GetErrorHandler Write SetErrorHandler;\r\n" +
" property Filters: TInterfaceList Read GetFilters;\r\n" +
" property Layout: ILogLayout Read GetLayout Write SetLayout;\r\n" +
" property Name: string Read GetName Write SetName;\r\n" +
" end;\r\n" +
"\r\n" +
" { Basic implementation of an appender for printing log statements.\r\n" +
" Subclasses should at least override DoAppend(string). }\r\n" +
" TLogCustomAppender = class(TLogOptionHandler, ILogDynamicCreate,\r\n" +
" ILogOptionHandler, ILogAppender)\r\n" +
" private\r\n" +
" FClosed: boolean;\r\n" +
" FErrorHandler: ILogErrorHandler;\r\n" +
" FFilters: TInterfaceList;\r\n" +
" FLayout: ILogLayout;\r\n" +
" FName: string;\r\n" +
" function GetErrorHandler: ILogErrorHandler;\r\n" +
" function GetFilters: TInterfaceList;\r\n" +
" function GetLayout: ILogLayout;\r\n" +
" function GetName: string;\r\n" +
" procedure SetErrorHandler(const ErrorHandler: ILogErrorHandler);\r\n" +
" procedure SetLayout(const Layout: ILogLayout);\r\n" +
" procedure SetName(const Name: string);\r\n" +
" protected\r\n" +
" FCriticalAppender: TRTLCriticalSection;\r\n" +
" function CheckEntryConditions: boolean; virtual;\r\n" +
" function CheckFilters(const Event: TLogEvent): boolean; virtual;\r\n" +
" procedure DoAppend(const Event: TLogEvent); overload; virtual;\r\n" +
" procedure DoAppend(const Message: string); overload; virtual; abstract;\r\n" +
" procedure WriteFooter; virtual;\r\n" +
" procedure WriteHeader; virtual;\r\n" +
" public\r\n" +
" constructor Create(const Name: string; const Layout: ILogLayout = nil);\r\n" +
" reintroduce; virtual;\r\n" +
" destructor Destroy; override;\r\n" +
" property ErrorHandler: ILogErrorHandler Read GetErrorHandler Write SetErrorHandler;\r\n" +
" property Filters: TInterfaceList Read GetFilters;\r\n" +
" property Layout: ILogLayout Read GetLayout Write SetLayout;\r\n" +
" property Name: string Read GetName Write SetName;\r\n" +
" procedure AddFilter(const Filter: ILogFilter); virtual;\r\n" +
" procedure Append(const Event: TLogEvent); virtual;\r\n" +
" procedure Close; virtual;\r\n" +
" procedure Init; override;\r\n" +
" procedure RemoveAllFilters; virtual;\r\n" +
" procedure RemoveFilter(const Filter: ILogFilter); virtual;\r\n" +
" function RequiresLayout: boolean; virtual;\r\n" +
" end;\r\n" +
"\r\n" +
" { Discard log messages. }\r\n" +
" TLogNullAppender = class(TLogCustomAppender)\r\n" +
" protected\r\n" +
" procedure DoAppend(const Message: string); override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Send log messages to debugging output. }\r\n" +
" TLogODSAppender = class(TLogCustomAppender)\r\n" +
" protected\r\n" +
" procedure DoAppend(const Message: string); override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Send log messages to a stream. }\r\n" +
" TLogStreamAppender = class(TLogCustomAppender)\r\n" +
" private\r\n" +
" FStream: TStream;\r\n" +
" protected\r\n" +
" procedure DoAppend(const Message: string); override;\r\n" +
" procedure DoWrite(const StrStream: TStringStream); virtual;\r\n" +
" public\r\n" +
" constructor Create(const Name: string; const Stream: TStream; const Layout: ILogLayout = nil); reintroduce; virtual;\r\n" +
" destructor Destroy; override;\r\n" +
" end;\r\n" +
"\r\n" +
" { Send log messages to a file.\r\n" +
"\r\n" +
" Accepts the following options:\r\n" +
"\r\n" +
" # Class identification\r\n" +
" log4d.appender.<name>=TLogFileAppender\r\n" +
" # Name of the file to write to, string, mandatory\r\n" +
" log4d.appender.<name>.fileName=C:\\Logs\\App.log\r\n" +
" # Whether to append to file, Boolean, optional, defaults to true\r\n" +
" log4d.appender.<name>.append=false\r\n" +
" }\r\n" +
" TLogFileAppender = class(TLogStreamAppender)\r\n" +
" private\r\n" +
" FAppend: boolean;\r\n" +
" FFileName: TFileName;\r\n" +
" function GetMachineName: String;\r\n" +
" function GetExecutableName: String;\r\n" +
" function ExpandOption(Data, Option, Value: String): String;\r\n" +
" function ExpandOptions(Value: String): String;\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" procedure CreateLogFile;\r\n" +
" procedure OnSetOptionsComplete(); override;\r\n" +
" procedure OpenLogFile();\r\n" +
" public\r\n" +
" constructor Create(const Name, FileName: string; const Layout: ILogLayout = nil; const Append: boolean = True);\r\n" +
" reintroduce; virtual;\r\n" +
" property FileName: TFileName Read FFileName;\r\n" +
" property OpenAppend: boolean Read FAppend;\r\n" +
" end;\r\n" +
"\r\n" +
" TRollingLogFileAppender = class(TLogFileAppender)\r\n" +
" private\r\n" +
" FMaxSize: int64;\r\n" +
" FCount: integer;\r\n" +
" function CanRollFiles: boolean;\r\n" +
" protected\r\n" +
" procedure SetOption(const Name, Value: string); override;\r\n" +
" procedure DoWrite(const StrStream: TStringStream); override;\r\n" +
" function ExtractName(const iFileName: string): string;\r\n" +
" function ExtractExtension(const iFileName: string): string;\r\n" +
" function FindIndex(const iText: string; const iSearchItem: char): longint;\r\n" +
" function MakeFileName(const iFileName: string; const iAppendIndex: longint): string;\r\n" +
" procedure RollLogFiles();\r\n" +
" procedure ChangeFileName(const iFrom, iTo: string);\r\n" +
" procedure RemoveFile(const iFileName: string);\r\n" +
" public\r\n" +
" constructor Create(const Name, FileName: string; const Layout: ILogLayout = nil; const Append: boolean = True); override;\r\n" +
" procedure Init; override;\r\n" +
" property MaxSize: int64 Read FMaxSize Write FMaxSize;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Configurators ---------------------------------------------------------------}\r\n" +
"\r\n" +
" { Use this class to quickly configure the package. }\r\n" +
" TLogBasicConfigurator = class(TObject)\r\n" +
" private\r\n" +
" FRegistry: TStringList;\r\n" +
" FLoggerFactory: ILogLoggerFactory;\r\n" +
" protected\r\n" +
" { Used by subclasses to add a renderer\r\n" +
" to the hierarchy passed as parameter. }\r\n" +
" procedure AddRenderer(const Hierarchy: TLogHierarchy; const RenderedName, RendererName: string);\r\n" +
" function AppenderGet(const Name: string): ILogAppender;\r\n" +
" procedure AppenderPut(const Appender: ILogAppender);\r\n" +
" procedure SetGlobalProps(const Hierarchy: TLogHierarchy; const FactoryClassName, Debug, Threshold: string);\r\n" +
" public\r\n" +
" constructor Create;\r\n" +
" destructor Destroy; override;\r\n" +
" { Add appender to the root logger. If no appender is provided,\r\n" +
" add a TLogODSAppender that uses TLogPatternLayout with the\r\n" +
" TTCCPattern and prints to debugging output for the root logger. }\r\n" +
" class procedure Configure(const Appender: ILogAppender = nil);\r\n" +
" { Reset the default hierarchy to its default. It is equivalent to calling\r\n" +
" Logger.GetDefaultHierarchy.ResetConfiguration.\r\n" +
" See TLogHierarchy.ResetConfiguration for more details. }\r\n" +
" class procedure ResetConfiguration;\r\n" +
" end;\r\n" +
"\r\n" +
" { Extends BasicConfigurator to provide configuration from an external file.\r\n" +
" See DoConfigure for the expected format.\r\n" +
"\r\n" +
" It is sometimes useful to see how Log4D is reading configuration files.\r\n" +
" You can enable Log4D internal logging by defining the log4d.debug variable. }\r\n" +
" TLogPropertyConfigurator = class(TLogBasicConfigurator)\r\n" +
" protected\r\n" +
" procedure ConfigureRootLogger(const Props: TStringList; const Hierarchy: TLogHierarchy);\r\n" +
" procedure ParseAdditivityForLogger(const Props: TStringList; const Logger: TLogLogger);\r\n" +
" function ParseAppender(const Props: TStringList; const AppenderName: string): ILogAppender;\r\n" +
" procedure ParseLoggersAndRenderers(const Props: TStringList; const Hierarchy: TLogHierarchy);\r\n" +
" procedure ParseLogger(const Props: TStringList; const Logger: TLogLogger; const Value: string);\r\n" +
" public\r\n" +
" class procedure Configure(const Filename: string); overload;\r\n" +
" class procedure Configure(const Props: TStringList); overload;\r\n" +
" procedure DoConfigure(const FileName: string; const Hierarchy: TLogHierarchy);\r\n" +
" overload;\r\n" +
" procedure DoConfigure(const Props: TStringList; const Hierarchy: TLogHierarchy); overload;\r\n" +
" end;\r\n" +
"\r\n" +
"{ Register a new appender class. }\r\n" +
"procedure RegisterAppender(const Appender: TClass);\r\n" +
"{ Find an appender based on its class name and create a new instance of it. }\r\n" +
"function FindAppender(const ClassName: string): ILogAppender;\r\n" +
"\r\n" +
"{ Register a new logger factory class. }\r\n" +
"procedure RegisterLoggerFactory(const LoggerFactory: TClass);\r\n" +
"{ Find a logger factory based on its class name\r\n" +
" and create a new instance of it. }\r\n" +
"function FindLoggerFactory(const ClassName: string): ILogLoggerFactory;\r\n" +
"\r\n" +
"{ Register a new error handler class. }\r\n" +
"procedure RegisterErrorHandler(const ErrorHandler: TClass);\r\n" +
"{ Find an error handler based on its class name\r\n" +
" and create a new instance of it. }\r\n" +
"function FindErrorHandler(const ClassName: string): ILogErrorHandler;\r\n" +
"\r\n" +
"{ Register a new filter class. }\r\n" +
"procedure RegisterFilter(const Filter: TClass);\r\n" +
"{ Find a filter based on its class name and create a new instance of it. }\r\n" +
"function FindFilter(const ClassName: string): ILogFilter;\r\n" +
"\r\n" +
"{ Register a new layout class. }\r\n" +
"procedure RegisterLayout(const Layout: TClass);\r\n" +
"{ Find a layout based on its class name and create a new instance of it. }\r\n" +
"function FindLayout(const ClassName: string): ILogLayout;\r\n" +
"\r\n" +
"{ Register a new class that can be rendered. }\r\n" +
"procedure RegisterRendered(const Rendered: TClass);\r\n" +
"{ Find a rendered class based on its class name and return its class. }\r\n" +
"function FindRendered(const ClassName: string): TClass;\r\n" +
"\r\n" +
"{ Register a new object renderer class. }\r\n" +
"procedure RegisterRenderer(const Renderer: TClass);\r\n" +
"{ Find an object renderer based on its class name\r\n" +
" and create a new instance of it. }\r\n" +
"function FindRenderer(const ClassName: string): ILogRenderer;\r\n" +
"\r\n" +
"{ Convert string value to a Boolean, with default. }\r\n" +
"function StrToBool(Value: string; const Default: boolean): boolean;\r\n" +
"\r\n" +
"{$IFDEF LINUX}\r\n" +
"procedure EnterCriticalSection(var CS: TCriticalSection);\r\n" +
"procedure LeaveCriticalSection(var CS: TCriticalSection);\r\n" +
"procedure InitializeCriticalSection(var CS: TCriticalSection);\r\n" +
"procedure DeleteCriticalSection(var CS: TCriticalSection);\r\n" +
"function GetCurrentThreadID: Integer;\r\n" +
"procedure OutputDebugString(const S: PChar);\r\n" +
"{$ENDIF}\r\n" +
"\r\n" +
"var\r\n" +
" { Default implementation of ILogLoggerFactory }\r\n" +
" DefaultLoggerFactory: TLogDefaultLoggerFactory;\r\n" +
" { The logging hierarchy }\r\n" +
" DefaultHierarchy: TLogHierarchy;\r\n" +
" { Internal package logging. }\r\n" +
" LogLog: TLogLog;\r\n" +
"\r\n" +
"implementation\r\n" +
"\r\n" +
"const\r\n" +
" CRLF = #13#10;\r\n" +
" TAB = #9;\r\n" +
" MilliSecsPerDay = 24 * 60 * 60 * 1000;\r\n" +
" DefaultRollingFileSize = 1024 * 1024;\r\n" +
"\r\n" +
"\r\n";
#endregion
TestGetUnits(cLog4D,
new string[] {"Classes", "SyncObjs", "Windows", "Winsock", "Contnrs", "SysUtils"},
new string[] {});
}
[Test]
public void GetUnits_FDFormat()
{
#region (Test value)
const string cFDFormat =
"{$O+,F+}\r\n" +
"\r\n" +
"interface\r\n" +
"uses\r\n" +
" Windows, SYSUTILS , CLASSES , DIALOGS\r\n" +
" , DBunit\r\n" +
" , GDeclare\r\n" +
" , DateTime\r\n" +
" , MYSTD\r\n" +
" , STDATMOS\r\n" +
" , ERRORSio\r\n" +
" , CODEio\r\n" +
" , ACATCio\r\n" +
" , ACLOGio\r\n" +
" , ACWGTSio\r\n" +
" , APTio\r\n" +
" , Bufferio\r\n" +
" , CTFFOTio\r\n" +
" , OldCTFFOTio\r\n" +
" , FDAPTio\r\n" +
" , FDBOOKio\r\n" +
" , FDRELio\r\n" +
" , FDRMKSio\r\n" +
" , FFSIio\r\n" +
" , FPCFPio\r\n" +
" , FPCFPI\r\n" +
" , FPFORMio\r\n" +
" , FPGlobal // added to get DispatchPolicyType\r\n" +
" , FPLITEio\r\n" +
" , FPMASKio\r\n" +
" , FPMONio\r\n" +
" , FSDLYio\r\n" +
" , FFJUMPio\r\n" +
" , METW2io\r\n" +
" , OPERio\r\n" +
" , DPODio\r\n" +
" ;\r\n";
#endregion
TestGetUnits(cFDFormat,
new string[] {"Windows", "SYSUTILS", "CLASSES", "DIALOGS", "DBunit", "GDeclare", "DateTime",
"MYSTD", "STDATMOS", "ERRORSio", "CODEio", "ACATCio", "ACLOGio", "ACWGTSio", "APTio",
"Bufferio", "CTFFOTio", "OldCTFFOTio", "FDAPTio", "FDBOOKio", "FDRELio", "FDRMKSio",
"FFSIio", "FPCFPio", "FPCFPI", "FPFORMio", "FPGlobal", "FPLITEio", "FPMASKio", "FPMONio",
"FSDLYio", "FFJUMPio", "METW2io", "OPERio", "DPODio"},
new string[] {});
}
[Test]
public void GetUnits_Schedzzz()
{
#region (Test value)
const string cSchedzzz =
"unit SCHEDZZZ;\r\n" +
"\r\n" +
"interface\r\n" +
"uses SYSUTILS\r\n" +
" , DBunit {Btrieve Interface }\r\n" +
" , DateTime {Various Date/time Coversions }\r\n" +
" , GDeclare {Global Declares and Procedures }\r\n" +
" , GDCL_ALL\r\n" +
" , MyStd {Field Manipulation Routines }\r\n" +
" , MyStdIO {Screen Manipulation Routines }\r\n" +
" , FLTEdits\r\n" +
" , StdEdits {Standards Field Type Edits }\r\n" +
" {Mouse Routines }\r\n" +
" , ERRORSio {Retrieve Message for Error Code }\r\n" +
" , ACWGTSio\r\n" +
" , FDAPTio\r\n" +
" , FSDLYio\r\n" +
" , FSDailyu\r\n" +
" , CODEIO\r\n" +
" , POSTLOG\r\n" +
" , oCOMMCTL\r\n" +
" , QMSGDESK\r\n" +
" , AOPCODio\r\n" +
" , FFSIio\r\n" +
" , SCHFiles\r\n" +
" , Classes\r\n" +
" ;\r\n" +
"\r\n" +
"{ HISTORY\r\n" +
"\r\n";
#endregion
TestGetUnits(cSchedzzz,
new string[] {"SYSUTILS", "DBunit", "DateTime", "GDeclare", "GDCL_ALL", "MyStd", "MyStdIO", "FLTEdits", "StdEdits", "ERRORSio", "ACWGTSio", "FDAPTio", "FSDLYio", "FSDailyu", "CODEIO", "POSTLOG", "oCOMMCTL", "QMSGDESK", "AOPCODio", "FFSIio", "SCHFiles", "Classes"},
new string[] {});
}
}
}
Reference in new issue View Git Blame Copy Permalink