{*******************************************************}
{                                                       }
{  Responsive Software     http://www.responsive.co.nz  }
{                                                       }
{  Copyright (c) 2003-2006 Responsive Software Limited  }
{                                                       }
{*******************************************************}

unit Utilities;

// this module contains high level utilities which have
// dependencies on other application modules

interface

uses
  DatabaseObjects, GeneralUtilities, BusinessObjects,
  IBDatabase, DB, Classes, Graphics, StdCtrls, QuickRpt, Chart, ExtCtrls;

function CompressString
  (Str : string) : string;
function DecompressString
  (Str : string) : string;

procedure LoadImageFromFile
  (Image : TImage;
   FileName : string;
   FileContents : string);

procedure LoadPOSConfiguration;
procedure SavePOSConfiguration;
procedure LoadPOSData;
procedure SavePOSData;
procedure CompleteSale
  (Sale : TSale);
procedure OpenCashDrawer;

function PreApplicationInitialize : boolean;
function PostApplicationInitialize : boolean;
function ApplicationStartUp : boolean;
procedure ApplicationShutDown;

function ConvertAccountTypeToString
  (AccountType : TAccountType) : string;

function ConvertStringToAccountType
  (Str : string) : TAccountType;

function ConvertAccountTypeToDescription
  (AccountType : TAccountType) : string;

procedure CreateOutlookExpressEmail
  (EmailAddress : string;
   SubjectLine : string;
   Body : string);

procedure CreateEmail
  (EmailAddress : string;
   SubjectLine : string);

procedure CreateEmailWithAttachment
  (EmailAddress : string;
   SubjectLine : string;
   FileName : string);
   
function SendFileViaFTP
  (FileName : string;
   HostName : string;
   UserId : string;
   Password : string;
   Passive : boolean;
   ShowProgress : boolean) : boolean;

function CheckQuickReportOpen : boolean;

procedure ViewQRPFile;

procedure EmailReport
  (Report : TQuickRep;
   ReportId : string;
   SubjectLine : string);

procedure Maintain
  (DatabaseObjectClass : TDatabaseObjectClass;
   NoDelete : boolean;
   SelectionString : string = '');

function Find
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string = '') : TDatabaseObject; overload;

function Find
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection) : TDatabaseObject; overload;

procedure MaintainAccounts;
function FindAccount : TDatabaseObject; overload;
function FindAccount
  (CompanyId : int64) : TDatabaseObject; overload;
function FindDefaultCompanyAccount : TDatabaseObject;

procedure PrintListing
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string); overload;
   
procedure PrintListing
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection); overload;
   
procedure CreateCSVFile
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string); overload;

procedure CreateCSVFile
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection); overload;

// this function checks the collection for an object with the
// given id and returns it if found, otherwise it formats
// the ResultString with '' if id was zero or 'Unknown' if the
// id was not found
function FormatObjectProperty
  (DatabaseObjectCollection : TDatabaseObjectCollection;
   ObjectId : int64;
   var ResultString : string) : TDatabaseObject;

procedure PopulateStringsWithDistinctValues
  (TableName : string;
   FieldName : string;
   Strings : TStrings;
   Add : boolean);

function FieldExists
  (TableName : string;
   FieldName : string) : boolean;

procedure AddFieldToTable
  (TableName : string;
   FieldName : string;
   DataType : TFieldType;
   Size : integer;
   DefaultValue : variant);

// note that this function has only been implemented for Firebird
// otherwise it has no effect
procedure RenameField
  (TableName : string;
   OldFieldName : string;
   NewFieldName : string);

function DatabaseDirectory : string;
function GetFreeSessionName : string;
procedure CloseSessionDatabase
  (SessionName : string);

function ReportFooterString : string;

function DelimitSQLFieldName
  (FieldName : string) : string;
function DelimitSQLStringValue
  (StringValue : string;
   MaxLength : integer=0) : string;
function IdFieldType : TFieldType;
function IdFieldValue
  (Field : TField) : int64;
procedure SetIdFieldValue
  (Field : TField;
   Id : int64);
function CurrencyFieldType : TFieldType;
function CurrencyFieldSize : integer;
function CurrencyFieldValue
  (Field : TField) : int64;
procedure SetCurrencyFieldValue
  (Field : TField;
   Amount : int64);
function CurrencyToSQLStr
  (Amount : int64) : string;

procedure SetControlColors
  (Component : TComponent;
   Color : TColor);

procedure PromptUserId
  (var UserId : string;
   var Password : string);

procedure PromptHostNameUserId
  (var HostName : string;
   var UserId : string;
   var Password : string;
   var Passive : boolean);

function PromptDate
  (var Date : TDateTime) : boolean;

// logged on workstation counting
procedure SetLoggedOnWorkstation
  (LoggedOn : boolean);
function NoOfLoggedOnWorkstations : integer;
function NoOfWorkstations : integer;

// graphing
procedure ClearGraph
  (Chart : TChart);

procedure DisplayGraph
  (Chart : TChart;
   CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   ShowProgress : boolean;
   OnReport : boolean);

// printing
procedure PrintGraph
  (CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);

procedure PrintBalanceSheet
  (CompanyId : int64;
   AsAtDate : TDateTime;
   Email : boolean);

procedure PrintIncomeStatement
  (CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);

procedure PrintAccountStatement
  (AccountId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Summary : boolean;
   Email : boolean);

procedure PrintCashbookStatement
  (CashbookId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);

procedure PrintReceipt
  (Sale : TSale;
   Preview : boolean);

procedure PrintSalesReport
  (Parameters : TSalesReportParameters;
   Email : boolean);

function RegistrationOk : boolean;
function CheckBDEDatabaseConnection : boolean;
function CheckFirebirdDatabaseConnection : boolean;
function CheckPrinterDriver : boolean;

procedure SendDatabase;
procedure DecompressDatabase;

procedure UpdateAllComboBoxes
  (Full : boolean);

type
  TDoubleEntryRecord = class
    Date : TDateTime;
    DebitAccountId : int64;
    DebitDescription : string;
    CreditAccountId : int64;
    CreditDescription : string;
    Amount : int64;
  end;

  // this class is used to accumulate double entries
  // and combine them before posting them to the ledger
  TDoubleEntryAccumulator = class
  private
    FList : TList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Accumulate
      (Date : TDateTime;
       DebitAccountId : int64;
       DebitDescription : string;
       CreditAccountId : int64;
       CreditDescription : string;
       Amount : int64);
    procedure Post
      (OnStatement : boolean;
       NotifyWorkstations : boolean);
  end;

// this function will create a combined double entry
// if CombinedEntry is nil
// or add to an existing combined entry
// if CombinedEntry is not nil
procedure CreateDoubleEntry
  (var CombinedEntry : TCombinedEntry;
   Date : TDateTime;
   DebitAccountId : int64;
   DebitDescription : string;
   CreditAccountId : int64;
   CreditDescription : string;
   Amount : int64);

// this function will update a double entry in the ledger
// and will create one if it does not already exist
// it returns the id of the combined entry
// if CombinedEntryId is zero then it will create a new
// combined entry
function PostDoubleEntry
  (CombinedEntryId : int64;
   var CombinedEntry : TCombinedEntry;
   NotifyWorkstations : boolean) : int64;

// this function will update a double entry in the ledger
// and will create one if it does not already exist
// it returns the id of the combined entry
// if CombinedEntryId is zero then it will create a new
// combined entry
function UpdateDoubleEntry
  (CombinedEntryId : int64;
   Date : TDateTime;
   DebitAccountId : int64;
   DebitDescription : string;
   CreditAccountId : int64;
   CreditDescription : string;
   Amount : int64;
   NotifyWorkstations : boolean) : int64;

// this function will update an entry in the cashbook
// or create one if it does not already exist
// it uses the CombinedEntryId as identification
// and assumes there is only one cashbook entry linked
// to the ledger entry
procedure UpdateCashbookEntry
  (CashbookId : int64;
   OtherAccountId : int64;
   CombinedEntryId : int64;
   Description : string;
   Date : TDateTime;
   Amount : int64;
   OnStatement : boolean;
   NotifyWorkstations : boolean);

// this function will create a new cashbook entry
// regardless of whether or not another one exists with the
// same CombinedEntryId
// this is to allow for multiple cashbook entries
// to be created via a sale and linked to the same ledger entry
procedure CreateCashbookEntry
  (CashbookId : int64;
   OtherAccountId : int64;
   CombinedEntryId : int64;
   Description : string;
   Date : TDateTime;
   Amount : int64;
   OnStatement : boolean;
   NotifyWorkstations : boolean);

// this function will delete multiple cashbook entries
// linked to the same ledger entry
procedure DeleteCashbookEntries
  (CombinedEntryId : int64;
   NotifyWorkstations : boolean);

// update ledger account for sale
procedure UpdateSaleToLedger
  (Sale : TSale);

procedure LoadReportLayoutsFromWorkstationConfiguration;
procedure SaveReportLayoutsToWorkstationConfiguration;
function ReportLayout
  (CompanyId : int64;
   ReportLayoutType : TReportLayoutType) : TReportLayout;
function RetainedEarnings
  (CompanyId : int64;
   AsAtDate : TDateTime) : int64;

// convert ids to names etc
function CompanyName
  (CompanyId : int64) : string;
function CompanyAbbreviation
  (CompanyId : int64) : string;
function CompanyIdFromAbbreviation
  (Abbreviation : string) : int64;
function CompanyIdFromName
  (Name : string) : int64;
function CompanyComboBoxDisplayString
  (CompanyId : int64) : string;

function AccountName
  (AccountId : int64) : string;
function AccountAbbreviation
  (AccountId : int64) : string;
function AccountCombinedAbbreviation
  (AccountId : int64) : string;
function AccountType
  (AccountId : int64) : TAccountType;
function AccountCompanyId
  (AccountId : int64) : int64;
function AccountDescription
  (AccountId : int64) : string;
function AccountComboBoxDisplayString
  (AccountId : int64) : string;
function AccountIdFromCombinedAbbreviation
  (CombinedAbbreviation : string) : int64;
function AccountIdFromAbbreviation
  (CompanyId : int64;
   Abbreviation : string) : int64;

function CashbookName
  (CashbookId : int64) : string;
function CashbookAbbreviation
  (CashbookId : int64) : string;
function CashbookCombinedAbbreviation
  (CashbookId : int64) : string;
function CashbookDescription
  (CashbookId : int64) : string;
function CashbookFromAccountId
  (AccountId : int64) : TCashbook;

function ItemName
  (ItemId : int64) : string;
function SalespersonName
  (SalespersonId : int64) : string;
function PaymentTypeName
  (PaymentTypeId : int64) : string;
function ItemIdFromLookupCode
  (Code : string) : int64;
function SalespersonIdFromName
  (Name : string) : int64;
function ItemIdFromName
  (Name : string) : int64;
function PaymentTypeIdFromName
  (Name : string) : int64;

// load combined entry from accounting subsystem
function GetCombinedEntry
  (CombinedEntryId : int64) : TCombinedEntry;

procedure CreateDefaultAccounts;
procedure CreateDefaultCashbooks;
procedure CreateDefaultPaymentTypes;

function LockDatabaseObject
  (DatabaseObject : TDatabaseObject) : boolean;

procedure UnlockDatabaseObject
  (DatabaseObject : TDatabaseObject);

procedure ShowCombinedEntry
  (CombinedEntryId : int64;
   CompanyId : int64);

procedure FindUnbalancedEntry;

function Unregistered : boolean;

function FindItem : TItem;
function FindDocument : TDocument;

procedure PurgeDatabase
  (PurgeDate : TDateTime);
  
implementation

uses
  Series, TeEngine, ComObj, Variants,
  Progress, DatabaseManager, CommunicationsManager,
  Globals,
  IB, IBTable, IBQuery, IBErrorCodes,
  PromptUserNamePassword, PromptUserIdPassword, PromptHostNameUserIdPassword,
  PromptDate, PromptString,
  Register, Compress,
  DBTables, Dialogs, SysUtils, Forms, Controls, ComCtrls, Grids, DBGrids,
  DateUtils, ShellApi, Windows, Valedit, Math,
  FTP, QRPRNTR, Main,
  IncomeStatementReportUnit, IncomeStatementReportFormat,
  BalanceSheetReportUnit, BalanceSheetReportFormat,
  AccountStatementReportUnit, AccountStatementReportFormat,
  CashbookStatementReportUnit, CashbookStatementReportFormat,
  ReceiptReportUnit, ReceiptReportFormat,
  GraphReportUnit, ChooseString, Splash,
  ProxyDatabaseObjectCollectionUnit,
  ProxyDatabaseCollectionObjectMaintain,
  ProxyDatabaseCollectionObjectFind,
  ProxyObjectListingReportUnit, SalesManagerUnit,
  SalesReportUnit, SalesReportFormat, JPeg;

var
  SendFileViaFTPInProgress : boolean;
  Semaphore : THandle;

function AuthenticateUser : boolean;
var
  SelectionString : string;
begin
  // get the user object from the database
  SelectionString := 'WHERE ' + DelimitSQLFieldName('Name') + ' = ' + DelimitSQLStringValue(ClientUserName);
  User := TUser(LoadDatabaseObject(TUser,SelectionString));
  // check for valid user and password
  if (User <> nil) and (User.UnencryptedPassword = ClientPassword) then
  begin
    // tell the server we have logged on
    ClientCommunicator.NotifyLoggedOnUser(ClientUserName);
    Result := true;
  end else begin
    // tell the server there was an invalid login attempt
    ClientCommunicator.NotifyInvalidLogin(ClientUserName,ClientPassword);
    Result := false;
    ShowMessage('Invalid User Name or Password.');
  end;
  // clear client password
  ClientPassword := '';
  // clear password in user object
  if User <> nil then
    User.Password := '';
end;

function PreApplicationInitialize : boolean;
var
  SemaphoreName : string;
  ProductionAppendage : string;

  function InParams
    (Value : string) : boolean;
  var
    i : integer;
  begin
    Result := true;
    for i := 1 to ParamCount do
      if UpperCase(ParamStr(i)) = UpperCase(Value) then
        Exit;
    Result := false;
  end;

begin
  Result := false;
  // POS mode implicitly includes client mode
  POSMode := (UpperCase(ParamStr(1)) = '/P');
  Offline := (UpperCase(ParamStr(2)) = '/O');
  // client, server, standard and conversion are mutually exclusive modes
  ClientMode := (UpperCase(ParamStr(1)) = '/C') or POSMode;
  ServerMode := (UpperCase(ParamStr(1)) = '/S');
  ConversionMode := (UpperCase(ParamStr(1)) = '/V');
  StandardMode := not (ClientMode or ServerMode or ConversionMode);

  ServerLogging := ServerMode and ((UpperCase(ParamStr(2)) = '/L') or (UpperCase(ParamStr(3)) = '/L'));
  Firebird := ServerMode and ((UpperCase(ParamStr(2)) = '/F') or (UpperCase(ParamStr(3)) = '/F'));
  
  if ServerMode and InParams('/H') then
    HTTPServer := true
  else
    HTTPServer := false;

  // set up database name and registry key
  if InParams('/PR') then
    ProductionAppendage := 'P'
  else
    ProductionAppendage := '';
  BDEDatabaseName := BaseDatabaseName + ProductionAppendage;
  FirebirdDatabaseName := BaseDatabaseName + ProductionAppendage;
  RegistryKey := BaseRegistryKey + ProductionAppendage;

  // check for other command line parameters in client mode
  if ClientMode then
  begin
    ServerIPAddress := ParamStr(2);
    ServerPortNumber := StrToIntDef(ParamStr(3),DefaultPortNumber);
  end;
  // check for other command line parameters in firebird server or conversion modes
  if Firebird or ConversionMode then
  begin
    if (ParamStr(2) <> '') and (ParamStr(2)[1] <> '/') then
    begin
      FirebirdUsername := ParamStr(2);
      FirebirdPassword := ParamStr(3);
      FirebirdServerIPAddress := ParamStr(4);
    end else if (ParamStr(3) <> '') and (ParamStr(3)[1] <> '/') then
    begin
      FirebirdUsername := ParamStr(3);
      FirebirdPassword := ParamStr(4);
      FirebirdServerIPAddress := ParamStr(5);
    end else if (ParamStr(4) <> '') and (ParamStr(4)[1] <> '/') then
    begin
      FirebirdUsername := ParamStr(4);
      FirebirdPassword := ParamStr(5);
      FirebirdServerIPAddress := ParamStr(6);
    end;
    if FirebirdServerIPAddress = '' then
      FirebirdServerIPAddress := 'localhost';
  end;

  if (not ClientMode) or POSMode then
  begin
    // check to see if already running and if so then exit
    if Firebird then
      SemaphoreName := ProgramName + ProductionAppendage + 'FirebirdIsRunning'
    else if POSMode then
      SemaphoreName := ProgramName + ProductionAppendage + 'POSIsRunning'
    else
      SemaphoreName := ProgramName + ProductionAppendage + 'IsRunning';
    Semaphore := CreateSemaphore( nil, 0, 1, PChar(SemaphoreName));
    if (Semaphore = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      ShowMessage(ProgramName + ' is already running');
      Exit;
    end;
  end else
    Semaphore := 0;

  if (not ClientMode) and (not Firebird) then
  begin
    if not CheckBDEDatabaseConnection then
    begin
      // try switching the database to the path explicitly if not found via alias
      BDEDatabaseName := ExeDirectory + 'Database';
      if not CheckBDEDatabaseConnection then
      begin
        ShowMessage('The database is not accessible.' + Chr(VK_RETURN)
          + Chr(VK_RETURN)
          + 'Please check that the computer with the database is turned on.' + Chr(VK_RETURN)
          + Chr(VK_RETURN)
          + 'If so then please check that the network is working, the BDE is configured correctly and ' + Chr(VK_RETURN)
          + 'that you have full access to the folder containing the database.' );
        Exit;
      end;
    end;
  end;

  if (not ServerMode) and (not ConversionMode) and (not CheckPrinterDriver) then
  begin
    ShowMessage('The printer driver is causing a problem.' + Chr(VK_RETURN)
      + Chr(VK_RETURN)
      + 'Try any or all of the following:' + Chr(VK_RETURN)
      + Chr(VK_RETURN)
      + '  1.  Reboot this computer.' + Chr(VK_RETURN)
      + '  2.  Reboot the computer connected to the printer.' + Chr(VK_RETURN)
      + '  3.  Check that the network is working and that you have access to the printer.' + Chr(VK_RETURN)
      + '  4.  Reinstall the printer driver(s).' );
    Exit;
  end;
  Result := true;
end;

procedure LoadImageFromFile
  (Image : TImage;
   FileName : string;
   FileContents : string);
var
  FileExtension : string;
  Picture : TPicture;
  StringStream : TStringStream;
  JPegImage : TJPegImage;
begin
  if (FileName = '') or (FileContents = '') then
  begin
    Image.Picture := nil;
    Exit;
  end;
  FileExtension := UpperCase(ExtractFileExt(FileName));
  StringStream := TStringStream.Create(FileContents);
  StringStream.Position := 0;
  try
    Picture := TPicture.Create;
    JPegImage := nil;
    try
      try
        if FileExtension = '.BMP' then
          Picture.Bitmap.LoadFromStream(StringStream)
        else if FileExtension = '.ICO' then
          Picture.Icon.LoadFromStream(StringStream)
        else if FileExtension = '.WMF' then
          Picture.Metafile.LoadFromStream(StringStream)
        else if (FileExtension = '.JPG')
               or (FileExtension = '.JPE')
               or (FileExtension = '.JPEG') then
        begin
          JPegImage := TJPegImage.Create;
          JPegImage.LoadFromStream(StringStream);
          Picture.Bitmap.Assign(JPegImage);
        end;
        Image.Picture := Picture;
      except
        // ignore errors
        Image.Picture := nil;
      end;
    finally
      Picture.Free;
      JPegImage.Free;
    end;
  finally
    StringStream.Free;
  end;
end;

procedure LoadPOSConfiguration;
var
  Str : string;
  StringStream : TStringStream;
begin
  Str := GetRegistryString('POS');
  try
    if POSConfiguration = nil then
      POSConfiguration := TPOSConfiguration.Create;
    if Str <> '' then
    begin
      Str := RestoreNullsEtc(Str);
      StringStream := TStringStream.Create(Str);
      try
        StringStream.Position := 0;
        POSConfiguration.LoadFromStream(StringStream);
      finally
        StringStream.Free;
      end;
    end else
      POSConfiguration.SetDefaults;
  except
    POSConfiguration.Free;
    POSConfiguration := TPOSConfiguration.Create;
    POSConfiguration.SetDefaults;
  end;
end;

procedure SavePOSConfiguration;
var
  Str : string;
  StringStream : TStringStream;
begin
  if POSConfiguration = nil then
    Exit;
  StringStream := TStringStream.Create('');
  try
    POSConfiguration.SaveToStream(StringStream);
    Str := ReplaceNullsEtc(StringStream.DataString);
    SaveRegistryString('POS',Str);
  finally
    StringStream.Free;
  end;
end;

const
  POSDataFileName = 'POSDATA';

var
  LastLoadPOSDataTime : TDateTime;
  POSDataFileAge : integer;

procedure LoadPOSData;
var
  POSDataFileStream : TFileStream;
  VersionStr : string;
  Value : integer;
begin
  // check that enough time has elapsed since the last time
  if Now <= IncMillisecond(LastLoadPOSDataTime,POSDataLoadTime) then
    Exit;
  // look to see if date/time stamp has changed
  Value := FileAge(AppendBackslash(POSConfiguration.POSDataDirectory) + POSDataFileName);
  if Value = POSDataFileAge then
    Exit;
  POSDataFileAge := Value;
  // clear existing data
  GlobalConfiguration.Free;
  GlobalConfiguration := TGlobalConfiguration.Create;
  GlobalConfiguration.SetDefaults;
  Items.Free;
  Items := TDatabaseObjectCollection.Create;
  LookupCodes.Free;
  LookupCodes := TDatabaseObjectCollection.Create;
  Salespersons.Free;
  Salespersons := TDatabaseObjectCollection.Create;
  PaymentTypes.Free;
  PaymentTypes := TDatabaseObjectCollection.Create;
  // load data from file 
  POSDataFileStream := OpenFileStream(AppendBackslash(POSConfiguration.POSDataDirectory) + POSDataFileName,true);
  try
    if POSDataFileStream <> nil then
      VersionStr := ReadStrFromStream(POSDataFileStream)
    else
      VersionStr := '';
    // don't continue if the correct version is not at the start
    if VersionStr <> ProgramVersion then
    begin
      ShowMessage('POS Data not found or version mismatch');
      Exit;
    end;
    try
      GlobalConfiguration.LoadFromStream(POSDataFileStream);
    except
      GlobalConfiguration.SetDefaults;
    end;
    try
      Items.LoadFromStream(POSDataFileStream);
    except
      Items.Clear;
    end;
    try
      LookupCodes.LoadFromStream(POSDataFileStream);
    except
      LookupCodes.Clear;
    end;
    try
      Salespersons.LoadFromStream(POSDataFileStream);
    except
      Salespersons.Clear;
    end;
    try
      PaymentTypes.LoadFromStream(POSDataFileStream);
    except
      PaymentTypes.Clear;
    end;
  finally
    POSDataFileStream.Free;
  end;
  // record current time
  LastLoadPOSDataTime := Now;
end;

procedure SavePOSData;
var
  POSDataFileStream : TFileStream;
begin
  POSDataFileStream := OpenFileStream(AppendBackslash(POSConfiguration.POSDataDirectory) + POSDataFileName,false);
  try
    WriteStrToStream(ProgramVersion,POSDataFileStream);
    GlobalConfiguration.SaveToStream(POSDataFileStream);
    Items.SaveToStream(POSDataFileStream);
    LookupCodes.SaveToStream(POSDataFileStream);
    Salespersons.SaveToStream(POSDataFileStream);
    PaymentTypes.SaveToStream(POSDataFileStream);
  finally
    POSDataFileStream.Free;
  end;
end;

procedure CompleteSale
  (Sale : TSale);
begin
  SalesManager.AddSaleToQueue(Sale);
  Sale.OpenCashDrawer;
  if POSConfiguration.PrintReceipt then
    Sale.PrintReceipt(false);
end;

procedure OpenCashDrawer;
begin
  // add code here to open cash drawer
end;

function PostApplicationInitialize : boolean;
begin
  Result := false;
  Globals.Initialize;

  ProgressForm := TProgressForm.Create(nil);
  ChooseStringForm := TChooseStringForm.Create(nil);
  PromptUserNamePasswordForm := TPromptUserNamePasswordForm.Create(nil);

  if POSMode then
  begin
    LoadPOSConfiguration;
    if not SalesManager.Verify then
    begin
      ShowMessage('There is a problem with the queued sales file POSSALES.' + Chr(VK_RETURN)
        + Chr(VK_RETURN)
        + 'Please check that you have full access to the folder containing the POS data files.' + Chr(VK_RETURN)
        + Chr(VK_RETURN)
        + 'If so then please delete the POSSALES file as it may still contain queued sales created by an older version of the program.' );
      Exit;
    end;
  end;

  // if client mode then get server ip address
  if (not Offline) and ClientMode then
  begin
    if ServerIPAddress = '' then
      GetServerIPAddress;
    if not GetClientUserNameAndPassword then
      Exit;
  end;

  if (Firebird and ServerMode) or ConversionMode then
  begin
    if FirebirdUsername = '' then
    begin
      if not GetFirebirdUserNameAndPassword then
        Exit;
    end;
    if not CheckFirebirdDatabaseConnection then
    begin
      ShowMessage('The database is not accessible.' + Chr(VK_RETURN)
        + Chr(VK_RETURN)
        + 'Please check that the Firebird server is running.' + Chr(VK_RETURN)
        + Chr(VK_RETURN)
        + 'If so then please check that it is configured correctly and ' + Chr(VK_RETURN)
        + 'that it has full access to the folder containing the database.' + Chr(VK_RETURN)
        + Chr(VK_RETURN)
        + 'Please also check that you have the correct user name and password.' );
      Exit;
    end;
  end;
  Result := true;
end;

function ApplicationStartUp : boolean;
begin
  Result := false;
  SplashForm := TSplashForm.Create(nil);
  SplashForm.Show;
  SplashForm.Repaint;

  MessageLog.Log('Start Up: ' + ProgramName + ' Version ' + ProgramVersion + ' ' + ModeString);
  // the order that these procedures are called is important
  try
    // register classes
    RegisterBusinessClasses;
    RegisterDatabaseClasses;
    // do conversion and then exit program
    if ConversionMode then
    begin
      if MessageDlg('WARNING: YOU ARE ABOUT TO COPY ALL DATA FROM THE PARADOX DATABASE TO THE FIREBIRD DATABASE.' + Chr(VK_RETURN)
          + Chr(VK_RETURN)
          + 'IF YOU HAVE AN EXISTING FIREBIRD DATABASE IT WILL BECOME CORRUPTED.' + Chr(VK_RETURN)
          + Chr(VK_RETURN)
          + 'Would you prefer to cancel this operation?',
        mtConfirmation, [mbYes,mbNo], 0) = mrNo then
        if MessageDlg('CONVERT DATA NOW?',
                mtConfirmation, [mbYes,mbNo], 0) = mrYes then
          ConvertTables;
      Exit;
    end;
    // maintain database unless client mode
    if not ClientMode then
      RestructureDatabase;
    // create communicators and load configurations 
    if ClientMode then
    begin
      if not Offline then
      begin
        CreateClientCommunicator;
        // check that we were able to connect
        if not ClientCommunicator.Connected then
        begin
          if not POSMode then
          begin
            ShowMessage('Unable to connect to the server.' + Chr(VK_RETURN)
              + Chr(VK_RETURN)
              + 'Please check that the server address and port number are correct.' + Chr(VK_RETURN)
              + Chr(VK_RETURN)
              + 'If so then please check the following:' + Chr(VK_RETURN)
              + Chr(VK_RETURN)
              + '1.  You are connected to the network.' + Chr(VK_RETURN)
              + '2.  You have access to the server through the specified port.' + Chr(VK_RETURN)
              + '3.  The server is turned on.' + Chr(VK_RETURN)
              + '4.  The server application is running.');
            Exit;
          end else
            Offline := true;
        end;
      end;
      // if offline then load local data and return true
      if Offline then
      begin
        LoadPOSData;
        MessageLog.Log('POS Offline');
        Result := true;
        Exit;
      end;
      // check that the version numbers match
      if not ClientCommunicator.CheckProgramVersion then
      begin
        ShowMessage('Version numbers do not match.' + Chr(VK_RETURN)
          + Chr(VK_RETURN)
          + 'Please ensure that the server and client applications are both the same version.');
        Exit;
      end;
      // determine if we are using the Firebird database server
      Firebird := ClientCommunicator.Firebird;
      // authenticate user name and password
      if not AuthenticateUser then
        Exit;
      // start the messaging thread
      ClientCommunicator.CreateMessagingThread;
    end;
    LoadGlobalConfiguration;
    if StandardMode and (NoOfWorkstations > 1) then
      GetIPAddresses(IPAddresses);
    if ServerMode then
    begin
      CreateServerCommunicator;
      if (ServerCommunicator <> nil) and HTTPServer then
        CreateHTTPServerCommunicator;
    end else
      LoadWorkstationConfiguration;
    if StandardMode then
    begin
      CreateCommunicator;
      SetLoggedOnWorkstation(true);
    end;
    // load the global database object collections
    CreateGlobalCollections;
  {$IFDEF ACCOUNTS}
    // create default accounts and cashbooks if none exist yet
    if Accounts.Count = 0 then
      CreateDefaultAccounts;
    if Cashbooks.Count = 0 then
      CreateDefaultCashbooks;
  {$ENDIF}
  {$IFDEF POS}
    // create default payment types if none exist yet
    if PaymentTypes.Count = 0 then
      CreateDefaultPaymentTypes;
  {$ENDIF}
    if POSMode then
      SavePOSData;
  except
    on E:Exception do
    begin
      // log any exceptions which occur
      MessageLog.Log(E.Message);
      // but reraise for default handler
      raise;
    end;
  end;
  Result := true;
end;

procedure ApplicationShutDown;
begin
  if StandardMode then
  begin
    try
      SetLoggedOnWorkstation(false);
    except
      // ignore exceptions on shutdown
    end;
  end;
  MessageLog.Log('Shut Down: Database Status ' + DatabaseStatusString);
  if (not ClientMode) or POSMode then
    CloseHandle(Semaphore);
  DestroyCommunicator;
end;

function ConvertAccountTypeToString
  (AccountType : TAccountType) : string;
begin
  if AccountType = atAsset then
    Result := 'A'
  else if AccountType = atLiability then
    Result := 'L'
  else if AccountType = atEquity then
    Result := 'P'
  else if AccountType = atIncome then
    Result := 'I'
  else if AccountType = atExpense then
    Result := 'E'
  else
    Result := ' ';
end;

function ConvertStringToAccountType
  (Str : string) : TAccountType;
begin
  if UpperCase(Str) = 'A' then
    Result := atAsset
  else if UpperCase(Str) = 'L' then
    Result := atLiability
  else if UpperCase(Str) = 'P' then
    Result := atEquity
  else if UpperCase(Str) = 'I' then
    Result := atIncome
  else if UpperCase(Str) = 'E' then
    Result := atExpense
  else
    Result := atAsset;
end;

function ConvertAccountTypeToDescription
  (AccountType : TAccountType) : string;
begin
  if AccountType = atAsset then
    Result := 'Asset'
  else if AccountType = atLiability then
    Result := 'Liability'
  else if AccountType = atEquity then
    Result := 'Equity'
  else if AccountType = atIncome then
    Result := 'Income'
  else if AccountType = atExpense then
    Result := 'Expense'
  else
    Result := '';
end;

procedure CreateOutlookExpressEmail
  (EmailAddress : string;
   SubjectLine : string;
   Body : string);
var
  FileName : string;
  pCh : PChar;
  OutStream : TFileStream;
  Str : string;
begin
  Str := 'To: <' + EmailAddress + '>' + CRLF;
  Str := Str + 'Subject: ' + SubjectLine + CRLF;
  Str := Str + 'X-Priority: 3' + CRLF;
  Str := Str + 'X-Unsent: 1' + CRLF;
  Str := Str + CRLF;
  Str := Str + Body;

  FileName := ExeDirectory + 'temp.eml';
  OutStream := TFileStream.Create(FileName,fmShareExclusive or fmCreate);
  try
    OutStream.Seek(0,soFromBeginning);
    OutStream.Write(Str[1],Length(Str));
    pCh := PChar(FileName);
    ShellExecute(0, 'open', pCh, nil, nil, SW_SHOWNORMAL);
  finally
    OutStream.Free;
  end;
end;

procedure CreateEmail
  (EmailAddress : string;
   SubjectLine : string);
var
  Str : string;
  pCh : PChar;

  // replace every space character with %20
  function ConvertSpaces
    (Str : string) : string;
  var
    SpacePosition : integer;
  begin
    repeat
      SpacePosition := Pos(' ',Str);
      if SpacePosition > 0 then
      begin
        Delete(Str,SpacePosition,1);
        Insert('%20',Str,SpacePosition);
      end;
    until SpacePosition = 0;
    Result := Str;
  end;

begin
  Str := 'mailto:' + EmailAddress + '?'
    + 'subject=' + ConvertSpaces(SubjectLine);
  pCh := PChar(Str);
  ShellExecute(0, 'open', pCh, nil, nil, SW_SHOWNORMAL);
end;

procedure CreateEmailWithAttachment
  (EmailAddress : string;
   SubjectLine : string;
   FileName : string);
var
  Str : string;
  pCh : PChar;

  // replace every space character with %20
  function ConvertSpaces
    (Str : string) : string;
  var
    SpacePosition : integer;
  begin
    repeat
      SpacePosition := Pos(' ',Str);
      if SpacePosition > 0 then
      begin
        Delete(Str,SpacePosition,1);
        Insert('%20',Str,SpacePosition);
      end;
    until SpacePosition = 0;
    Result := Str;
  end;

begin
  Str := 'mailto:' + EmailAddress + '?'
    + 'subject=' + ConvertSpaces(SubjectLine) + '&'
    + 'body=' + 'Please%20attach%20the%20file%20' + ConvertSpaces(FileName) + '%20to%20this%20email%20(if%20not%20already%20attached)&'
    + 'file=' + ConvertSpaces(FileName);
  pCh := PChar(Str);
  ShellExecute(0, 'open', pCh, nil, nil, SW_SHOWNORMAL);
end;

function SendFileViaFTP
  (FileName : string;
   HostName : string;
   UserId : string;
   Password : string;
   Passive : boolean;
   ShowProgress : boolean) : boolean;
begin
  // don't allow this function to be re-entered if a send is already in progress
  // this is necessary because the TNMFTP component makes calls to
  // Application.ProcessMessages which means the user can still keep working
  // while the send is in progress
  if SendFileViaFTPInProgress then
  begin
    Result := false;
    Exit;
  end;
  SendFileViaFTPInProgress := true;
  Result := FTPForm.SendFile
    (FileName,
     HostName,
     UserId,
     Password,
     Passive,
     ShowProgress);
  SendFileViaFTPInProgress := false;
end;

function CheckQuickReportOpen : boolean;
begin
  if QuickReportOpen then
    ShowMessage('Please close current report first');
  Result := QuickReportOpen;
end;

procedure ViewQRPFile;
var
  FileName : string;
  QRPrinter : TQRPrinter;
begin
  if CheckQuickReportOpen then
    Exit;
  if ChooseFile(WorkstationConfiguration.QRPFileDirectory,
    FileName,'Select QRP File','QRP files (*.QRP)|*.QRP'
      + '|Any file (*.*)|*.*') then
  begin
    QRPrinter := TQRPrinter.Create;
    try
      QRPrinter.Load(FileName);
      QRPrinter.PreviewModal;
    finally
      QRPrinter.Free;
    end;
  end;
end;

procedure EmailReport
  (Report : TQuickRep;
   ReportId : string;
   SubjectLine : string);
var
  FileName : string;
begin
  try
    FileName := AppendBackslash(WorkstationConfiguration.QRPFileDirectory) + ReportId + '.QRP';
    Report.Prepare;
    Report.QrPrinter.Save(FileName);
  finally
    QuickReportOpen := false;
  end;
  CreateEmailWithAttachment('',SubjectLine,FileName);
end;

procedure ClearGraph
  (Chart : TChart);
var
  i : integer;
begin
  // clear all existing series
  for i := Chart.SeriesCount - 1 downto 0 do
    Chart.Series[i].Free;
  Chart.RemoveAllSeries;
end;

procedure DisplayGraph
  (Chart : TChart;
   CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   ShowProgress : boolean;
   OnReport : boolean);
var
  i : integer;
  Series : TChartSeries;
  ZeroSeries : TChartSeries;
  AssetsSeries : TChartSeries;
  LiabilitiesSeries : TChartSeries;
  EquitySeries : TChartSeries;
  Account : TAccount;
  CachedAccount : TAccount;
  BeginDate : TDateTime;
  EndDate : TDateTime;
  WorkDate : TDateTime;

  MaxValue : int64;
  MinValue : int64;

  TotalAssets : int64;
  TotalLiabilities : int64;
  TotalEquity : int64;

  procedure SetMaxMinValues
    (Value : int64);
  begin
    if Value > MaxValue then
      MaxValue := Value;
    if Value < MinValue then
      MinValue := Value;
  end;

  function TotalAssetsAsAt
    (AsAtDate : TDateTime) : int64;
  var
    i : integer;
  begin
    Result := 0;
    for i := 0 to Globals.Accounts.Count - 1 do
    begin
      Account := TAccount(Globals.Accounts[i]);
      if (Account.CompanyId = CompanyId) and (Account.AccountType = atAsset) then
      begin
        // get cached account
        CachedAccount := AccountsCache.GetAccount(Account.Id);
        // accumulate balances
        Result := Result + CachedAccount.BalanceAsAt(AsAtDate);
      end;
    end;
  end;

  function TotalLiabilitiesAsAt
    (AsAtDate : TDateTime) : int64;
  var
    i : integer;
  begin
    Result := 0;
    for i := 0 to Globals.Accounts.Count - 1 do
    begin
      Account := TAccount(Globals.Accounts[i]);
      if (Account.CompanyId = CompanyId) and (Account.AccountType = atLiability) then
      begin
        // get cached account
        CachedAccount := AccountsCache.GetAccount(Account.Id);
        // accumulate balances
        Result := Result + CachedAccount.BalanceAsAt(AsAtDate);
      end;
    end;
  end;

begin
  // clear all existing series
  for i := Chart.SeriesCount - 1 downto 0 do
    Chart.Series[i].Free;
  Chart.RemoveAllSeries;
  // set begin and end dates
  if UseBeginPeriod then
    BeginDate := BeginPeriodDate
  else
    BeginDate := Date;
  if UseEndPeriod then
    EndDate := EndPeriodDate
  else
    EndDate := Date;
  if ShowProgress then
  begin
    ProgressForm.SetPosition(0);
    ProgressForm.SetCaption('Generating graph.  Please wait...');
    ProgressForm.Show;
  end;
  if ClientCommunicator <> nil then
    ClientCommunicator.SetServerThreadPriority(tpLowest);
  try
    // work through each account and determine begin and end dates
    for i := 0 to Globals.Accounts.Count - 1 do
    begin
      Account := TAccount(Globals.Accounts[i]);
      if (Account.CompanyId = CompanyId) then
      begin
        // get cached account
        CachedAccount := AccountsCache.GetAccount(Account.Id);
        // determine begin date if no begin period specified
        if not UseBeginPeriod then
        begin
          WorkDate := CachedAccount.EarliestDate;
          if BeginDate > WorkDate then
            BeginDate := WorkDate;
        end;
        // determine end date if no end period specified
        if not UseEndPeriod then
        begin
          WorkDate := CachedAccount.LatestDate;
          if EndDate < WorkDate then
            EndDate := WorkDate;
        end;
      end;
      if ShowProgress then
        ProgressForm.SetPosition(i * 100 div Globals.Accounts.Count);
    end;

    // always start from day before begin date
    BeginDate := BeginDate - 1;

    // set the initial maximum and minimum values
    MaxValue := 50000;
    MinValue := -50000;

    // create a series for the zero line
    ZeroSeries := TFastLineSeries.Create(nil);
    ZeroSeries.SeriesColor := clYellow;
    TFastLineSeries(ZeroSeries).LinePen.Width := 3;
    // create a series for the assets
    AssetsSeries := TFastLineSeries.Create(nil);
    AssetsSeries.SeriesColor := clBlue;
    TFastLineSeries(AssetsSeries).LinePen.Width := 3;
    // create a series for the liabilities
    LiabilitiesSeries := TFastLineSeries.Create(nil);
    LiabilitiesSeries.SeriesColor := clRed;
    TFastLineSeries(LiabilitiesSeries).LinePen.Width := 3;
    // create a series for the equity
    EquitySeries := TFastLineSeries.Create(nil);
    EquitySeries.SeriesColor := clGreen;
    TFastLineSeries(EquitySeries).LinePen.Width := 3;

    WorkDate := BeginDate;
    while WorkDate <= EndDate do
    begin
      TotalAssets := TotalAssetsAsAt(WorkDate);
      // show liabilities as negative amounts
      TotalLiabilities := - TotalLiabilitiesAsAt(WorkDate);
      TotalEquity := TotalAssets + TotalLiabilities;

      // ensure that the values are not overlapping before displaying
      while TotalEquity = 0 do
        TotalEquity := TotalEquity + 500;
      while (TotalLiabilities = TotalEquity) or (TotalLiabilities = 0) do
        TotalLiabilities := TotalLiabilities + 500;
      while (TotalAssets = TotalLiabilities) or (TotalAssets = TotalEquity) or (TotalAssets = 0) do
        TotalAssets := TotalAssets + 500;

      AssetsSeries.Add(TotalAssets);
      SetMaxMinValues(TotalAssets);

      LiabilitiesSeries.Add(TotalLiabilities);
      SetMaxMinValues(TotalLiabilities);

      EquitySeries.Add(TotalEquity);
      SetMaxMinValues(TotalEquity);

      ZeroSeries.Add(0);

      WorkDate := WorkDate + 1;
    end;

    Chart.AddSeries(ZeroSeries);
    Chart.AddSeries(AssetsSeries);
    Chart.AddSeries(LiabilitiesSeries);
    Chart.AddSeries(EquitySeries);

    // create an invisible series above the maximum value
    Series := TFastLineSeries.Create(nil);
    if OnReport then
      Series.SeriesColor := clWhite
    else
      Series.SeriesColor := clBtnFace;
    TFastLineSeries(Series).LinePen.Width := 3;
    WorkDate := BeginDate;
    while WorkDate <= EndDate do
    begin
      Series.Add(MaxValue * 1.02);
      WorkDate := WorkDate + 1;
    end;
    Chart.AddSeries(Series);

    // create an invisible series below the minimum value
    Series := TFastLineSeries.Create(nil);
    if OnReport then
      Series.SeriesColor := clWhite
    else
      Series.SeriesColor := clBtnFace;
    TFastLineSeries(Series).LinePen.Width := 3;
    WorkDate := BeginDate;
    while WorkDate <= EndDate do
    begin
      Series.Add(MinValue * 1.02);
      WorkDate := WorkDate + 1;
    end;
    Chart.AddSeries(Series);

  finally
    if ShowProgress then
      ProgressForm.Hide;
    if ClientCommunicator <> nil then
      ClientCommunicator.SetServerThreadPriority(tpNormal);
  end;
end;

procedure PrintGraph
  (CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);
begin
  if CheckQuickReportOpen then
    Exit;

  GraphReport.CompanyId := CompanyId;
  GraphReport.UseBeginPeriod := UseBeginPeriod;
  GraphReport.BeginPeriodDate := BeginPeriodDate;
  GraphReport.UseEndPeriod := UseEndPeriod;
  GraphReport.EndPeriodDate := EndPeriodDate;
  if Email then
    EmailReport(GraphReport,
      'Graph -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr,
      'Graph -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr)
  else
    GraphReport.Preview; 
end;

procedure PrintBalanceSheet
  (CompanyId : int64;
   AsAtDate : TDateTime;
   Email : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatBalanceSheetReportDetails
      (CompanyId,AsAtDate,ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  BalanceSheetReport.CompanyId := CompanyId;
  BalanceSheetReport.AsAtDate := AsAtDate;
  BalanceSheetReport.SetReportData(ReportData);
  if Email then
    EmailReport(BalanceSheetReport,
      'Balance Sheet -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr,
      'Balance Sheet -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr)
  else
    BalanceSheetReport.Preview;
end;

procedure PrintIncomeStatement
  (CompanyId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatIncomeStatementReportDetails
      (CompanyId,
       UseBeginPeriod,
       BeginPeriodDate,
       UseEndPeriod,
       EndPeriodDate,
       ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  IncomeStatementReport.CompanyId := CompanyId;
  IncomeStatementReport.UseBeginPeriod := UseBeginPeriod;
  IncomeStatementReport.BeginPeriodDate := BeginPeriodDate;
  IncomeStatementReport.UseEndPeriod := UseEndPeriod;
  IncomeStatementReport.EndPeriodDate := EndPeriodDate;
  IncomeStatementReport.SetReportData(ReportData);
  if Email then
    EmailReport(IncomeStatementReport,
      'Income Statement -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr,
      'Income Statement -' + CompanyAbbreviation(CompanyId) + '-' + DateTimeStampStr)
  else
    IncomeStatementReport.Preview;
end;

procedure PrintAccountStatement
  (AccountId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Summary : boolean;
   Email : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatAccountStatementReportDetails
      (AccountId,
       UseBeginPeriod,
       BeginPeriodDate,
       UseEndPeriod,
       EndPeriodDate,
       Summary,
       ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  AccountStatementReport.AccountId := AccountId;
  AccountStatementReport.UseBeginPeriod := UseBeginPeriod;
  AccountStatementReport.BeginPeriodDate := BeginPeriodDate;
  AccountStatementReport.UseEndPeriod := UseEndPeriod;
  AccountStatementReport.EndPeriodDate := EndPeriodDate;
  if Summary then
    AccountStatementReport.SetHeading('ACCOUNT SUMMARY')
  else
    AccountStatementReport.SetHeading('ACCOUNT STATEMENT');
  AccountStatementReport.SetReportData(ReportData);
  if Email then
    EmailReport(AccountStatementReport,
      'Account Statement -' + AccountCombinedAbbreviation(AccountId) + '-' + DateTimeStampStr,
      'Account Statement -' + AccountCombinedAbbreviation(AccountId) + '-' + DateTimeStampStr)
  else
    AccountStatementReport.Preview; 
end;

procedure PrintCashbookStatement
  (CashbookId : int64;
   UseBeginPeriod : boolean;
   BeginPeriodDate : TDateTime;
   UseEndPeriod : boolean;
   EndPeriodDate : TDateTime;
   Email : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatCashbookStatementReportDetails
      (CashbookId,
       UseBeginPeriod,
       BeginPeriodDate,
       UseEndPeriod,
       EndPeriodDate,
       ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  CashbookStatementReport.CashbookId := CashbookId;
  CashbookStatementReport.UseBeginPeriod := UseBeginPeriod;
  CashbookStatementReport.BeginPeriodDate := BeginPeriodDate;
  CashbookStatementReport.UseEndPeriod := UseEndPeriod;
  CashbookStatementReport.EndPeriodDate := EndPeriodDate;
  CashbookStatementReport.SetReportData(ReportData);
  if Email then
    EmailReport(CashbookStatementReport,
      'Cashbook Statement -' + CashbookCombinedAbbreviation(CashbookId) + '-' + DateTimeStampStr,
      'Cashbook Statement -' + CashbookCombinedAbbreviation(CashbookId) + '-' + DateTimeStampStr)
  else
    CashbookStatementReport.Preview; 
end;

procedure PrintReceipt
  (Sale : TSale;
   Preview : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatReceiptReportDetails
      (Sale,
       ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  ReceiptReport.SaleDateTime := Sale.DateTime;
  ReceiptReport.SalespersonId := Sale.SalespersonId;
  ReceiptReport.SetReportData(ReportData);
  
  if DevelopmentMode or Preview then
    ReceiptReport.Preview
  else
    ReceiptReport.Print;
end;

procedure PrintSalesReport
  (Parameters : TSalesReportParameters;
   Email : boolean);
var
  ReportData : TReportData;
begin
  if CheckQuickReportOpen then
    Exit;
  if Parameters = nil then
    Exit;
  ReportData := TReportData.Create;

  // generating this report may take a while so change cursor to an hour glass
  Screen.Cursor := crHourGlass;
  try
    FormatSalesReportDetails
      (Parameters,ReportData);
  finally
    Screen.Cursor := crDefault;
  end;

  SalesReport.SetParameters(Parameters);
  SalesReport.SetReportData(ReportData);
  if Email then
    EmailReport(SalesReport,
      'Sales -' + DateTimeStampStr,
      'Sales -' + DateTimeStampStr)
  else
    SalesReport.Preview;
end;

procedure Maintain
  (DatabaseObjectClass : TDatabaseObjectClass;
   NoDelete : boolean;
   SelectionString : string);
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  if SelectionString <> '' then
    ProxyCollection := TProxyDatabaseObjectCollection.Create
      (DatabaseObjectClass,nil,SelectionString)
  else
    ProxyCollection := TProxyDatabaseObjectCollection.Create
      (DatabaseObjectClass,nil,DatabaseObjectClass.MaintainSelectionString);
  try
    ProxyDatabaseCollectionObjectMaintainForm.Maintain
      (DatabaseObjectClass,ProxyCollection,NoDelete);
  finally
    ProxyCollection.Free;
  end;
end;

function Find
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string) : TDatabaseObject; overload;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  if SelectionString <> '' then
    ProxyCollection := TProxyDatabaseObjectCollection.Create
      (DatabaseObjectClass,nil,SelectionString)
  else
    ProxyCollection := TProxyDatabaseObjectCollection.Create
      (DatabaseObjectClass,nil,DatabaseObjectClass.FindSelectionString);
  try
    Result := ProxyDatabaseCollectionObjectFindForm.Find
      (DatabaseObjectClass,ProxyCollection);
  finally
    ProxyCollection.Free;
  end;
end;

function Find
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection) : TDatabaseObject; overload;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (DatabaseObjectClass,DatabaseObjectCollection,'');
  try
    Result := ProxyDatabaseCollectionObjectFindForm.Find
      (DatabaseObjectClass,ProxyCollection);
  finally
    ProxyCollection.Free;
  end;
end;

function CompareAccounts
  (Item1, Item2 : pointer) : integer;
var
  Account1,
  Account2 : TAccount;
begin
  Account1 := TAccount(Item1);
  Account2 := TAccount(Item2);
  if (Account1 = nil) and (Account2 = nil) then
    Result := 0
  else if (Account1 = nil) and (Account2 <> nil) then
    Result := -1
  else if (Account1 <> nil) and (Account2 = nil) then
    Result := 1
  else begin
    // compare on company abbreviation
    Result := CompareText(Account1.CompanyAbbreviation,Account2.CompanyAbbreviation);
    // if same then use account type
    if Result = 0 then
      Result := integer(Account1.AccountType) - integer(Account2.AccountType);
    // if same then use abbreviation
    if Result = 0 then
      Result := CompareText(Account1.Abbreviation,Account2.Abbreviation);
  end;
end;

procedure MaintainAccounts;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
  Accounts : TDatabaseObjectCollection;
  i : integer;
begin
  // create a sorted copy of the global accounts collection
  Accounts := TDatabaseObjectCollection.Create;
  Accounts.Owned := false;
  for i := 0 to Globals.Accounts.Count - 1 do
    Accounts.Add(Globals.Accounts[i]);
  Accounts.Sort(CompareAccounts);
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (TAccount,Accounts,'');
  try
    ProxyDatabaseCollectionObjectMaintainForm.Maintain
      (TAccount,ProxyCollection,false);
  finally
    Accounts.Free;
    ProxyCollection.Free;
  end;
end;

function FindAccount : TDatabaseObject;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
  Accounts : TDatabaseObjectCollection;
  i : integer;
begin
  // create a sorted copy of the global accounts collection
  Accounts := TDatabaseObjectCollection.Create;
  Accounts.Owned := false;
  for i := 0 to Globals.Accounts.Count - 1 do
    Accounts.Add(Globals.Accounts[i]);
  Accounts.Sort(CompareAccounts);
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (TAccount,Accounts,'');
  try
    Result := ProxyDatabaseCollectionObjectFindForm.Find
      (TAccount,ProxyCollection);
  finally
    Accounts.Free;
    ProxyCollection.Free;
  end;
end;

function FindAccount
  (CompanyId : int64) : TDatabaseObject;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
  Accounts : TDatabaseObjectCollection;
  i : integer;
begin
  // create a sorted copy of the global accounts collection
  // including only those accounts that match the specified company
  Accounts := TDatabaseObjectCollection.Create;
  Accounts.Owned := false;
  for i := 0 to Globals.Accounts.Count - 1 do
    if TAccount(Globals.Accounts[i]).CompanyId = CompanyId then
      Accounts.Add(Globals.Accounts[i]);
  Accounts.Sort(CompareAccounts);
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (TAccount,Accounts,'');
  try
    Result := ProxyDatabaseCollectionObjectFindForm.Find
      (TAccount,ProxyCollection);
  finally
    Accounts.Free;
    ProxyCollection.Free;
  end;
end;

function FindDefaultCompanyAccount : TDatabaseObject;
begin
  Result := FindAccount(0);
end;

procedure PrintListing
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (DatabaseObjectClass,nil,SelectionString);
  // allow the report to own the collection and destroy it when finished
  ProxyObjectListingReport.SetProxyCollection
    (DatabaseObjectClass,ProxyCollection,true);
  ProxyObjectListingReport.Preview;
end;

procedure PrintListing
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection); overload;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (DatabaseObjectClass,DatabaseObjectCollection,'');
  // allow the report to own the collection and destroy it when finished
  ProxyObjectListingReport.SetProxyCollection
    (DatabaseObjectClass,ProxyCollection,true);
  ProxyObjectListingReport.Preview;
end;

procedure CreateCSVFile
  (DatabaseObjectClass : TDatabaseObjectClass;
   SelectionString : string);
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (DatabaseObjectClass,nil,SelectionString);
  try
    ProxyCollection.SaveToCSVFile;
  finally
    ProxyCollection.Free;
  end;
end;

procedure CreateCSVFile
  (DatabaseObjectClass : TDatabaseObjectClass;
   DatabaseObjectCollection : TDatabaseObjectCollection); overload;
var
  ProxyCollection : TProxyDatabaseObjectCollection;
begin
  ProxyCollection := TProxyDatabaseObjectCollection.Create
    (DatabaseObjectClass,DatabaseObjectCollection,'');
  try
    ProxyCollection.SaveToCSVFile;
  finally
    ProxyCollection.Free;
  end;
end;

function FormatObjectProperty
  (DatabaseObjectCollection : TDatabaseObjectCollection;
   ObjectId : int64;
   var ResultString : string) : TDatabaseObject;
begin
  if ObjectId = 0 then
  begin
    ResultString := '';
    Result := nil;
    Exit;
  end;
  Result := DatabaseObjectCollection.ObjectsById[ObjectId];
  if Result = nil then
    ResultString := 'ID' + IntToStr(ObjectId);
end;

procedure PopulateStringsWithDistinctValues
  (TableName : string;
   FieldName : string;
   Strings : TStrings;
   Add : boolean);
var
  Query : TDataset;
  Transaction : TIBTransaction;
  SQLStr : string;
  opened : boolean;
  Retries : integer;
  Str : string;
begin
  // if client mode get information directly from server
  if ClientMode then
  begin
    ClientCommunicator.PopulateStringsWithDistinctValues(TableName,FieldName,Strings,Add);
    Exit;
  end;

  SQLStr := 'SELECT DISTINCT ';
  SQLStr := SQLStr + DelimitSQLFieldName(FieldName);
  SQLStr := SQLStr + ' FROM "';
  SQLStr := SQLStr + TableName + '"';

  if Firebird then
  begin
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    Query := TIBQuery.Create(nil);
    TIBQuery(Query).Database := TVFirebirdDatabase;
    TIBQuery(Query).Transaction := Transaction;
    TIBQuery(Query).SQL.Clear;
    TIBQuery(Query).SQL.Add(SQLStr);
    TIBQuery(Query).Open;
    TIBQuery(Query).FetchAll;
  end else begin
    Query := TQuery.Create(nil);
    TQuery(Query).DatabaseName := BDEDatabaseName;
    TQuery(Query).SessionName := TVSessionName;
    TQuery(Query).SQL.Clear;
    TQuery(Query).SQL.Add(SQLStr);
    opened := false;
    Retries := 0;
    while not opened do
    begin
      try
        Query.Active := true;
        opened := true;
      except
        on E:Exception do
        begin
          // keep trying until table is opened
          // but count retries and show error message when limit is reached
          Inc(Retries);
          if ServerMode and (TVSessionName <> '') then
          begin
            if Retries > NoOfDatabaseRetries * 2 then
            begin
              if E is EDBEngineError then
                MessageLog.Log(FormatDBEngineError(EDBEngineError(E)))
              else
                MessageLog.Log(E.Message);
              raise;
            end;
          end else begin
            if Retries > NoOfDatabaseRetries then
            begin
              if E is EDBEngineError then
                ShowMessage(FormatDBEngineError(EDBEngineError(E)))
              else
                ShowMessage(E.Message);
              if MessageDlg('Do you wish to retry the operation that caused the error?',
                mtConfirmation, [mbYes, mbNo], 0) = mrNo then
                raise
              else
                Retries := 0;
            end;
          end;
          Sleep(PauseBetweenRetries);
        end;
      end;
    end;
  end;
  if not Add then
    Strings.Clear;
  while not Query.EOF do
  begin
    Str := TStringField(Query.FieldByName(FieldName)).Value;
    if Str <> '' then
    begin
      // if we are adding then check first to see if not already in list
      if (not Add) or (Strings.IndexOf(Str) = -1) then
        Strings.Add(Str);
    end;
    Query.Next;
  end;
  Query.Active := false;
  if Firebird then
  begin
    if TIBQuery(Query).Transaction.InTransaction then
      TIBQuery(Query).Transaction.Commit;
    TIBQuery(Query).Transaction.Free;
  end;
  Query.Free;
end;

function FieldExists
  (TableName : string;
   FieldName : string) : boolean;
var
  Table : TTable;
  IBTable : TIBTable;
  Transaction : TIBTransaction;
  FieldIndex : integer;
begin
  if Firebird then
  begin
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    IBTable := TIBTable.Create(nil);
    IBTable.Database := TVFirebirdDatabase;
    IBTable.Transaction := Transaction;
    IBTable.TableName := TableName;
    IBTable.Open;
    FieldIndex := IBTable.FieldDefs.IndexOf(FieldName);
    if (FieldIndex < 0) or (IBTable.FieldDefs[FieldIndex].Name <> FieldName) then
      Result := false
    else
      Result := true;
    IBTable.Close;
    IBTable.Free;
    if Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end else begin
    Table := TTable.Create(nil);
    Table.DatabaseName := BDEDatabaseName;
    Table.TableName := TableName;
    Table.Active := true;
    FieldIndex := Table.FieldDefs.IndexOf(FieldName);
    if (FieldIndex < 0) or (Table.FieldDefs[FieldIndex].Name <> FieldName) then
      Result := false
    else
      Result := true;
    Table.Active := false;
    Table.Free;
  end;
end;

procedure AddFieldToTable
  (TableName : string;
   FieldName : string;
   DataType : TFieldType;
   Size : integer;
   DefaultValue : variant);
var
  ExistingTable : TTable;
  NewTable : TTable;
  FieldIndex : integer;
  i : integer;
  opened : boolean;
  IBQuery : TIBQuery;
  Transaction : TIBTransaction;
  SQLStr : string;
  Int64Value : int64;
begin
  if FireBird then
  begin
    SQLStr := 'ALTER TABLE "';
    SQLStr := SQLStr + TableName;
    SQLStr := SQLStr + '" ADD "';
    SQLStr := SQLStr + FieldName + '"';
    if DataType = ftLargeint then
    begin
      SQLStr := SQLStr + ' Numeric(18, 0) ';
      Int64Value := DefaultValue;
      SQLStr := SQLStr + 'DEFAULT ' + IntToStr(Int64Value);
    end else if DataType = ftInteger then
    begin
      SQLStr := SQLStr + ' INTEGER ';
      SQLStr := SQLStr + 'DEFAULT ' + IntToStr(DefaultValue);
    end else if DataType = ftString then
    begin
      SQLStr := SQLStr + ' VARCHAR(' + IntToStr(Size) + ') ';
      SQLStr := SQLStr + 'DEFAULT ''' + DefaultValue + '''';
    end;
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    IBQuery := TIBQuery.Create(nil);
    IBQuery.Database := TVFirebirdDatabase;
    IBQuery.Transaction := Transaction;
    IBQuery.SQL.Clear;
    IBQuery.SQL.Add(SQLStr);
    IBQuery.ExecSQL;
    IBQuery.Free;
    if Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end else begin
    // create existing table component and open
    ExistingTable := TTable.Create(nil);
    ExistingTable.DatabaseName := BDEDatabaseName;
    ExistingTable.TableName := TableName;
    ExistingTable.Active := true;

    // check for existence of field
    FieldIndex := ExistingTable.FieldDefs.IndexOf(FieldName);
    if FieldIndex < 0 then
    begin
      // close existing table and open again in exclusive mode
      ExistingTable.Active := false;
      ExistingTable.Exclusive := true;
      opened := false;
      while not opened do
      begin
        try
          ExistingTable.Active := true;
          opened := true;
        except
          ShowMessage(TableName + ' table is in use by another user.  Please ask all other users to exit from ' + ProgramName + '.');
        end;
      end;

      // create new table component
      NewTable := TTable.Create(nil);
      NewTable.DatabaseName := BDEDatabaseName;
      NewTable.TableName := 'TEMP';

      // create new table from structure of existing table
      ExistingTable.FieldDefs.Update;
      NewTable.FieldDefs.Assign(ExistingTable.FieldDefs);
      ExistingTable.IndexDefs.Update;
      NewTable.IndexDefs.Assign(ExistingTable.IndexDefs);
      // add new field definition
      NewTable.FieldDefs.Add(FieldName,DataType,Size,false);
      NewTable.CreateTable;

      // move data from existing table
      NewTable.Active := true;

      ExistingTable.First;
      while not ExistingTable.EOF do
      begin
        NewTable.Insert;
        // transfer data for existing fields
        for i := 0 to ExistingTable.FieldDefs.Count - 1 do
        begin
          NewTable.FieldByName(ExistingTable.Fields[i].FieldName).Value
            := ExistingTable.Fields[i].Value;
        end;
        // set default value
        NewTable.FieldByName(FieldName).Value := DefaultValue;
        NewTable.Post;
        ExistingTable.Next;
      end;

      // delete existing table
      ExistingTable.Active := false;
      ExistingTable.DeleteTable;

      // rename new table back to existing table name
      NewTable.Active := false;
      NewTable.RenameTable(TableName);

      // destroy new table component
      NewTable.Free;
    end;
    // close existing table and destroy component
    ExistingTable.Active := false;
    ExistingTable.Free;
  end;
end;

procedure RenameField
  (TableName : string;
   OldFieldName : string;
   NewFieldName : string);
var
  IBQuery : TIBQuery;
  Transaction : TIBTransaction;
  SQLStr : string;
begin
  if FireBird then
  begin
    SQLStr := 'ALTER TABLE "';
    SQLStr := SQLStr + TableName;
    SQLStr := SQLStr + '" ALTER "';
    SQLStr := SQLStr + OldFieldName;
    SQLStr := SQLStr + '" TO "';
    SQLStr := SQLStr + NewFieldName + '"';
    Transaction := TIBTransaction.Create(nil);
    Transaction.DefaultDatabase := TVFirebirdDatabase;
    Transaction.StartTransaction;
    IBQuery := TIBQuery.Create(nil);
    IBQuery.Database := TVFirebirdDatabase;
    IBQuery.Transaction := Transaction;
    IBQuery.SQL.Clear;
    IBQuery.SQL.Add(SQLStr);
    IBQuery.ExecSQL;
    IBQuery.Free;
    if Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end;
end;

function DatabaseDirectory : string;
var
  Database : TDatabase;
  i : integer;
begin
  // check databases in global session list first
  for i := 0 to Session.DatabaseCount - 1 do
    if Session.Databases[i].DatabaseName = BDEDatabaseName then
    begin
      Session.Databases[i].Open;
      Result := Session.Databases[i].Directory;
      Exit;
    end;
  // if not found in global session list then create one
  Database := TDatabase.Create(nil);
  Database.DatabaseName := BDEDatabaseName;
  Database.Open;
  Result := Database.Directory;
  Database.Close;
  Database.Free;
end;

function GetFreeSessionName : string;
var
  i : integer;
  j : integer;
  Session : TSession;
  PrivateDir : string;
begin
  // look at all the current sessions excluding the default
  // to see if we can find one which is not being used with
  // the application database
  for i := 0 to Sessions.Count - 1 do
  begin
    Session := Sessions[i];
    if Session.SessionName <> 'Default' then
      for j := 0 to Session.DatabaseCount - 1 do
        if (Session.Databases[j].DatabaseName = BDEDatabaseName)
          and (not Session.Databases[j].Connected) then
        begin
          // open the database
          Session.OpenDatabase(BDEDatabaseName);
          Result := Session.SessionName;
          Exit;
        end;
  end;
  // if we haven't found one then we need to create one
  Result := 'RunTimeSession' + IntToStr(Sessions.Count+1);
  PrivateDir := ExeDirectory + 'PRIV' + IntToStr(Sessions.Count+1);
  // create the new session and open the database at the same time
  Session := Sessions.OpenSession(Result);
  CreateDir(PrivateDir);
  Session.PrivateDir := PrivateDir;
  Session.OpenDatabase(BDEDatabaseName);
end;

procedure CloseSessionDatabase
  (SessionName : string);
var
  i : integer;
  j : integer;
  Session : TSession;
begin
  for i := 0 to Sessions.Count - 1 do
  begin
    Session := Sessions[i];
    if Session.SessionName = SessionName then
      for j := 0 to Session.DatabaseCount - 1 do
        if Session.Databases[j].DatabaseName = BDEDatabaseName then
        begin
          Session.Databases[j].Close;
          Exit;
        end;
  end;
end;

procedure SetControlColors
  (Component : TComponent;
   Color : TColor);
var
  i : integer;
  OwnedComponent : TComponent;
begin
  for i := 0 to Component.ComponentCount - 1 do
  begin
    OwnedComponent := Component.Components[i];
    if OwnedComponent is TEdit then
      TEdit(OwnedComponent).Color := Color
    else if OwnedComponent is TMemo then
      TMemo(OwnedComponent).Color := Color
    else if OwnedComponent is TComboBox then
      TComboBox(OwnedComponent).Color := Color
    else if (OwnedComponent is TTreeView) and
      (OwnedComponent.Owner.Name <> 'MainForm') then
      TTreeView(OwnedComponent).Color := Color
    else if OwnedComponent is TDateTimePicker then
      TDateTimePicker(OwnedComponent).Color := Color
    else if OwnedComponent is TStringGrid then
      TStringGrid(OwnedComponent).Color := Color
    else if OwnedComponent is TDBGrid then
      TDBGrid(OwnedComponent).Color := Color
    else if OwnedComponent is TValueListEditor then
      TValueListEditor(OwnedComponent).Color := Color
    else if (OwnedComponent is TListBox) and
      (OwnedComponent.Name <> 'ThreadInfoListBox') then
      TListBox(OwnedComponent).Color := Color
    else
      SetControlColors(OwnedComponent,Color);
  end;
end;

function ReportFooterString : string;
begin
  Result := ProgramName + ' ' + ProgramVersion + ' by ' + DevelopmentCompanyName + '  (' + DevelopmentCompanyWebsite + ')';
end;

function DelimitSQLFieldName
  (FieldName : string) : string;
begin
  if Firebird then
    Result := '"' + FieldName + '"'
  else
    Result := FieldName;
end;

function DelimitSQLStringValue
  (StringValue : string;
   MaxLength : integer) : string;
begin
  if Firebird then
  begin
    if MaxLength <> 0 then
    begin
      // this bit of code is to workaround an apparent bug in Firebird
      // where if the last character is an #13 and it is equal to the
      // maximum length there is a problem in the SQL INSERT statement
      if (Length(StringValue)>= MaxLength)
        and (StringValue[Length(StringValue)] = #13) then
        StringValue[Length(StringValue)] := ' ';
      /////////////////////////////////////////////////////////////////
      Result := '''' + RepeatSingleQuotes(Copy(StringValue,1,MaxLength)) + ''''
    end else
      Result := '''' + RepeatSingleQuotes(StringValue) + ''''
  end else
    Result := '"' + RepeatDoubleQuotes(StringValue) + '"';
end;

function IdFieldType : TFieldType;
begin
  if Firebird then
    Result := ftLargeint
  else
    Result := ftInteger;
end;

function IdFieldValue
  (Field : TField) : int64;
begin
  if Field is TLargeIntField then
    Result := TLargeIntField(Field).Value
  else
    Result := TIntegerField(Field).Value;
end;

procedure SetIdFieldValue
  (Field : TField;
   Id : int64);
begin
  if Field is TLargeIntField then
    TLargeIntField(Field).Value := Id
  else
    TIntegerField(Field).Value := Id;
end;

function CurrencyFieldType : TFieldType;
begin
  if Firebird then
    Result := ftLargeint
  else
    Result := ftString;
end;

function CurrencyFieldSize : integer;
begin
  if Firebird then
    Result := 0
  else
    Result := 20;
end;

function CurrencyFieldValue
  (Field : TField) : int64;
begin
  if Field is TLargeIntField then
    Result := TLargeIntField(Field).Value
  else
    Result := ConvertStringToInt64(TStringField(Field).Value);
end;

procedure SetCurrencyFieldValue
  (Field : TField;
   Amount : int64);
begin
  if Field is TLargeIntField then
    TLargeIntField(Field).Value := Amount
  else
    TStringField(Field).Value := ConvertInt64ToString(Amount);
end;

function CurrencyToSQLStr
  (Amount : int64) : string;
begin
  if CurrencyFieldType = ftLargeint then
    Result := IntToStr(Amount)
  else
    Result := DelimitSQLStringValue(ConvertInt64ToString(Amount));
end;

procedure PromptUserId
  (var UserId : string;
   var Password : string);
begin
  if PromptUserIdPasswordForm.Prompt then
  begin
    UserId := PromptUserIdPasswordForm.UserId;
    Password := PromptUserIdPasswordForm.Password;
  end else
    UserId := '';
end;

procedure PromptHostNameUserId
  (var HostName : string;
   var UserId : string;
   var Password : string;
   var Passive : boolean);
begin
  if PromptHostNameUserIdPasswordForm.Prompt then
  begin
    HostName := PromptHostNameUserIdPasswordForm.HostName;
    UserId := PromptHostNameUserIdPasswordForm.UserId;
    Password := PromptHostNameUserIdPasswordForm.Password;
    Passive := PromptHostNameUserIdPasswordForm.Passive;
  end else
    HostName := '';
end;

function PromptDate
  (var Date : TDateTime) : boolean;
begin
  PromptDateForm.Date := Date;
  if PromptDateForm.Prompt then
  begin
    Date := PromptDateForm.Date;
    Result := true;
  end else
    Result := false;
end;

procedure SetLoggedOnWorkstation
  (LoggedOn : boolean);
begin
  WorkstationConfiguration.LoggedOn := LoggedOn;
  SaveWorkstationConfiguration;
end;

function NoOfLoggedOnWorkstations : integer;
var
  WorkstationConfigurations : TDatabaseObjectCollection;
  WorkstationConfiguration : TWorkstationConfiguration;
  i : integer;
begin
  // if client mode get information directly from server
  if ClientMode then
  begin
    Result := ClientCommunicator.NoOfLoggedOnWorkstations;
    Exit;
  end;

  Result := 0;
  // get the workstations from the database
  WorkstationConfigurations := nil;
  AcquireDatabaseCriticalUpdate;
  try
    LoadAllDatabaseObjects(WorkstationConfigurations,TWorkstationConfiguration);
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
  // go through each workstation in turn
  for i := 0 to WorkstationConfigurations.Count - 1 do
  begin
    WorkstationConfiguration :=
      TWorkstationConfiguration(WorkstationConfigurations[i]);
    if WorkstationConfiguration.LoggedOn then
      Inc(Result);
  end;
  // destroy collection from database
  WorkstationConfigurations.Free;
end;

function NoOfWorkstations : integer;
var
  WorkstationConfigurations : TDatabaseObjectCollection;
begin
  // if client mode get information directly from server
  if ClientMode then
  begin
    Result := ClientCommunicator.NoOfWorkstations;
    Exit;
  end;

  // get the workstations from the database
  WorkstationConfigurations := nil;
  AcquireDatabaseCriticalUpdate;
  try
    LoadAllDatabaseObjects(WorkstationConfigurations,TWorkstationConfiguration);
  finally
    ReleaseDatabaseCriticalUpdate;
  end;
  Result := WorkstationConfigurations.Count;
  // destroy collection from database
  WorkstationConfigurations.Free;
end;

function RegistrationOk : boolean;
begin
  Result := true;
  // check registration here before running
  while Result
    and (not GlobalConfiguration.CheckRegistrationCode) do
  begin
    ShowMessage('Registration code incorrect.  Please contact ' + DevelopmentCompanyName + ' to obtain a registration code.');
    if Offline or (not RegisterForm.Register) then
      Result := false;
  end;

  // check expiry date
  while Result
    and (not GlobalConfiguration.Unlimited)
    and (Date > GlobalConfiguration.ExpiryDate) do
  begin
    ShowMessage('Software expired.  Please contact ' + DevelopmentCompanyName + ' to obtain a registration code.');
    if Offline or (not RegisterForm.Register) then
      Result := false;
  end;

  // check number of workstations
  while Result
    and (not ServerMode)
    and (not Offline)
    and (not GlobalConfiguration.Unlimited)
    and (NoOfLoggedOnWorkstations > GlobalConfiguration.NoOfWorkstations) do
  begin
    ShowMessage('No of workstations exceeded.  Please contact ' + DevelopmentCompanyName + ' to obtain a registration code.');
    if not RegisterForm.Register then
      Result := false;
  end;

  // check if close to expiry date and show warning
  if Result
    and (not GlobalConfiguration.Unlimited)
    and (GlobalConfiguration.ExpiryDate - Date < 7) then
    ShowMessage('Software will expire soon.  Please contact ' + DevelopmentCompanyName + ' to obtain a registration code.');
end;

function CheckBDEDatabaseConnection : boolean;
var
  Database : TDatabase;
  Table : TTable;
  PrivateDir : string;
begin
  // try to open connection to database and
  // workstation configuration table to check that we can access the database
  Result := false;
  Database := TDatabase.Create(nil);
  Database.DatabaseName := BDEDatabaseName;
  Table := TTable.Create(nil);
  Table.DatabaseName := BDEDatabaseName;
  Table.TableName := TWorkstationConfiguration.TableName;
  try
    try
      Database.Open;
      Database.Close;
      // try to open table but if the table does not exist
      // then this is okay as the program will create it
      try
        Table.Open;
        Table.Close;
      except
        on E:EDBEngineError do
          if E.Errors[0].Errorcode <> eNoSuchTable then
            raise;
      end;
      Result := true;
    except
    end;
  finally
    Table.Free;
    Database.Free;
  end;
  // create the BDE private directory for the default session
  // if it does not exist
  if Result then
  begin
    PrivateDir := ExeDirectory + 'PRIV';
    CreateDir(PrivateDir);
    Session.PrivateDir := PrivateDir;
  end;
end;

function CheckFirebirdDatabaseConnection;
var
  Transaction : TIBTransaction;
  Table : TIBTable;
begin
  // try to open connection to database and
  // workstation configuration table to check that we can access the database
  Result := false;
  Transaction := nil;
  Table := nil;
  try
    try
      TVFirebirdDatabase := TIBDatabase.Create(nil);
      TVFirebirdDatabase.DatabaseName := FirebirdServerIPAddress + ':' + FirebirdDatabaseName;
      TVFirebirdDatabase.Params.Add('user_name=' + FirebirdUsername);
      TVFirebirdDatabase.Params.Add('password=' + FirebirdPassword);
      TVFirebirdDatabase.LoginPrompt := false;
      try
        TVFirebirdDatabase.Open;
      except
        on E:EIBInterbaseError do
        begin
          if E.IBErrorCode = isc_io_error then
          begin
            TVFirebirdDatabase.Params.Clear;
            TVFirebirdDatabase.Params.Add('USER "' + FirebirdUsername + '"');
            TVFirebirdDatabase.Params.Add('PASSWORD "' + FirebirdPassword + '"');
            TVFirebirdDatabase.Params.Add('PAGE_SIZE 4096');
            TVFirebirdDatabase.SQLDialect := 3;
            TVFirebirdDatabase.CreateDatabase;
          end else if E.IBErrorCode = isc_unavailable then
            // don't bother showing message
            // just allow function to return false
            raise
          else begin
            ShowMessage(E.Message);
            raise;
          end;
        end;
      end;

      Transaction := TIBTransaction.Create(nil);
      Transaction.DefaultDatabase := TVFirebirdDatabase;
      Transaction.StartTransaction;

      Table := TIBTable.Create(nil);
      Table.Database := TVFirebirdDatabase;
      Table.Transaction := Transaction;

      Table.TableName := TWorkstationConfiguration.TableName;
      // try to open table but if the table does not exist
      // then this is okay as the program will create it
      try
        Table.Open;
        Table.Close;
      except
        on E:EIBInterbaseError do
        begin
          if E.IBErrorCode <> isc_dsql_error then
          begin
            ShowMessage(E.Message);
            raise;
          end;
        end;
      end;
      Result := true;
    except
      on E:Exception do
        ShowMessage(E.Message);
    end;
  finally
    Table.Free;
    if (Transaction <> nil) and Transaction.InTransaction then
      Transaction.Commit;
    Transaction.Free;
  end;
end;

function CheckPrinterDriver : boolean;
var
  ObjectListingReport : TProxyObjectListingReport;
begin
  Result := false;
  // try creating a quick reports report
  try
    ObjectListingReport := TProxyObjectListingReport.Create(nil);
    ObjectListingReport.Free;
    Result := true;
  except
  end;
end;

type
  TFMCompressor = class(TLZWCompressor)
  public
    FInStream : TStream;
    FOutStream : TStream;
    FInputBytesToProcess : integer;
    FInputBytesProcessed : integer;
    FOutputBytesProcessed : integer;
    constructor Create(anOwner : TComponent); override;
    procedure FMGetData(Sender: TObject;
      pData: Pointer; var cbData: Integer);
    procedure FMSetData(Sender: TObject;
      pData: Pointer; var cbData: Integer);
  end;

constructor TFMCompressor.Create(anOwner : TComponent);
begin
  inherited Create(anOwner);
  OnGetData := FMGetData;
  OnSetData := FMSetData;
end;

procedure TFMCompressor.FMGetData(Sender: TObject;
 pData: Pointer; var cbData: Integer);
begin
  if (FInputBytesToProcess <> 0)
    and (cbData > FInputBytesToProcess - FInputBytesProcessed) then
      cbData :=  FInputBytesToProcess - FInputBytesProcessed;
  cbData := FInStream.Read( pData^, cbData );
  FInputBytesProcessed := FInputBytesProcessed + cbData;
end;

procedure TFMCompressor.FMSetData(Sender: TObject;
  pData: Pointer; var cbData: Integer);
begin
  FOutStream.write( pData^, cbData );
  FOutputBytesProcessed := FOutputBytesProcessed + cbData;
end;

procedure CompressData
  (InStream : TStream;
   OutStream : TStream;
   InputBytesToProcess : integer;  // no of bytes in input stream to process, 0 means go to end of stream
   var InputBytesProcessed : integer;    // no of bytes in input stream which were actually processed
   var OutputBytesProcessed : integer);  // no of bytes placed into output stream
var
  FMCompressor : TFMCompressor;
begin
  FMCompressor := TFMCompressor.Create(nil);
  FMCompressor.FInStream := InStream;
  FMCompressor.FOutStream := OutStream;
  FMCompressor.FInputBytesToProcess := InputBytesToProcess;
  FMCompressor.Compress;
  InputBytesProcessed := FMCompressor.FInputBytesProcessed;
  OutputBytesProcessed := FMCompressor.FOutputBytesProcessed;
  FMCompressor.Free;
end;

procedure DecompressData
  (InStream : TStream;
   OutStream : TStream;
   InputBytesToProcess : integer;  // no of bytes in input stream to process, 0 means go to end of stream
   var InputBytesProcessed : integer;    // no of bytes in input stream which were actually processed
   var OutputBytesProcessed : integer);  // no of bytes placed into output stream
var
  FMCompressor : TFMCompressor;
begin
  FMCompressor := TFMCompressor.Create(nil);
  FMCompressor.FInStream := InStream;
  FMCompressor.FOutStream := OutStream;
  FMCompressor.FInputBytesToProcess := InputBytesToProcess;
  FMCompressor.Decompress;
  InputBytesProcessed := FMCompressor.FInputBytesProcessed;
  OutputBytesProcessed := FMCompressor.FOutputBytesProcessed;
  FMCompressor.Free;
end;

function CompressString
  (Str : string) : string;
var
  InStream : TStringStream;
  OutStream : TStringStream;
  UncompressedBytesProcessed : integer;
  CompressedBytesProcessed : integer;
begin
  InStream := TStringStream.Create(Str);
  OutStream := TStringStream.Create('');
  try
    InStream.Position := 0;
    CompressData(InStream,OutStream,0,UncompressedBytesProcessed,CompressedBytesProcessed);
    // don't send compressed data if there is no great advantage
    if CompressedBytesProcessed > UncompressedBytesProcessed - 30 then
      Result := 'u' + Str
    else
      Result := 'c' + '{' + IntToStr(UncompressedBytesProcessed) + '}'
                    + '[' + IntToStr(CompressedBytesProcessed) + ']' + OutStream.DataString;
  finally
    InStream.Free;
    OutStream.Free;
  end;
end;

function DecompressString
  (Str : string) : string;
var
  InStream : TStringStream;
  OutStream : TStringStream;
  PreviousUncompressedBytesProcessed : integer;
  PreviousCompressedBytesProcessed : integer;
  PreviousUncompressedBytesProcessedStr : string;
  PreviousCompressedBytesProcessedStr : string;
  UncompressedBytesProcessed : integer;
  CompressedBytesProcessed : integer;
  i : integer;
  NullByte : byte;
begin
  if (Length(Str) > 0) and (Str[1] = 'u') then
  begin
    Delete(Str,1,1);
    Result := Str;
    Exit;
  end;
  NullByte := 0;
  Delete(Str,1,1);
  PreviousUncompressedBytesProcessedStr := Copy(Str,2,Pos('}',Str)-2);
  PreviousUncompressedBytesProcessed := StrToIntDef(PreviousUncompressedBytesProcessedStr,0);
  Delete(Str,1,Pos('}',Str));
  PreviousCompressedBytesProcessedStr := Copy(Str,2,Pos(']',Str)-2);
  PreviousCompressedBytesProcessed := StrToIntDef(PreviousCompressedBytesProcessedStr,0);
  Delete(Str,1,Pos(']',Str));
  InStream := TStringStream.Create(Str);
  OutStream := TStringStream.Create('');
  try
    InStream.Position := 0;
    DecompressData(InStream,OutStream,PreviousCompressedBytesProcessed,CompressedBytesProcessed,UncompressedBytesProcessed);
    Result := OutStream.DataString;
    // check resulting byte counters
    if CompressedBytesProcessed <> PreviousCompressedBytesProcessed then
      raise Exception.Create('Number of input bytes do not match after decompress');
    if UncompressedBytesProcessed < PreviousUncompressedBytesProcessed then
    begin
      // this appears to be a bug in the decompression code so we will pad out the difference
      // with nulls
      for i := 0 to PreviousUncompressedBytesProcessed - UncompressedBytesProcessed - 1 do
        Result := Result + Char(NullByte);
    end else if UncompressedBytesProcessed > PreviousUncompressedBytesProcessed then
      raise Exception.Create('Number of output bytes greater after decompress');
  finally
    InStream.Free;
    OutStream.Free;
  end;
end;

// this procedure takes all the files in the directory
// InputDirectoryName and compresses them using LZW compression
// into the file OutputFileName.  If this file already exists
// it is overwritten.
// Note that InputDirectoryName is assumed to include trailing '\' character
procedure CompressDirectory
  (InputDirectoryName : string;
   OutputFileName : string);
var
  InFileNames : TStringList;
  SearchRec : TSearchRec;
  OutStream : TFileStream;
  InStream : TFileStream;
  i : integer;
  InFileName : string;
  UncompressedBytesProcessed : integer;
  CompressedBytesProcessed : integer;
  StartPosition : integer;
  EndPosition : integer;

  opened : boolean;
  Retries : integer;
begin
  ProgressForm.SetStep(1);
  ProgressForm.SetCaption('Compressing database. Please wait...');
  ProgressForm.Show;
  InFileNames := nil;
  OutStream := nil;
  InStream := nil;
  try
    // build list of all files in directory
    InFileNames := TStringList.Create;
    if FindFirst(InputDirectoryName + '*.*', faAnyFile, SearchRec) = 0 then
      repeat
        InFileNames.Add(SearchRec.Name);
      until FindNext(SearchRec) <> 0;
    SysUtils.FindClose(SearchRec);

    // open output file
    // always create a new one
    OutStream := TFileStream.Create(OutputFileName,fmShareExclusive or fmCreate);
    OutStream.Seek(0,soFromBeginning);

    // compress each input file
    for i := 0 to InFileNames.Count - 1 do
    begin
      InFileName := InFileNames[i];
      if (InFileName <> '.') and (InFileName <> '..') then
      begin
        // open input file
        InStream.Free;

        opened := false;
        Retries := 0;
        while not opened do
        begin
          try
            InStream := TFileStream.Create(DatabaseDirectory + InFileName,fmShareExclusive or fmOpenRead);
            opened := true;
          except
            on E:Exception do
            begin
              // reset reference to nil
              InStream := nil;
              // keep trying until file is opened
              // but count retries and show error message when limit is reached
              Inc(Retries);
              if Retries > NoOfDatabaseRetries then
              begin
                ShowMessage(E.Message);
                if MessageDlg('Do you wish to retry the operation that caused the error?',
                  mtConfirmation, [mbYes, mbNo], 0) = mrNo then
                  raise
                else
                  Retries := 0;
              end;
              Sleep(PauseBetweenRetries);
            end;
          end;
        end;

        // record name of file in output stream
        WriteStrToStream(InFileName,OutStream);
        // record current position in output stream
        StartPosition := OutStream.Position;
        // reserve space for byte counters
        OutStream.Write(UncompressedBytesProcessed,SizeOf(UncompressedBytesProcessed));
        OutStream.Write(CompressedBytesProcessed,SizeOf(CompressedBytesProcessed));
        // do compression
        ProgressForm.StepIt;
        CompressData(InStream,OutStream,0,UncompressedBytesProcessed,CompressedBytesProcessed);
        // record ending position
        EndPosition := OutStream.Position;
        // record byte counters
        OutStream.Seek(StartPosition,soFromBeginning);
        OutStream.Write(UncompressedBytesProcessed,SizeOf(UncompressedBytesProcessed));
        OutStream.Write(CompressedBytesProcessed,SizeOf(CompressedBytesProcessed));
        // return to ending position
        OutStream.Seek(EndPosition,soFromBeginning);
      end;
    end;

  finally
    //clean up
    OutStream.Free;
    InStream.Free;
    InFileNames.Free;
    ProgressForm.Hide;
  end;
end;

// this procedure takes a LZW compressed file created by the
// previous procedure and decompresses it to the directory
// specified by OutputDirectoryName.
// Note that OutputDirectoryName is assumed to NOT include a trailing '\' character
procedure DecompressFile
  (InputFileName : string;
   OutputDirectoryName : string);
var
  OutFileName : string;
  OutStream : TFileStream;
  InStream : TFileStream;
  PreviousUncompressedBytesProcessed : integer;
  PreviousCompressedBytesProcessed : integer;
  UncompressedBytesProcessed : integer;
  CompressedBytesProcessed : integer;
  i : integer;
  NullByte : byte;
begin
  InStream := nil;
  OutStream := nil;
  NullByte := 0;
  if CreateDir(OutputDirectoryName) then
  begin
    try
      // open input file
      InStream :=  TFileStream.Create(InputFileName,fmShareExclusive or fmOpenRead);
      // read file name and byte counters from input stream
      OutFileName := ReadStrFromStream(InStream);
      InStream.Read(PreviousUncompressedBytesProcessed,SizeOf(PreviousUncompressedBytesProcessed));
      InStream.Read(PreviousCompressedBytesProcessed,SizeOf(PreviousCompressedBytesProcessed));
      while OutFileName <> '' do
      begin
        // open output file
        OutStream.Free;
        OutStream := TFileStream.Create(OutputDirectoryName + '\' + OutFileName,fmShareExclusive or fmCreate);
        // do decompression
        DecompressData(InStream,OutStream,PreviousCompressedBytesProcessed,CompressedBytesProcessed,UncompressedBytesProcessed);
        // check resulting byte counters
        if CompressedBytesProcessed <> PreviousCompressedBytesProcessed then
          raise Exception.Create('Number of input bytes do not match after decompress');
        if UncompressedBytesProcessed < PreviousUncompressedBytesProcessed then
        begin
          // this appears to be a bug in the decompression code so we will pad out the difference
          // with nulls
          for i := 0 to PreviousUncompressedBytesProcessed - UncompressedBytesProcessed - 1 do
            OutStream.Write(NullByte,1);
        end else if UncompressedBytesProcessed > PreviousUncompressedBytesProcessed then
          raise Exception.Create('Number of output bytes greater after decompress');
        // read file name and byte counters from input stream
        OutFileName := ReadStrFromStream(InStream);
        InStream.Read(PreviousUncompressedBytesProcessed,SizeOf(PreviousUncompressedBytesProcessed));
        InStream.Read(PreviousCompressedBytesProcessed,SizeOf(PreviousCompressedBytesProcessed));
      end;
    finally
      OutStream.Free;
      InStream.Free;
    end;
  end else
    ShowMessage(OutputDirectoryName + ' already exists');
end;

procedure CompressDatabase;
begin
  if MainForm <> nil then
    MainForm.CloseDataAwareComponents;
  try
    CompressDirectory(DatabaseDirectory,ExeDirectory + Trim(GlobalConfiguration.CompanyName) + '.LZW');
  finally
    if MainForm <> nil then
      MainForm.OpenDataAwareComponents;
  end;
end;

procedure SendDatabase;
var
  HostName : string;
  UserId : string;
  Password : string;
  Passive : boolean;
begin
  PromptHostNameUserId(
    HostName,
    UserId,
    Password,
    Passive);
  if HostName = '' then
    Exit;

  CompressDatabase;

  if not SendFileViaFTP
    (ExeDirectory + Trim(GlobalConfiguration.CompanyName) + '.LZW',
     HostName,
     UserId,
     Password,
     Passive,
     true) then
      MessageDlg('An error occurred while attempting to send database',mtWarning,[mbOk],0)
    else
      MessageDlg('Database sent successfully',mtInformation,[mbOk],0);
end;

procedure DecompressDatabase;
var
  InputFileName : string;
  OutputDirectoryName : string;
begin
  if ChooseLZWFile(InputFileName) then
  begin
    OutputDirectoryName := InputFileName + '$';
    DecompressFile(InputFileName,OutputDirectoryName);
  end;
end;

procedure UpdateAllComboBoxes
  (Full : boolean);
begin
  MainForm.UpdateAllComboBoxes(Full);
end;

{***** TDoubleEntryAccumulator methods ****************************************}

constructor TDoubleEntryAccumulator.Create;
begin
  FList := TList.Create;
end;

destructor TDoubleEntryAccumulator.Destroy;
begin
  DestroyList(FList);
end;

procedure TDoubleEntryAccumulator.Accumulate
  (Date : TDateTime;
   DebitAccountId : int64;
   DebitDescription : string;
   CreditAccountId : int64;
   CreditDescription : string;
   Amount : int64);
var
  i : integer;
  DoubleEntryRecord : TDoubleEntryRecord;
begin
  DoubleEntryRecord := nil;
  for i := 0 to FList.Count - 1 do
  begin
    if    (TDoubleEntryRecord(FList[i]).Date = Date)
      and (TDoubleEntryRecord(FList[i]).DebitAccountId = DebitAccountId)
      and (TDoubleEntryRecord(FList[i]).DebitDescription = DebitDescription)
      and (TDoubleEntryRecord(FList[i]).CreditAccountId = CreditAccountId)
      and (TDoubleEntryRecord(FList[i]).CreditDescription = CreditDescription) then
    begin
      DoubleEntryRecord := TDoubleEntryRecord(FList[i]);
      break;
    end;
  end;
  if DoubleEntryRecord = nil then
  begin
    DoubleEntryRecord := TDoubleEntryRecord.Create;
    DoubleEntryRecord.Date := Date;
    DoubleEntryRecord.DebitAccountId := DebitAccountId;
    DoubleEntryRecord.DebitDescription := DebitDescription;
    DoubleEntryRecord.CreditAccountId := CreditAccountId;
    DoubleEntryRecord.CreditDescription := CreditDescription;
    FList.Add(DoubleEntryRecord);
  end;
  DoubleEntryRecord.Amount := DoubleEntryRecord.Amount + Amount;
end;

procedure TDoubleEntryAccumulator.Post
  (OnStatement : boolean;
   NotifyWorkstations : boolean);
var
  i : integer;
  DoubleEntryRecord : TDoubleEntryRecord;
  CombinedEntryId : int64;
  DebitCashbook : TCashbook;
  CreditCashbook : TCashbook;
begin
  for i := 0 to FList.Count - 1 do
  begin
    // create ledger double entry
    DoubleEntryRecord := TDoubleEntryRecord(FList[i]);
    CombinedEntryId := UpdateDoubleEntry
      (0,
       DoubleEntryRecord.Date,
       DoubleEntryRecord.DebitAccountId,
       DoubleEntryRecord.DebitDescription,
       DoubleEntryRecord.CreditAccountId,
       DoubleEntryRecord.CreditDescription,
       DoubleEntryRecord.Amount,
       NotifyWorkstations);
    // create cashbook entry if an account has an associated cashbook
    DebitCashbook := Utilities.CashbookFromAccountId(DoubleEntryRecord.DebitAccountId);
    CreditCashbook := Utilities.CashbookFromAccountId(DoubleEntryRecord.CreditAccountId);
    if DebitCashbook <> nil then
      UpdateCashbookEntry
        (DebitCashbook.Id,
         DoubleEntryRecord.CreditAccountId,
         CombinedEntryId,
         DoubleEntryRecord.DebitDescription,
         DoubleEntryRecord.Date,
         DoubleEntryRecord.Amount,
         OnStatement,
         NotifyWorkstations)
    else if CreditCashbook <> nil then
      UpdateCashbookEntry
        (CreditCashbook.Id,
         DoubleEntryRecord.DebitAccountId,
         CombinedEntryId,
         DoubleEntryRecord.CreditDescription,
         DoubleEntryRecord.Date,
         -DoubleEntryRecord.Amount,
         OnStatement,
         NotifyWorkstations);
  end;
end;

{******************************************************************************}

procedure CreateDoubleEntry
  (var CombinedEntry : TCombinedEntry;
   Date : TDateTime;
   DebitAccountId : int64;
   DebitDescription : string;
   CreditAccountId : int64;
   CreditDescription : string;
   Amount : int64);
var
  Entry : TEntry;
begin
  if CombinedEntry = nil then
    CombinedEntry := TCombinedEntry.Create;
  CombinedEntry.Date := Date;
  // create debit entry
  Entry := TEntry.Create;
  CombinedEntry.Entries.Add(Entry);
  Entry.AccountId := DebitAccountId;
  Entry.Description := DebitDescription;
  if (Entry.Account <> nil) and
    (Entry.Account.Credit) then
    Entry.Amount := -Amount
  else
    Entry.Amount := Amount;
  // create credit entry
  Entry := TEntry.Create;
  CombinedEntry.Entries.Add(Entry);
  Entry.AccountId := CreditAccountId;
  Entry.Description := CreditDescription;
  if (Entry.Account <> nil) and
    (Entry.Account.Debit) then
    Entry.Amount := -Amount
  else
    Entry.Amount := Amount;
end;

function PostDoubleEntry
  (CombinedEntryId : int64;
   var CombinedEntry : TCombinedEntry;
   NotifyWorkstations : boolean) : int64;
begin
  // update database
  CombinedEntry.Id := CombinedEntryId;
  CombinedEntry.UpdateDatabase(NotifyWorkstations);
  // return combined entry id
  Result := CombinedEntry.Id;
  // free memory
  CombinedEntry.Free;
  CombinedEntry := nil;
end;

function UpdateDoubleEntry
  (CombinedEntryId : int64;
   Date : TDateTime;
   DebitAccountId : int64;
   DebitDescription : string;
   CreditAccountId : int64;
   CreditDescription : string;
   Amount : int64;
   NotifyWorkstations : boolean) : int64;
var
  CombinedEntry : TCombinedEntry;
begin
  CombinedEntry := nil;
  CreateDoubleEntry
    (CombinedEntry,
     Date,
     DebitAccountId,
     DebitDescription,
     CreditAccountId,
     CreditDescription,
     Amount);
  Result := PostDoubleentry
    (CombinedEntryId,
     CombinedEntry,
     NotifyWorkstations);
end;

procedure UpdateCashbookEntry
  (CashbookId : int64;
   OtherAccountId : int64;
   CombinedEntryId : int64;
   Description : string;
   Date : TDateTime;
   Amount : int64;
   OnStatement : boolean;
   NotifyWorkstations : boolean);
var
  SelectionString : string;
  CashbookEntry : TCashbookEntry;
begin
  SelectionString := 'WHERE ' + DelimitSQLFieldName('CombinedEntryId') + ' = ' + IntToStr(CombinedEntryId);
  CashbookEntry := TCashbookEntry(LoadDatabaseObject(TCashbookEntry,SelectionString));
  // if no existing cashbook entry then create one
  if CashbookEntry = nil then
    CashbookEntry := TCashbookEntry.Create;
  CashbookEntry.CashbookId := CashbookId;
  CashbookEntry.OtherAccountId := OtherAccountId;
  CashbookEntry.CombinedEntryId := CombinedEntryId;
  CashbookEntry.Description := Description;
  CashbookEntry.Date := Date;
  CashbookEntry.Amount := Amount;
  CashbookEntry.OnStatement := OnStatement;
  // update database
  CashbookEntry.FullSaveToDatabase(true);
  // notify the other workstations
  if NotifyWorkstations then
    UpdateDatabaseObjectOnLoggedOnWorkstations
      (TCashbookEntry,CashbookEntry);
  //free memory
  CashbookEntry.Free;
end;

procedure CreateCashbookEntry
  (CashbookId : int64;
   OtherAccountId : int64;
   CombinedEntryId : int64;
   Description : string;
   Date : TDateTime;
   Amount : int64;
   OnStatement : boolean;
   NotifyWorkstations : boolean);
var
  CashbookEntry : TCashbookEntry;
begin
  CashbookEntry := TCashbookEntry.Create;
  CashbookEntry.CashbookId := CashbookId;
  CashbookEntry.OtherAccountId := OtherAccountId;
  CashbookEntry.CombinedEntryId := CombinedEntryId;
  CashbookEntry.Description := Description;
  CashbookEntry.Date := Date;
  CashbookEntry.Amount := Amount;
  CashbookEntry.OnStatement := OnStatement;
  // update database
  CashbookEntry.FullSaveToDatabase(true);
  // notify the other workstations
  if NotifyWorkstations then
    UpdateDatabaseObjectOnLoggedOnWorkstations
      (TCashbookEntry,CashbookEntry);
  //free memory
  CashbookEntry.Free;
end;

procedure DeleteCashbookEntries
  (CombinedEntryId : int64;
   NotifyWorkstations : boolean);
var
  SelectionString : string;
  CashbookEntries : TDatabaseObjectCollection;
  i : integer;
begin
  SelectionString := 'WHERE ' + DelimitSQLFieldName('CombinedEntryId') + ' = ' + IntToStr(CombinedEntryId);
  CashbookEntries := nil;
  LoadSomeDatabaseObjects(CashbookEntries,TCashbookEntry,SelectionString);
  CashbookEntries.DeleteFromDatabase(TCashbookEntry,NotifyWorkstations);
  // notify the other workstations (since TCashbookEntry is not stored in a global collection)
  if NotifyWorkstations then
    for i := 0 to CashbookEntries.Count - 1 do
      DeleteDatabaseObjectFromLoggedOnWorkstations(TCashbookEntry,CashbookEntries[i].Id);
  // free memory
  CashbookEntries.Free;
end;

procedure UpdateSaleToLedger
  (Sale : TSale);
var
  SalesAccountId : int64;
  BankAccountId : int64;
  Entries : TDatabaseObjectCollection;
  SelectionString : string;
  Entry : TEntry;
  i : integer;


  CombinedEntryId : int64;
  CombinedEntryDate : TDateTime;
  Description : string;
  DebitAccountId : int64;
  CreditAccountId : int64;
  Amount : int64;

  DebitCashbook : TCashbook;
  CreditCashbook : TCashbook;
begin
  BankAccountId := AccountIdFromAbbreviation(Sale.CompanyId,GlobalConfiguration.BankAccountAbbreviation);
  SalesAccountId := AccountIdFromAbbreviation(Sale.CompanyId,GlobalConfiguration.SalesAccountAbbreviation);
  if (BankAccountId = 0) or (SalesAccountId = 0) then
    Exit;

  // get entries in sales account for sale date
  Entries := nil;
  if Firebird then
    SelectionString := 'WHERE ' + DelimitSQLFieldName('Date') + ' = '
  else
    SelectionString := 'WHERE Entry."Date" = ';
  SelectionString := SelectionString + DelimitSQLStringValue(ConvertDateToDatabaseString(Trunc(Sale.DateTime))) + ' AND ' + DelimitSQLFieldName('AccountId') + ' = ' + IntToStr(SalesAccountId);
  LoadSomeDatabaseObjects(Entries,TEntry,SelectionString);
  try
    if Sale.TotalPrice >= 0 then
      Description := POSSalesDescription
    else
      Description := POSCreditsDescription;
    // look for existing entry
    Entry := nil;
    for i := 0 to Entries.Count - 1 do
      if TEntry(Entries[i]).Description = Description then
      begin
        Entry := TEntry(Entries[i]);
        break;
      end;
    // set up double entry details
    if Entry <> nil then
    begin
      CombinedEntryId := Entry.CombinedEntryId;
      CombinedEntryDate := Entry.Date;
    end else begin
      CombinedEntryId := 0;
      CombinedEntryDate := Trunc(Sale.DateTime);
    end;
    if Sale.TotalPrice >= 0 then
    begin
      DebitAccountId := BankAccountId;
      CreditAccountId := SalesAccountId;
      Amount := Sale.TotalPrice;
    end else begin
      DebitAccountId := SalesAccountId;
      CreditAccountId := BankAccountId;
      Amount := -Sale.TotalPrice;
    end;
    if Entry <> nil then
      Amount := Amount + Entry.CombinedEntry.TotalCredits;
    // update double entry
    CombinedEntryId := UpdateDoubleEntry
      (CombinedEntryId,
       CombinedEntryDate,
       DebitAccountId,
       Description,
       CreditAccountId,
       Description,
       Amount,
       true);
    // update cashbook entry if an account has an associated cashbook
    DebitCashbook := CashbookFromAccountId(DebitAccountId);
    CreditCashbook := CashbookFromAccountId(CreditAccountId);
    if DebitCashbook <> nil then
      UpdateCashbookEntry
        (DebitCashbook.Id,
         CreditAccountId,
         CombinedEntryId,
         Description,
         CombinedEntryDate,
         Amount,
         false,
         true)
    else if CreditCashbook <> nil then
      UpdateCashbookEntry
        (CreditCashbook.Id,
         DebitAccountId,
         CombinedEntryId,
         Description,
         CombinedEntryDate,
         -Amount,
         false,
         true);
  finally
    Entries.Free;
  end;
end;

procedure LoadReportLayoutsFromWorkstationConfiguration;
var
  StringStream : TStringStream;
begin
  if ReportLayouts = nil then
  begin
    ReportLayouts := TBusinessObjectCollection.Create;
    ReportLayouts.Owned := true;
  end else
    ReportLayouts.Clear;
  if WorkstationConfiguration.ReportLayouts.AsString <> '' then
  begin
    StringStream := TStringStream.Create(WorkstationConfiguration.ReportLayouts.AsString);
    StringStream.Position := 0;
    try
      ReportLayouts.LoadFromStream(StringStream);
    except
      // if error occurs during load then clear collection
      ReportLayouts.Clear;
    end;
    StringStream.Free;
  end;
end;

procedure SaveReportLayoutsToWorkstationConfiguration;
var
  StringStream : TStringStream;
begin
  if ReportLayouts = nil then
    Exit;
  StringStream := TStringStream.Create('');
  ReportLayouts.SaveToStream(StringStream);
  WorkstationConfiguration.ReportLayouts.SetString(StringStream.DataString);
  StringStream.Free;
end;

function ReportLayout
  (CompanyId : int64;
   ReportLayoutType : TReportLayoutType) : TReportLayout;
var
  i : integer;
begin
  if ReportLayouts = nil then
    LoadReportLayoutsFromWorkstationConfiguration;
  Result := nil;
  // look for existing report layout for currently selected company
  // with given type
  for i := 0 to ReportLayouts.Count - 1 do
    if (TReportLayout(ReportLayouts[i]).CompanyId = CompanyId)
    and (TReportLayout(ReportLayouts[i]).ReportLayoutType = ReportLayoutType) then
    begin
      Result := TReportLayout(ReportLayouts[i]);
      Exit;
    end;
end;

function RetainedEarnings
  (CompanyId : int64;
   AsAtDate : TDateTime) : int64;
var
  i : integer;
  Account : TAccount;
  CachedAccount : TAccount;
  AccountBalance : int64;
begin
  Result := 0;
  for i := 0 to Globals.Accounts.Count - 1 do
  begin
    Account := TAccount(Globals.Accounts[i]);
    if (Account.CompanyId = CompanyId) and
      (Account.IncomeStatement) then
    begin
      // get cached account before calculating balance
      CachedAccount := AccountsCache.GetAccount(Account.Id);
      AccountBalance := CachedAccount.BalanceAsAt(AsAtDate);
      // reverse the sign on debit accounts
      if Account.Debit then
        AccountBalance := -AccountBalance;
      // accumulate balances
      Result := Result + AccountBalance;
    end;
  end;
end;

function CompanyName
  (CompanyId : int64) : string;
var
  Company : TCompany;
begin
  Company := TCompany(FormatObjectProperty
    (Companies, CompanyId, Result));
  if Company <> nil then
    Result := Company.Name;
end;

function CompanyAbbreviation
  (CompanyId : int64) : string;
var
  Company : TCompany;
begin
  Company := TCompany(FormatObjectProperty
    (Companies, CompanyId, Result));
  if Company <> nil then
    Result := Company.Abbreviation;
end;

function CompanyIdFromAbbreviation
  (Abbreviation : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Companies.Count - 1 do
  begin
    if TCompany(Companies[i]).Abbreviation = Abbreviation then
    begin
      Result := TCompany(Companies[i]).Id;
      Exit;
    end;
  end;
end;

function CompanyIdFromName
  (Name : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Companies.Count - 1 do
  begin
    if TCompany(Companies[i]).Name = Name then
    begin
      Result := TCompany(Companies[i]).Id;
      Exit;
    end;
  end;
end;

function CompanyComboBoxDisplayString
  (CompanyId : int64) : string;
var
  Company : TCompany;
begin
  Company := TCompany(FormatObjectProperty
    (Companies, CompanyId, Result));
  if Company <> nil then
    Result := Company.ComboBoxDisplayString;
end;

function AccountName
  (AccountId : int64) : string;
var
  Account : TAccount;
begin
  Account := TAccount(FormatObjectProperty
    (Accounts, AccountId, Result));
  if Account <> nil then
    Result := Account.Name;
end;

function AccountAbbreviation
  (AccountId : int64) : string;
var
  Account : TAccount;
begin
  Account := TAccount(FormatObjectProperty
    (Accounts, AccountId, Result));
  if Account <> nil then
    Result := Account.Abbreviation;
end;

function AccountCombinedAbbreviation
  (AccountId : int64) : string;
var
  Account : TAccount;
begin
  Account := TAccount(FormatObjectProperty
    (Accounts, AccountId, Result));
  if Account <> nil then
    Result := Account.CombinedAbbreviation;
end;

function AccountType
  (AccountId : int64) : TAccountType;
var
  i : integer;
begin
  for i := 0 to Accounts.Count - 1 do
    if TAccount(Accounts[i]).Id = AccountId then
    begin
      Result := TAccount(Accounts[i]).AccountType;
      Exit;
    end;
  // default to asset if not found
  Result := atAsset;
end;

function AccountCompanyId
  (AccountId : int64) : int64;
var
  i : integer;
begin
  for i := 0 to Accounts.Count - 1 do
    if TAccount(Accounts[i]).Id = AccountId then
    begin
      Result := TAccount(Accounts[i]).CompanyId;
      Exit;
    end;
  // default to zero if not found
  Result := 0;
end;

function AccountDescription
  (AccountId : int64) : string;
var
  i : integer;
begin
  for i := 0 to Accounts.Count - 1 do
    if TAccount(Accounts[i]).Id = AccountId then
    begin
      Result := TAccount(Accounts[i]).Description;
      Exit;
    end;
  // default to empty string if not found
  Result := '';
end;

function AccountComboBoxDisplayString
  (AccountId : int64) : string;
var
  Account : TAccount;
begin
  Account := TAccount(FormatObjectProperty
    (Accounts, AccountId, Result));
  if Account <> nil then
    Result := Account.ComboBoxDisplayString;
end;

function AccountIdFromCombinedAbbreviation
  (CombinedAbbreviation : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Accounts.Count - 1 do
  begin
    if TAccount(Accounts[i]).CombinedAbbreviation = CombinedAbbreviation then
    begin
      Result := TAccount(Accounts[i]).Id;
      Exit;
    end;
  end;
end;

function AccountIdFromAbbreviation
  (CompanyId : int64;
   Abbreviation : string) : int64;
var
  i : integer;
  Account : TAccount;
begin
  Result := 0;
  for i := 0 to Accounts.Count - 1 do
  begin
    Account := TAccount(Accounts[i]);
    if (Account.CompanyId = CompanyId)
      and (Account.Abbreviation = Abbreviation) then
    begin
      Result := Account.Id;
      Exit;
    end;
  end;
end;

function CashbookName
  (CashbookId : int64) : string;
var
  Cashbook : TCashbook;
begin
  Cashbook := TCashbook(FormatObjectProperty
    (Cashbooks, CashbookId, Result));
  if Cashbook <> nil then
    Result := Cashbook.Name;
end;

function CashbookAbbreviation
  (CashbookId : int64) : string;
var
  Cashbook : TCashbook;
begin
  Cashbook := TCashbook(FormatObjectProperty
    (Cashbooks, CashbookId, Result));
  if Cashbook <> nil then
    Result := Cashbook.Abbreviation;
end;

function CashbookCombinedAbbreviation
  (CashbookId : int64) : string;
var
  Cashbook : TCashbook;
begin
  Cashbook := TCashbook(FormatObjectProperty
    (Cashbooks, CashbookId, Result));
  if Cashbook <> nil then
    Result := Cashbook.CombinedAbbreviation;
end;

function CashbookDescription
  (CashbookId : int64) : string;
var
  i : integer;
begin
  for i := 0 to Cashbooks.Count - 1 do
    if TCashbook(Cashbooks[i]).Id = CashbookId then
    begin
      Result := TCashbook(Cashbooks[i]).Description;
      Exit;
    end;
  // default to empty string if not found
  Result := '';
end;

function CashbookFromAccountId
  (AccountId : int64) : TCashbook;
var
  i : integer;
begin
  for i := 0 to Cashbooks.Count - 1 do
    if TCashbook(Cashbooks[i]).AccountId = AccountId then
    begin
      Result := TCashbook(Cashbooks[i]);
      Exit;
    end;
  // default to nil if not found
  Result := nil;
end;

function ItemName
  (ItemId : int64) : string;
var
  Item : TItem;
begin
  Item := TItem(FormatObjectProperty
    (Items, ItemId, Result));
  if Item <> nil then
    Result := Item.Name;
end;

function SalespersonName
  (SalespersonId : int64) : string;
var
  Salesperson : TSalesperson;
begin
  Salesperson := TSalesperson(FormatObjectProperty
    (Salespersons, SalespersonId, Result));
  if Salesperson <> nil then
    Result := Salesperson.Name;
end;

function PaymentTypeName
  (PaymentTypeId : int64) : string;
var
  PaymentType : TPaymentType;
begin
  PaymentType := TPaymentType(FormatObjectProperty
    (PaymentTypes, PaymentTypeId, Result));
  if PaymentType <> nil then
    Result := PaymentType.Name;
end;

function ItemIdFromLookupCode
  (Code : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to LookupCodes.Count - 1 do
  begin
    if TLookupCode(LookupCodes[i]).Code = Code then
    begin
      Result := TLookupCode(LookupCodes[i]).ItemId;
      Exit;
    end;
  end;
end;

function SalespersonIdFromName
  (Name : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Salespersons.Count - 1 do
  begin
    if TSalesperson(Salespersons[i]).Name = Name then
    begin
      Result := TSalesperson(Salespersons[i]).Id;
      Exit;
    end;
  end;
end;

function ItemIdFromName
  (Name : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to Items.Count - 1 do
  begin
    if TItem(Items[i]).Name = Name then
    begin
      Result := TItem(Items[i]).Id;
      Exit;
    end;
  end;
end;

function PaymentTypeIdFromName
  (Name : string) : int64;
var
  i : integer;
begin
  Result := 0;
  for i := 0 to PaymentTypes.Count - 1 do
  begin
    if TPaymentType(PaymentTypes[i]).Name = Name then
    begin
      Result := TPaymentType(PaymentTypes[i]).Id;
      Exit;
    end;
  end;
end;

function GetCombinedEntry
  (CombinedEntryId : int64) : TCombinedEntry;
begin
  if CombinedEntryId = 0 then
    Result := nil
  else begin
    Result := TCombinedEntry.Create;
    Result.Id := CombinedEntryId;
    if Result.Entries.Count = 0 then
    begin
      Result.Free;
      Result := nil;
    end
  end;
end;

procedure CreateDefaultAccounts;

  procedure CreateAccount
    (Abbreviation : string;
     Name : string;
     Description : string;
     AccountType : TAccountType);
  var
    Account : TAccount;
  begin
    Account := TAccount.Create;
    Account.Abbreviation := Abbreviation;
    Account.Name := Name;
    Account.Description := Description;
    Account.AccountType := AccountType;
    Account.SaveToDatabase(true);
    Account.Free;
  end;

begin
  // create a default chart of accounts if none exist
  CreateAccount('COH','Cash','Cash on hand',atAsset);
  CreateAccount('BNK','Bank','Money in bank account',atAsset);
  CreateAccount('ACR','Accounts Receivable','Money owed by customers',atAsset);
  CreateAccount('INV','Inventory','Items owned',atAsset);
  CreateAccount('LND','Land','Land owned',atAsset);
  CreateAccount('BDG','Buildings','Buildings owned',atAsset);
  CreateAccount('EQT','Equipment','Equipment owned',atAsset);
  CreateAccount('VHC','Vehicles','Vehicles owned',atAsset);

  CreateAccount('ACP','Accounts Payable','Money owed to suppliers',atLiability);
  CreateAccount('WGP','Wages Payable','Money owed to employees',atLiability);
  CreateAccount('TXP','Taxes Payable','Money owed to tax authorities',atLiability);

  CreateAccount('CMS','Common Stock','Basic equity class',atEquity);
  CreateAccount('PIC','Paid-in Capital','Additional contributions from owners',atEquity);

  CreateAccount('SLS','Sales','Income from sales',atIncome);
  CreateAccount('INI','Interest Income','Interest received from bank',atIncome);
  CreateAccount('RNI','Rent Income','Rent received from tenants',atIncome);

  CreateAccount('OSP','Office Supplies','General office expenses',atExpense);
  CreateAccount('MTR','Materials','Cost of materials used',atExpense);
  CreateAccount('INE','Interest Expense','Interest due to bank',atExpense);
  CreateAccount('RNT','Rent Expense','Rent due to landlord',atExpense);
  CreateAccount('ELC','Electricity','Cost of electricity used',atExpense);
  CreateAccount('COM','Communications','Cost of telephone, internet etc.',atExpense);
  CreateAccount('WGE','Wages Expense','Wages earned by employees',atExpense);
  CreateAccount('TXE','Tax Expense','Tax paid to tax authorities',atExpense);
  CreateAccount('DVD','Dividend','Dividends paid to owners',atExpense);
end;

procedure CreateDefaultCashbooks;
var
  AccountId : int64;

  procedure CreateCashbook
    (Abbreviation : string;
     Name : string;
     Description : string;
     AccountId : int64);
  var
    Cashbook : TCashbook;
  begin
    Cashbook := TCashbook.Create;
    Cashbook.Abbreviation := Abbreviation;
    Cashbook.Name := Name;
    Cashbook.Description := Description;
    Cashbook.AccountId := AccountId;
    Cashbook.SaveToDatabase(true);
    Cashbook.Free;
  end;

begin
  // create a default cashbook if none exists
  AccountId := Accounts.GetIdFromComboBoxDisplayString('BNK - Bank');
  if AccountId <> 0 then
    CreateCashbook('BNK','Bank Cashbook','Cashbook for bank account',AccountId);
end;

procedure CreateDefaultPaymentTypes;

  procedure CreatePaymentType
    (Name : string;
     KeyboardShortcut : char;
     OpenCashDrawer : boolean;
     EFT : boolean;
     PromptCashOut : boolean;
     PromptDetails : boolean);
  var
    PaymentType : TPaymentType;
  begin
    PaymentType := TPaymentType.Create;
    PaymentType.Name := Name;
    PaymentType.KeyboardShortcut := KeyboardShortcut;
    PaymentType.OpenCashDrawer := OpenCashDrawer;
    PaymentType.EFT := EFT;
    PaymentType.PromptCashOut := PromptCashOut;
    PaymentType.PromptDetails := PromptDetails;
    PaymentType.Active := true;
    PaymentType.SaveToDatabase(true);
    PaymentType.Free;
  end;

begin
  // create default payment types if none exist
  CreatePaymentType('Cash','1',true,false,false,false);
  CreatePaymentType('Cheque','2',false,false,false,true);
  CreatePaymentType('VISA','3',false,true,false,true);
  CreatePaymentType('Mastercard','4',false,true,false,true);
  CreatePaymentType('EFT','5',false,true,true,true);
end;

function LockDatabaseObject
  (DatabaseObject : TDatabaseObject) : boolean;
var
  OtherUserName : string;
begin
  // only try to lock when in client mode and it is an existing object
  if (DatabaseObject <> nil) and (DatabaseObject.Id <> 0)
    and ClientMode then
  begin
    Result := ClientCommunicator.LockDatabaseObject(DatabaseObject.Id,OtherUserName);
    if not Result then
      ShowMessage('Database record is locked by ' + OtherUserName);
    Exit;
  end;
  // always allow lock to return true
  Result := true;
end;

procedure UnlockDatabaseObject
  (DatabaseObject : TDatabaseObject);
begin
  // only unlock when in client mode and it is an existing object
  if (DatabaseObject <> nil) and (DatabaseObject.Id <> 0)
    and ClientMode then
    ClientCommunicator.UnlockDatabaseObject(DatabaseObject.Id);
end;

procedure ShowCombinedEntry
  (CombinedEntryId : int64;
   CompanyId : int64);
begin
  // switch default accounting company to the company for this client account
  if WorkstationConfiguration.CompanyId <> CompanyId then
  begin
    WorkstationConfiguration.CompanyId := CompanyId;
    SaveWorkstationConfiguration;
    MainForm.EntriesFrame.UpdateComboBoxes(false);
    MainForm.AccountsFrame.UpdateComboBoxes(false);
    MainForm.CashbooksFrame.UpdateComboBoxes(false);
    MainForm.EntriesFrame.ClearDisplay;
    MainForm.AccountsFrame.ClearDisplay;
    MainForm.CashbooksFrame.ClearDisplay;
    MainForm.BalanceSheetFrame.UpdateDisplay;
    MainForm.IncomeStatementFrame.UpdateDisplay;
    MainForm.GraphFrame.UpdateDisplay;
  end;
  MainForm.SwitchToFrame('Entries');
  MainForm.EntriesFrame.ShowCombinedEntry(CombinedEntryId);
end;

procedure FindUnbalancedEntry;
var
  i : integer;
  j : integer;
  Account : TAccount;
  Entry : TEntry;
begin
  Screen.Cursor := crHourGlass;
  if ClientCommunicator <> nil then
    ClientCommunicator.SetServerThreadPriority(tpLowest);
  try
    for i := 0 to Globals.Accounts.Count - 1 do
    begin
      Account := TAccount(AccountsCache.GetAccount(Globals.Accounts[i].Id));
      for j := 0 to Account.Entries.Count - 1 do
      begin
         Entry := TEntry(Account.Entries[j]);
         if not Entry.CombinedEntry.Balanced then
         begin
           ShowCombinedEntry(Entry.CombinedEntryId,Account.CompanyId);
           Exit;
         end;
         if Entry.CombinedEntry.SplitCompany then
         begin
           ShowCombinedEntry(Entry.CombinedEntryId,Account.CompanyId);
           Exit;
         end;
      end;
    end;
    ShowMessage('No unbalanced entry found');
  finally
    if ClientCommunicator <> nil then
      ClientCommunicator.SetServerThreadPriority(tpNormal);
    Screen.Cursor := crDefault;
  end;
end;

function Unregistered : boolean;
begin
  Result := (GlobalConfiguration <> nil) and
    (GlobalConfiguration.CompanyName = DefaultCompanyName);
end;

function FindItem : TItem;
var
  DatabaseObject : TDatabaseObject;
  SelectionString : string;
  SearchString : string;
begin
  Result := nil;
  if PromptStringForm.Prompt(false,'Enter Search String, Lookup Code or Barcode','Item Search String, Lookup Code or Barcode') then
    SearchString := PromptStringForm.Value
  else
    Exit;
  // first attempt lookup
  if SearchString <> '' then
    DatabaseObject := Globals.Items.ObjectsById[ItemIdFromLookupCode(SearchString)]
  else
    DatabaseObject := nil;
  if DatabaseObject <> nil then
  begin
    Result := TItem.Create;
    Result.Assign(DatabaseObject);
    Exit;
  end;
  // convert search string to upper case
  SearchString := UpperCase(SearchString);
  // if empty search string then search on entire table
  if SearchString = '' then
    SelectionString := ''
  // otherwise build a selection string for query
  else
    SelectionString := 'UPPER(' + DelimitSQLFieldName('Name') + ') LIKE ' + DelimitSQLStringValue('%' + SearchString + '%');
  if SelectionString <> '' then
    SelectionString := 'WHERE ' + SelectionString;
  DatabaseObject := Find(TItem,SelectionString);
  Result := TItem(DatabaseObject);
end;

function FindDocument : TDocument;
var
  DatabaseObject : TDatabaseObject;
  SelectionString : string;
  SearchString : string;
begin
  Result := nil;
  if PromptStringForm.Prompt(false,'Enter Search String','Document Search String') then
    SearchString := PromptStringForm.Value
  else
    Exit;
  // convert search string to upper case
  SearchString := UpperCase(SearchString);
  // if empty search string then search on entire table
  if SearchString = '' then
    SelectionString := ''
  // otherwise build a selection string for query
  else
    SelectionString := 'UPPER(' + DelimitSQLFieldName('Name') + ') LIKE ' + DelimitSQLStringValue('%' + SearchString + '%');
  if SelectionString <> '' then
    SelectionString := 'WHERE ' + SelectionString;
  DatabaseObject := Find(TDocument,SelectionString);
  Result := TDocument(DatabaseObject);
end;

procedure PurgeDatabase
  (PurgeDate : TDateTime);
var
  i,j : integer;
  Company : TCompany;
  Account : TAccount;
  CombinedEntry : TCombinedEntry;
  Entry : TEntry;
begin
  Company := nil;
  ProgressForm.SetStep(1);
  ProgressForm.SetCaption('Purging database.  Please wait...');
  ProgressForm.Show;
  AcquireDatabaseCriticalUpdate;
  try
    // work through each company in turn (including default)
    for i := 0 to Globals.Companies.Count do
    begin
      if i < Globals.Companies.Count then
        Company := TCompany(Globals.Companies[i])
      else
        Company := TCompany.Create;
      // create a combined entry to record the new opening balances
      // for the company
      CombinedEntry := TCombinedEntry.Create;
      CombinedEntry.Date := PurgeDate;
      // work through each account in turn
      for j := 0 to Globals.Accounts.Count - 1 do
      begin
        Account := AccountsCache.GetAccount(Globals.Accounts[j].Id);
        if Account.CompanyId = Company.Id then
        begin
          if Account.BalanceAsAt(PurgeDate) <> 0 then
          begin
            Entry := TEntry.Create;
            CombinedEntry.Entries.Add(Entry);
            Entry.AccountId := Account.Id;
            Entry.Description := 'Opening Balance';
            Entry.Amount := Account.BalanceAsAt(PurgeDate);
          end;
        end;
        ProgressForm.SetPosition(j * 100 div Globals.Accounts.Count);
      end;
      // check that the new opening entries balance
      if not CombinedEntry.Balanced then
        ShowMessage(Company.Name + ' has unbalanced accounts. Unable to purge')
      else begin
        // purge the accounts
        for j := 0 to Globals.Accounts.Count - 1 do
        begin
          Account := TAccount(Globals.Accounts[j]);
          if Account.CompanyId = Company.Id then
            Account.Purge(PurgeDate);
        end;
        // save the new opening entries
        CombinedEntry.UpdateDatabase(false);
      end;
      // free memory
      CombinedEntry.Free;
    end;
    // clear accounts cache
    AccountsCache.Clear;
    // update display
    MainForm.EntriesFrame.ClearDisplay;
    MainForm.AccountsFrame.ClearDisplay;
  finally
    Company.Free;
    ReleaseDatabaseCriticalUpdate;
    ProgressForm.Hide;
  end;
end;

end.