lazarus-ccr/components/flashfiler/sourcelaz/ffsrcfg.pas

{*********************************************************}
{* FlashFiler: Server Configuration Information          *}
{*********************************************************}

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower FlashFiler
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$I ffdefine.inc}

unit ffsrcfg;

interface

uses
  Windows,
  SysUtils,
  Classes,
  ffconst,
  ffllbase,
  ffllunc,
  ffsrmgr,
  ffllexcp,
  ffllprot,
  ffsrintf,
  ffsrbase;

type
  PffGeneralInfo = ^TffGeneralInfo;
  TffGeneralInfo = packed record
{Begin !!.06}
{$IFDEF IsDelphi}
    giServerName      : TffNetName;
{$ELSE}
    giServerName      : TffNetNameShr;
{$ENDIF}
{End !!.06}
    giMaxRAM          : Longint;
    giSingleUser      : Boolean;
    giIPXSPX          : Boolean;
    giIPXSPXLFB       : Boolean;
    giTCPIP           : Boolean;
    giTCPIPLFB        : Boolean;
    giTCPPort         : Longint;
    giUDPPortSr       : Longint;
    giUDPPortCl       : Longint;
    giIPXSocketSr     : Longint;
    giIPXSocketCl     : Longint;
    giSPXSocket       : Longint;
    giIsSecure        : Boolean;
    giAutoUp          : Boolean;
    giAutoMini        : Boolean;
    giDebugLog        : Boolean;
    giAllowEncrypt    : Boolean;
    giReadOnly        : Boolean;
    giLastMsgInterval : Longint;
    giKAInterval      : Longint;
    giKARetries       : Longint;
    giPriority        : Longint;
    giTCPInterface    : Longint;
    giNoAutoSaveCfg   : Boolean;
    giTempStoreSize   : Integer;
    giCollectEnabled  : Boolean;
    giCollectFreq     : Longint;
  end;

type
  TffAliasItem = class(TffUCStrListItem)
    protected {private}
      FCheckDisk : Boolean;                                            {!!.11}
      FPath      : PffShStr;
    protected
      function GetAlias : string;                                      {!!.10}
      function GetPath : string;                                       {!!.10}
    public
      constructor Create(const aAlias     : TffName;
                         const aPath      : TffPath;
                               aCheckDisk : Boolean);                  {!!.11}
      destructor Destroy; override;

      property Alias : string read GetAlias;                           {!!.10}
      property Path : string read GetPath;                             {!!.10}
      property CheckSpace : Boolean                                    {!!.11}
        read FCheckDisk;                                               {!!.11}
  end;

  TffAliasList = class(TffThreadList)
    protected
      function GetAliasItem(aInx : Integer) : TffAliasItem;
      function GetAliasPath(const aAlias : TffName) : TffPath;
    public
      procedure AddAlias(aAliasItem : TffAliasItem);
      function AliasExists(const aAlias : TffName) : Boolean;
      function AliasIndex(const aAlias : TffName) : Integer;
      function CheckDiskSpace(const aAlias : TffName) : Boolean;       {!!.11}
      procedure DeleteAlias(const aAlias : TffName);

      property AliasItem[aInx : Integer] : TffAliasItem
        read GetAliasItem; default;
      property Path[const aAlias : TffName] : TffPath
        read GetAliasPath;
  end;

  TffUserItem = class(TffUCStrListItem)
    protected {private}
      FFirst   : PffShStr;
      FLast    : PffShStr;
      FPwdHash : TffWord32;
      FRights  : TffUserRights;
    protected
      function GetFirstName : string;                                  {!!.10}
      function GetLastName : string;                                   {!!.10}
      function GetUserID : string;                                     {!!.10}
    public
      constructor Create(const aUserID    : TffName;
                         const aLastName  : TffName;
                         const aFirstName : TffName;
                               aPwdHash   : TffWord32;
                               aRights    : TffUserRights);
      destructor Destroy; override;

      property FirstName : string read GetFirstName;                   {!!.10}
      property LastName : string read GetLastName;                     {!!.10}
      property PasswordHash : TffWord32 read FPwdHash;
      property Rights : TffUserRights read FRights;
      property UserID : string read GetUserID;                         {!!.10}
  end;

  TffUserList = class(TffObject)
    protected {private}
      FUserList : TffList;
    protected
      function GetUserItem(aInx : integer) : TffUserItem;
      function GetUserPwdHash(const aUserID : TffName) : TffWord32;
      function GetUserRights(const aUserID : TffName) : TffUserRights;
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddUser(aUserItem : TffUserItem);
      function UserExists(const aUserID : TffName) : Boolean;
      function UserIndex(const aUserID : TffName) : Integer;
      function Count : integer;
      procedure DeleteUser(const aUserID : TffName);
      procedure Empty;

      property UserItem[aInx : integer] : TffUserItem read GetUserItem; default;
      property PasswordHash[const aUserID : TffName] : TffWord32 read GetUserPwdHash;
      property UserRights[const aUserID : TffName] : TffUserRights read GetUserRights;
  end;

  TffKeyProcItem = class(TffUCStrListItem)
    protected {private}
      FIndexID     : Integer;
      FDLLName     : PffShStr;
      FBuildKey    : TffKeyBuildFunc;
      FBuildName   : PffShStr;
      FCompareKey  : TffKeyCompareFunc;
      FCompareName : PffShStr;
      FPath        : PffShStr;
      FTable       : PffShStr;

      kpiLibHandle    : THandle;
    protected
      function GetBuildKeyName : string;                               {!!.10}
      function GetCompareKeyName : string;                             {!!.10}
      function GetDLLName : string;                                    {!!.10}
      function GetPath : string;                                       {!!.10}
      function GetTable : string;                                      {!!.10}
      function GetTableDataFileName : string;                          {!!.10}
    public
      constructor Create(const aPath        : TffPath;
                         const aTable       : TffTableName;
                               aIndexID     : Integer;
                         const aDLLName     : TffFullFileName;
                         const aBuildName   : TffName;
                         const aCompareName : TffName);
      destructor Destroy; override;
      function Link : boolean;
      procedure Unlink;

      property DLLName : string
        read GetDLLName;                                               {!!.10}
      property IndexID : Integer
        read FIndexID;
      property BuildKey : TffKeyBuildFunc
        read FBuildKey;
      property BuildKeyName : string
        read GetBuildKeyName;                                          {!!.10}
      property CompareKey : TffKeyCompareFunc
        read FCompareKey;
      property CompareKeyName : string
        read GetCompareKeyName;                                        {!!.10}
      property Path : string
        read GetPath;                                                  {!!.10}
      property Table : string
        read GetTable;                                                 {!!.10}
      property TableDataFileName : string
        read GetTableDataFileName;                                     {!!.10}
  end;

  TffKeyProcList = class(TffObject)
    protected {private}
      FKPList : TffList;
    protected
      function GetKPItem(aInx : integer) : TffKeyProcItem;
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddKeyProc(aKeyProcItem : TffKeyProcItem);
      function KeyProcExists(const aPath    : TffPath;
                             const aTable   : TffTableName;
                                   aIndexID : Integer)
                                            : Boolean;
      function KeyProcIndex(const aPath    : TffPath;
                            const aTable   : TffTableName;
                                  aIndexID : Integer)
                                           : Integer;
      function Count : integer;
      procedure DeleteKeyProc(const aPath    : TffPath;
                              const aTable   : TffTableName;
                                    aIndexID : Integer);
      procedure Empty;

      property KeyProcItem[aInx : Integer] : TffKeyProcItem
        read GetKPItem; default;
  end;

  TffServerConfiguration = class(TffObject)
    protected {private}
      FAliasList   : TffAliasList;
      FGeneralInfo : TffGeneralInfo;
      FKeyProcList : TffKeyProcList;
      FUserList    : TffUserList;
      scPadLock    : TffPadLock;
    protected
      function GetGeneralInfo : PffGeneralInfo;
      function GetServerName : string;                                 {!!.10}
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddAlias(const aAlias     : TffName;
                         const aPath      : TffPath;
                               aCheckDisk : Boolean);                  {!!.11}
      procedure AddKeyProc(const aPath        : TffPath;
                           const aTable       : TffTableName;
                                 aIndexID     : Integer;
                           const aDLLName     : TffFullFileName;
                           const aBuildName   : TffName;
                           const aCompareName : TffName);
      procedure AddUser(const aUserID    : TffName;
                        const aLastName  : TffName;
                        const aFirstName : TffName;
                              aPwdHash   : TffWord32;
                              aRights    : TffUserRights);
      procedure Lock;
      procedure PerformDynamicLink;
      procedure Unlock;

      property AliasList : TffAliasList
        read FAliasList;
      property GeneralInfo : PffGeneralInfo
        read GetGeneralInfo;
      property KeyProcList : TffKeyProcList
        read FKeyProcList;
      property ServerName : string
        read GetServerName;                                            {!!.10}
      property UserList : TffUserList
        read FUserList;
  end;

{---Internal helper routines---}
function srcfgCalcKPKey(const aTable : TffFullFileName;
                              aIndex : Integer) : TffShStr;
function srcfgAliasFromKPKey(const BKK : TffShStr) : TffName;
function srcfgTableFromKPKey(const BKK : TffShStr) : TffTableName;
function srcfgIndexFromKPKey(const BKK : TffShStr) : Integer;

implementation

{== Helper routines ==================================================}
function srcfgCalcKPKey(const aTable : TffFullFileName;
                              aIndex : Integer)
                                     : TffShStr;
var
  S : string[9];
begin
  Str(aIndex, S);
  Result := aTable;
  FFShStrAddChar(Result, '|');
  FFShStrConcat(Result, S);
end;
{--------}
function srcfgAliasFromKPKey(const BKK : TffShStr) : TffName;
var
  PosSlash : integer;
begin
  PosSlash := Pos('/', BKK);
  if (PosSlash > 0) then
    Result := Copy(BKK, 1, pred(PosSlash))
  else
    Result := '';
end;
{--------}
function srcfgTableFromKPKey(const BKK : TffShStr) : TffTableName;
var
  PosColon : Integer;
  PosSlash : Integer;
begin
  PosSlash := Pos('/', BKK);
  PosColon := Pos(':', BKK);
  if (PosSlash > 0) and (PosColon > 0) then
    Result := Copy(BKK, succ(PosSlash), pred(PosColon - PosSlash))
  else
    Result := '';
end;
{--------}
function srcfgIndexFromKPKey(const BKK : TffShStr) : Integer;
var
  PosColon : Integer;
  ec       : Integer;
  InxAsStr : string[9];
begin
  PosColon := Pos(':', BKK);
  if (PosColon > 0) then begin
    InxAsStr := Copy(BKK, succ(PosColon), 255);
    Val(InxAsStr, Result, ec);
    if (ec <> 0) then
      Result := 0;
  end
  else
    Result := 0;
end;
{=====================================================================}

{== TffAliasItem =====================================================}
constructor TffAliasItem.Create(const aAlias     : TffName;
                                const aPath      : TffPath;
                                      aCheckDisk : Boolean);           {!!.11}
begin
  inherited Create(aAlias);
  FPath := FFShStrAlloc(FFExpandUNCFileName(aPath));
  FCheckDisk := aCheckDisk;                                            {!!.11}
end;
{--------}
destructor TffAliasItem.Destroy;
begin
  FFShStrFree(FPath);
  inherited Destroy;
end;
{--------}
function TffAliasItem.GetAlias : string;                               {!!.10}
begin
  Result := KeyAsStr;
end;
{--------}
function TffAliasItem.GetPath : string;                                {!!.10}
begin
  Result := FPath^;
end;
{====================================================================}


{===TffAliasList=====================================================}
procedure TffAliasList.AddAlias(aAliasItem : TffAliasItem);
begin
  Insert(aAliasItem);
end;
{--------}
function TffAliasList.AliasExists(const aAlias : TffName) : Boolean;
begin
  Result := Exists(aAlias);
end;
{--------}
function TffAliasList.AliasIndex(const aAlias : TffName) : Integer;
begin
  Result := Index(aAlias);
end;
{--------}
{!!.11 - New}
function TffAliasList.CheckDiskSpace(const aAlias : TffName)
                                                  : Boolean;
var
  Position : Integer;
begin
  Result := False;
  Position := Index(aAlias);
  if (Position > -1) then
    Result := AliasItem[Position].CheckSpace;
end;
{--------}
procedure TffAliasList.DeleteAlias(const aAlias : TffName);
begin
  Delete(aAlias);
end;
{--------}
function TffAliasList.GetAliasItem(aInx : Integer) : TffAliasItem;
begin
  Result := TffAliasItem(fflList[aInx]);
end;
{--------}
function TffAliasList.GetAliasPath(const aAlias : TffName) : TffPath;
var
  Inx : Integer;
begin
  Inx := Index(aAlias);
  if (Inx = -1) then
    Result := ''
  else
    Result := TffAliasItem(fflList[Inx]).Path;
end;
{====================================================================}


{===TffUserItem======================================================}
constructor TffUserItem.Create(const aUserID    : TffName;
                               const aLastName  : TffName;
                               const aFirstName : TffName;
                                     aPwdHash   : TffWord32;
                                     aRights    : TffUserRights);
begin
  inherited Create(aUserID);
  FFirst := FFShStrAlloc(aFirstName);
  FLast := FFShStrAlloc(aLastName);
  FPwdHash := aPwdHash;
  FRights := aRights;
end;
{--------}
destructor TffUserItem.Destroy;
begin
  FFShStrFree(FFirst);
  FFShStrFree(FLast);
  inherited Destroy;
end;
{--------}
function TffUserItem.GetFirstName : string;                            {!!.10}
begin
  Result := FFirst^;
end;
{--------}
function TffUserItem.GetLastName : string;                             {!!.10}
begin
  Result := FLast^;
end;
{--------}
function TffUserItem.GetUserID : string;                               {!!.10}
begin
  Result := KeyAsStr;
end;
{====================================================================}


{===TffUserList======================================================}
constructor TffUserList.Create;
begin
  inherited Create;
  FUserList := TffList.Create;
end;
{--------}
destructor TffUserList.Destroy;
begin
  FUserList.Free;
  inherited Destroy;
end;
{--------}
procedure TffUserList.AddUser(aUserItem : TffUserItem);
begin
  FUserList.Insert(aUserItem);
end;
{--------}
function TffUserList.UserExists(const aUserID : TffName) : Boolean;
begin
  Result := FUserList.Exists(aUserID);
end;
{--------}
function TffUserList.UserIndex(const aUserID : TffName) : Integer;
begin
  Result := FUserList.Index(aUserID);
end;
{--------}
function TffUserList.Count : Integer;
begin
  Result := FUserList.Count;
end;
{--------}
procedure TffUserList.DeleteUser(const aUserID : TffName);
begin
  FUserList.Delete(aUserID);
end;
{--------}
procedure TffUserList.Empty;
begin
  FUserList.Empty;
end;
{--------}
function TffUserList.GetUserItem(aInx : Integer) : TffUserItem;
begin
  Result := TffUserItem(FUserList[aInx]);
end;
{--------}
function TffUserList.GetUserPwdHash(const aUserID : TffName) : TffWord32;
var
  Inx : integer;
begin
  if (aUserID = '') then
    Result := 0
  else begin
    Inx := FUserList.Index(aUserID);
    if (Inx = -1) then
      Result := $FFFFFFFF
    else
      Result := TffUserItem(FUserList[Inx]).PasswordHash;
  end;
end;
{--------}
function TffUserList.GetUserRights(const aUserID : TffName) : TffUserRights;
var
  Inx : integer;
begin
  Inx := FUserList.Index(aUserID);
  if (Inx = -1) then
    Result := []
  else
    Result := TffUserItem(FUserList[Inx]).Rights;
end;
{====================================================================}



{===TffKeyProcItem===================================================}
constructor TffKeyProcItem.Create(const aPath        : TffPath;
                                  const aTable       : TffTableName;
                                        aIndexID     : integer;
                                  const aDLLName     : TffFullFileName;
                                  const aBuildName   : TffName;
                                  const aCompareName : TffName);
var
  FFN     : TffFullFileName;
  UNCPath : TffPath;
begin
  UNCPath := FFExpandUNCFileName(aPath);
  FFN := FFMakeFullFileName(UNCPath, FFMakeFileNameExt(aTable, ffc_ExtForData));
  inherited Create(srcfgCalcKPKey(FFN, aIndexID));
  FIndexID := aIndexID;
  FPath := FFShStrAlloc(UNCPath);
  FTable := FFShStrAlloc(aTable);
  FDLLName := FFShStrAlloc(aDLLName);
  FBuildName := FFShStrAlloc(aBuildName);
  FCompareName := FFShStrAlloc(aCompareName);
end;
{--------}
destructor TffKeyProcItem.Destroy;
begin
  Unlink;
  FFShStrFree(FCompareName);
  FFShStrFree(FBuildName);
  FFShStrFree(FDLLName);
  FFShStrFree(FTable);
  FFShStrFree(FPath);
  inherited Destroy;
end;
{--------}
function TffKeyProcItem.GetDLLName : string;                           {!!.10}
begin
  Result := FDLLName^;
end;
{--------}
function TffKeyProcItem.GetBuildKeyName : string;                      {!!.10}         
begin
  Result := FBuildName^;
end;
{--------}
function TffKeyProcItem.GetCompareKeyName : string;                    {!!.10}
begin
  Result := FCompareName^;
end;
{--------}
function TffKeyProcItem.GetPath : string;                              {!!.10}
begin
  Result := FPath^;
end;
{--------}
function TffKeyProcItem.GetTable : string;                             {!!.10}       
begin
  Result := FTable^;
end;
{--------}
function TffKeyProcItem.GetTableDataFileName : string;                 {!!.10}
begin
  Result := FFMakeFullFileName(Path, FFMakeFileNameExt(Table, ffc_ExtForData));
end;
{--------}
function TffKeyProcItem.Link : Boolean;
var
  DLLPathZ  : TffStringZ;
  ProcNameZ : TffStringZ;
begin
  Result := false;
  Unlink;
  kpiLibHandle := LoadLibrary(FFStrPCopy(DLLPathZ, DLLName));
  if (kpiLibHandle <> 0) then begin
    @FBuildKey := GetProcAddress(kpiLibHandle, FFStrPCopy(ProcNameZ, BuildKeyName));
    if Assigned(FBuildKey) then begin
      @FCompareKey := GetProcAddress(kpiLibHandle, FFStrPCopy(ProcNameZ, CompareKeyName));
      if Assigned(FCompareKey) then
        Result := true
      else
        Unlink;
    end
    else
      Unlink;
  end;
end;
{--------}
procedure TffKeyProcItem.Unlink;
begin
  if (kpiLibHandle <> 0) then
    FreeLibrary(kpiLibHandle);
  kpiLibHandle := 0;
  FBuildKey := nil;
  FCompareKey := nil;
end;
{====================================================================}


{===TffKeyProcList===================================================}
constructor TffKeyProcList.Create;
begin
  inherited Create;
  FKPList := TffList.Create;
end;
{--------}
destructor TffKeyProcList.Destroy;
begin
  FKPList.Free;
  inherited Destroy;
end;
{--------}
procedure TffKeyProcList.AddKeyProc(aKeyProcItem : TffKeyProcItem);
begin
  FKPList.Insert(aKeyProcItem);
end;
{--------}
function TffKeyProcList.Count : Integer;
begin
  Result := FKPList.Count;
end;
{--------}
procedure TffKeyProcList.DeleteKeyProc(const aPath    : TffPath;
                                       const aTable   : TffTableName;
                                             aIndexID : integer);
var
  FFN   : TffFullFileName;
  KPKey : TffShStr;
begin
  FFN := FFMakeFullFileName(
            FFExpandUNCFileName(aPath),
            FFMakeFileNameExt(aTable, ffc_ExtForData));
  KPKey := srcfgCalcKPKey(FFN, aIndexID);
  FKPList.Delete(KPKey);
end;
{--------}
procedure TffKeyProcList.Empty;
begin
  FKPList.Empty;
end;
{--------}
function TffKeyProcList.GetKPItem(aInx : Integer) : TffKeyProcItem;
begin
  Result := TffKeyProcItem(FKPList[aInx]);
end;
{--------}
function TffKeyProcList.KeyProcExists(const aPath    : TffPath;
                                      const aTable   : TffTableName;
                                            aIndexID : Integer) : Boolean;
var
  FFN   : TffFullFileName;
  KPKey : TffShStr;
begin
  FFN := FFMakeFullFileName(
            FFExpandUNCFileName(aPath),
            FFMakeFileNameExt(aTable, ffc_ExtForData));
  KPKey := srcfgCalcKPKey(FFN, aIndexID);
  Result := (FKPList.Index(KPKey) <> -1);
end;
{--------}
function TffKeyProcList.KeyProcIndex(const aPath    : TffPath;
                                     const aTable   : TffTableName;
                                           aIndexID : Integer) : Integer;
var
  FFN   : TffFullFileName;
  KPKey : TffShStr;
begin
  FFN := FFMakeFullFileName(
            FFExpandUNCFileName(aPath),
            FFMakeFileNameExt(aTable, ffc_ExtForData));
  KPKey := srcfgCalcKPKey(FFN, aIndexID);
  Result := FKPList.Index(KPKey);
end;
{=====================================================================}


{== TffServerConfiguration ===========================================}
constructor TffServerConfiguration.Create;
begin
  inherited Create;                                                    {!!.01}

  {set up the default general info}
  with FGeneralInfo do begin
    giServerName := '';
    giMaxRAM := 10;
    giSingleUser := True;
    giIPXSPX := False;
    giIPXSPXLFB := True;
    giTCPIP := False;
    giTCPIPLFB := True;
    giIsSecure := False;
    giAutoUp := False;
    giAutoMini := False;
    giDebugLog := False;
    {$IFDEF SecureServer}
    giAllowEncrypt := True;
    {$ELSE}
    giAllowEncrypt := False;
    {$ENDIF}
    giReadOnly := False;
    giNoAutoSaveCfg := False;
    giLastMsgInterval := ffc_LastMsgInterval;
    giKAInterval := ffc_KeepAliveInterval;
    giKARetries := ffc_KeepAliveRetries;
    giPriority := 2; {THREAD_PRIORITY_HIGHEST}                      
    giTCPPort := FFGetTCPPort;
    giUDPPortSr := FFGetUDPPortServer;
    giUDPPortCl := FFGetUDPPortClient;
    giIPXSocketSr := FFGetIPXSocketServer;
    giIPXSocketCl := FFGetIPXSocketClient;
    giSPXSocket := FFGetSPXSocket;
    giTempStoreSize := ffcl_TempStorageSize;
    giCollectEnabled := False;
    giCollectFreq := ffcl_CollectionFrequency;
  end;

  {create internal items}
  scPadLock := TffPadLock.Create;
  FAliasList := TffAliasList.Create;
  FKeyProcList := TffKeyProcList.Create;
  FUserList := TffUserList.Create;
end;
{--------}
destructor TffServerConfiguration.Destroy;
begin
  FUserList.Free;
  FKeyProcList.Free;
  FAliasList.Free;
  scPadLock.Free;
  inherited Destroy;                                                   {!!.01}
end;
{--------}
procedure TffServerConfiguration.AddAlias(const aAlias     : TffName;
                                          const aPath      : TffPath;
                                                aCheckDisk : Boolean); {!!.11}
var
  NewAlias : TffAliasItem;
begin
  { Assumption: Thread-safeness enforced at a higher level. }
  NewAlias := TffAliasItem.Create(aAlias, aPath, aCheckDisk);          {!!.11}
  try
    FAliasList.AddAlias(NewAlias)
  except
    NewAlias.Free;
    raise;
  end;{try..except}
end;
{--------}
procedure TffServerConfiguration.AddKeyProc(const aPath        : TffPath;
                                            const aTable       : TffTableName;
                                                  aIndexID     : Integer;
                                            const aDLLName     : TffFullFileName;
                                            const aBuildName   : TffName;
                                            const aCompareName : TffName);
var
  NewKeyProc : TffKeyProcItem;
begin
  { Assumption: Thread-safeness enforced at a higher level. }
  NewKeyProc := TffKeyProcItem.Create(aPath, aTable, aIndexID,
                                      aDLLName, aBuildName, aCompareName);
  try
    FKeyProcList.AddKeyProc(NewKeyProc)
  except
    NewKeyProc.Free;
    raise;
  end;{try..except}
end;
{--------}
procedure TffServerConfiguration.AddUser(const aUserID    : TffName;
                                         const aLastName  : TffName;
                                         const aFirstName : TffName;
                                               aPwdHash   : TffWord32;
                                               aRights    : TffUserRights);
var
  NewUser : TffUserItem;
begin
  { Assumption: Thread-safeness enforced at a higher level. }
  NewUser := TffUserItem.Create(aUserID, aLastName, aFirstName, aPwdHash, aRights);
  try
    FUserList.AddUser(NewUser)
  except
    NewUser.Free;
    raise;
  end;{try..except}
end;
{--------}
function TffServerConfiguration.GetGeneralInfo : PffGeneralInfo;
begin
  Result := @FGeneralInfo;
end;
{--------}
function TffServerConfiguration.GetServerName : string;                {!!.10}   
begin
  Result := FGeneralInfo.giServerName;
end;
{--------}
procedure TffServerConfiguration.Lock;
begin
  scPadLock.Lock;
end;
{--------}
procedure TffServerConfiguration.PerformDynamicLink;
var
  i      : integer;
  lTable : TffFullFileName;
  lDLL   : TffFullFileName;
  lBKName: TffName;
  lCKName: TffName;
begin
  Lock;
  try
    for i := 0 to pred(KeyProcList.Count) do begin
      with KeyProcList[i] do begin
        if not Link then begin
          lTable := TableDataFileName;
          lDLL := DLLName;
          lBKName := BuildKeyName;
          lCKName := CompareKeyName;
          FFRaiseException(EffServerException, ffStrResServer, fferrDynamicLink,
                           [lTable, IndexID, lDLL, lBKName, lCKName])
        end;
      end;
    end;
  finally
    Unlock;
  end;{try..finally}
end;
{--------}
procedure TffServerConfiguration.UnLock;
begin
  scPadLock.Unlock;
end;
{====================================================================}
end.