unit U_ProtectionBase;

interface

Uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms, StdCtrls, Registry, Winsock, ExtCtrls,
  DB, U_ProtectionCommon;


const
  HP_ALGID          = $0001; // Hash algorithm
  HP_HASHVAL        = $0002; // Hash value
  HP_HASHSIZE       = $0004; // Hash value size
  HP_HMAC_INFO      = $0005; // information for creating an HMAC

  MAX_ADAPTER_ADDRESS_LENGTH = 6;

  {
  // RegKeyParamNames
  pnShowLicenceType = 'ShowLicenceType';
  pnLicenseTypeNB = 'LicenseTypeNB';
  pnServerNameNB = 'ServerNameNB';
  pnLocalPathToNB = 'LocalPathToNB';
  pnUserLog = 'ul';
  pnUserPass = 'up';
  pnPathToNB = 'PathToNB';

  pnNBUser = 'NBU';
  pnNBPass = 'NBP';
  pnPMUser = 'PMU';
  pnPMPass = 'PMP';}

type
  TMacAddress = array[0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of byte;

  TCheckConnectRes = (ccrSuccess, ccrBaseNoConnected,
                      ccrIsRemotePathInLocal, ccrIsLocalPathInMultiUser,
                      ccrNoAnswerCodeInProg, ccrNoMACAddrInProg,
                      ccrNoAnswerCodeInBase, ccrNoMACAddrInBase, ccrNoMaxConnectionCountInBase, ccrNoPathCheckSumInBase,
                      ccrNoProperAnswerCode, ccrNoProperMACAddr, ccrNoProperConnectionCount, ccrNoProperPathCheckSum);

  TCheckConnectResult = set of TCheckConnectRes;
  TLicenceType = (ltNone, ltLocal, ltMultiUser);
  TProtectionBaseParams = record
    LicenceType: TLicenceType;
    NoAsk: Boolean;
    ServerName: string[255];
    LocalPathToNB: string[255];
    PathToNB: string[255];
    IsOk: Boolean;
  end;

  TProtectionBaseKeyParams = record
    AnswerCode: string[200];
    MACAddrServer: string[200];
    ConnectionCount: string[200];
    PathCheckSum: string[200];
  end;

  function GetHash(AStr: string): string;
  function BuildHash(SourceStr: string): string;
  function XorStr(AStr: String; AMask: Byte=$FF; ADynamicMask: Boolean=false): String;

  //----------------------
  // Определяет служебные поля (ответный код, МАК адрес, количество подключений) в базе
  procedure DefineUseFieldsInBase(AFMain: TForm);
  // Криптографические функции
  function CryptStr(AStr: String; AParam: Integer): String;
  function DecryptStr(AStr: String; AParam: Integer): String;
  // Получение параметров из базы/программы
  function GetAnswerCodeFromBase: String;
  function GetAnswerCodeFromProgram: String;
  function GetCurrConnectionCount: Integer;
  function GetMACAddrFromBase: String;
  function GetMACAddrFromIP(ARemoteIP: String): String;
  function GetMaxConnectionCountFromBase: Integer;
  function GetMaxConnectionCountFromBaseAsStr: String;
  function GetPathCheckSumFromBase: Integer;
  function GetPathCheckSumFromBaseAsStr: String;
  function GetProgKeyParams(APathToNB: string; AConnectCount: Integer): TProtectionBaseKeyParams;
  // Установка параметров в базу
  procedure SetAnswerCodeToBase(AAnswerCode: String);
  procedure SetMACAddrToBase(AMACAddr: String);
  procedure SetMaxConnectionCountToBase(AMaxConnectionCount: Integer);
  procedure SetMaxConnectionCountToBaseAsStr(AMaxConnectionCount: String);
  procedure SetPathCheckSumFromBase(APathCheckSum: Integer);
  procedure SetPathCheckSumFromBaseAsStr(APathCheckSum: String);

  //---------------
  // Определяет можно ли работать с базой по параметрам лицензирования
  function CanConnectByLicenceType(ALicenceType: TLicenceType): TCheckConnectResult;
  // Обработка результата ф-ции CanConnectByLicenceType
  procedure CheckConnectResultHandler(ACheckConnectResult: TCheckConnectResult);
  // Г Л А В Н А Я
  // Определяет можно ли работать с базой по параметрам лицензирования + отображает форму с параметрами
  function CheckProtectionBase(ABindingShow: Boolean; ABasePath: string=''): TCheckConnectResult;
  function ConnectToNBByParams(AProtectionBaseParams: TProtectionBaseParams; ATestConnect, AShowMessages: Boolean): Boolean;
  // Подключение к НБ
  function ConnecToNBWizard(ABindingShow, ATestConnect, ADisableEdit, ACanRemotaPath: Boolean): Boolean;
  // отображает форму с параметрами лицензирования
  function ShowProtectionBaseParams(AProtectionBaseParams: TProtectionBaseParams; ATestConnect, ADisableEdit, ACanRemotePath: Boolean): TProtectionBaseParams;

  function SendARP(const DestIP, SrcIP: ULONG;
    pMacAddr: PULONG; var PhyAddrLen: ULONG): DWORD; stdcall; external 'IPHLPAPI.DLL';

  function GetProtectionType: TLicenceType;

var
  GProtectionType: TLicenceType;

implementation

Uses U_BaseCommon, U_BaseConstants, U_Main, U_BaseSettings, U_Protection, U_ProtectionBaseParams, FIBDatabase, Unit_DM_SCS;


function GetHash(AStr: string): string;
const
  BuffSize = 3000;
var
  hProv: HCRYPTPROV;
  hash: HCRYPTHASH;

  //Buff: array [1..BuffSize] of byte;
  //newhash: array [1..16] of byte;
  Buff: Pointer;

  dwHashLen: DWord;
  dwCount: DWord;
  pbHash: PByte;
  i: integer;
begin
  Result := 'null';

  //ZeroMemory(@Buff, BuffSize);
  //for i := 1 to Length(AStr) do
  //  Buff[i] := Byte(AStr[i]);

  GetMem(Buff, SizeOf(Length(AStr)) );
  for i := 0 to Length(AStr) - 1 do
    Char(Pointer(Integer(Buff)+i)^) := AStr[i+1];

  // Get handle to the default provider.
  if CryptAcquireContext(hProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) then
  begin
    // Create hash object.
    if CryptCreateHash(hProv, CALG_MD5, 0, 0, hash) then
    begin
      // Hash in buffer.
      if CryptHashData(hash, Buff, Length(AStr), 0) then
      begin
        // Read hash value size and allocate memory
        dwCount := SizeOf(DWord);
        if CryptGetHashParam(hash, HP_HASHSIZE, @dwHashLen, dwCount, 0) then
        begin
          GetMem(pbHash, dwHashLen);

          // Read hash value.
          if CryptGetHashParam(hash, HP_HASHVAL, pbHash, dwHashLen, 0) then
          begin
            Result := '';
            for i := 0 to dwHashLen - 1 do
              Result := Result + IntToHex( Byte(Pointer(Integer(pbHash) + i)^), 2);
          end;
          FreeMem(pbHash);
        end;
      end;
      CryptDestroyHash(hash);
    end;
    CryptReleaseContext(hProv, 0);
  end;

  FreeMem(Buff);
end;

function BuildHash(SourceStr: string): string;
var
hProv: HCRYPTPROV;
tempbuf: array [1..3000] of byte;
newhash: array [1..16] of byte;
i: integer;
len: DWORD;
begin
  len := length(SourceStr);
  for i:=1 to length(SourceStr) do
   tempbuf[i] := byte(SourceStr[i]);
  len := 16;
  result := 'null';
  new(hProv);
  hProv^ := 0;
  new(hHash);
  hHash^ := 0;
  if CryptAcquireContext(hProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) then
    if CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash) then
      if CryptHashData(hHash, @tempbuf, length(SourceStr), 0) then
        if CryptGetHashParam(hHash,$0002, @newhash, len, 0) then
        begin
          HashString := '';
          for i:=1 to 16 do
            HashString := HashString + inttohex(newhash[i], 2);
          if CryptDestroyHash(hHash) then
            if CryptReleaseContext(hProv, 0) then
              result := HashString;
        end;
end;

function XorStr(AStr: String; AMask: Byte; ADynamicMask: Boolean): String;
var
  i: integer;
  Mask: Byte;
begin
  Result := '';
  Mask := AMask;
  for i := 1 to Length(AStr) do
  begin
    Result := Result + Char(Byte(AStr[i]) xor Mask);
    if ADynamicMask then
    begin
      if Mask < $FF then
        Inc(Mask)
      else
        Mask := 1;
    end;
  end;
end;

procedure DefineUseFieldsInBase(AFMain: TForm);
begin
  if AFMain is TF_Main then
  begin
    if Not CheckFieldInTableByFirstRec(tnSettings, fnTmpAnswerCode, TF_Main(AFMain).DM.Query_Select) then
      TF_Main(AFMain).DM.AddFieldToTable(tnSettings, fnTmpAnswerCode, ftString, 200);
    if Not CheckFieldInTableByFirstRec(tnSettings, fnTmpMACAddress, TF_Main(AFMain).DM.Query_Select) then
      TF_Main(AFMain).DM.AddFieldToTable(tnSettings, fnTmpMACAddress, ftString, 200);
    if Not CheckFieldInTableByFirstRec(tnSettings, fnTmpMaxConnCount, TF_Main(AFMain).DM.Query_Select) then
      TF_Main(AFMain).DM.AddFieldToTable(tnSettings, fnTmpMaxConnCount, ftString, 200);
    if Not CheckFieldInTableByFirstRec(tnSettings, fnTmpPathCheckSum, TF_Main(AFMain).DM.Query_Select) then
      TF_Main(AFMain).DM.AddFieldToTable(tnSettings, fnTmpPathCheckSum, ftString, 200);
  end;
end;

function CryptStr(AStr: String; AParam: Integer): String;
begin
  Result := AStr;
end;

function DecryptStr(AStr: String; AParam: Integer): String;
begin
  Result := AStr;
end;

function GetAnswerCodeFromBase: String;
begin
  Result := F_NormBase.DM.GetStringFromTableFirst(tnSettings, fnTmpAnswerCode);
  // DECRYPTION
  Result := DecryptStr(Result, 0);
end;

function GetAnswerCodeFromProgram: string;
begin
  Result := '00';
end;

function GetCurrConnectionCount: Integer;
begin
  Result := 0;
  if F_NormBase <> nil then
    Result := GetConnectedCountToDataBase(F_NormBase.DM.Database_SCS);
    //if F_NormBase.DM.Database_SCS.Connected then
    //  Result := F_NormBase.DM.Database_SCS.UserNames.Count;
end;

function GetMACAddrFromBase: String;
begin
  Result := F_NormBase.DM.GetStringFromTableFirst(tnSettings, fnTmpMACAddress);
  // DECRYPTION
  Result := DecryptStr(Result, 0);
end;

function GetMACAddrFromIP(ARemoteIP: String): String;
var
  DestIP, SrcIP: ULONG;
  pMacAddr: TMacAddress;
  PhyAddrLen: ULONG;

  function GetMAC(Value: TMacAddress; Length: DWORD): String;
  var
    I: Integer;
  begin
    Result := '';
    if Length = 0 then
      Result := '00-00-00-00-00-00'
    else
    begin
      Result := '';
      for i:= 0 to Length - 2 do
        Result := Result + IntToHex(Value[i], 2) + '-';
      Result := Result + IntToHex(Value[Length-1], 2);
    end;
  end;

begin
  Result := '';

  DestIP := inet_addr(PAnsiChar(ARemoteIP));
  PhyAddrLen := 6;
  SendArp(DestIP, 0, @pMacAddr, PhyAddrLen);
  Result := GetMAC(pMacAddr, PhyAddrLen);
end;

function GetMaxConnectionCountFromBase: Integer;
var
  ResStr: string;
begin
  Result := -1;
  ResStr := GetMaxConnectionCountFromBaseAsStr;
  if ResStr <> '' then
    try
      Result := StrToInt(ResStr);
    except
    end;
end;

function GetMaxConnectionCountFromBaseAsStr: String;
begin
  Result := F_NormBase.DM.GetStringFromTableFirst(tnSettings, fnTmpMaxConnCount);
  // DECRYPTION
  Result := DecryptStr(Result, 0);
end;

function GetPathCheckSumFromBase: Integer;
var
  ResStr: string;
begin
  Result := -1;
  ResStr := GetPathCheckSumFromBaseAsStr;
  if ResStr <> '' then
    try
      Result := StrToInt(ResStr);
    except
    end;
end;

function GetPathCheckSumFromBaseAsStr: String;
begin
  Result := F_NormBase.DM.GetStringFromTableFirst(tnSettings, fnTmpPathCheckSum);
  // DECRYPTION
  Result := DecryptStr(Result, 0);
end;

function GetProgKeyParams(APathToNB: string; AConnectCount: Integer): TProtectionBaseKeyParams;
var
  ServerName: string;
  LocalPath: string;
begin
  ZeroMemory(@Result, SizeOf(TProtectionBaseKeyParams));
  ExtractServerName(APathToNB, ServerName, LocalPath);

  Result.AnswerCode := GetAnswerCodeFromProgram;
  Result.ConnectionCount := IntToStr(AConnectCount);
  Result.MACAddrServer := GetMACAddrFromIP(GetIPAddressFromName(ServerName));
  Result.PathCheckSum := IntToStr(GetStrCheckSum(AnsiUpperCase(LocalPath)));
end;

procedure SetAnswerCodeToBase(AAnswerCode: String);
var
  AnswerCodeCR: String;
begin
  // CRYPTION
  AnswerCodeCR := CryptStr(AAnswerCode, 0);
  F_NormBase.DM.UpdateStrTableFieldAllRec(tnSettings, fnTmpAnswerCode, AnswerCodeCR);
end;

procedure SetMACAddrToBase(AMACAddr: String);
var
  MACAddrCR: String;
begin
  // CRYPTION
  MACAddrCR := CryptStr(AMACAddr, 0);
  F_NormBase.DM.UpdateStrTableFieldAllRec(tnSettings, fnTmpMACAddress, MACAddrCR);
end;

procedure SetMaxConnectionCountToBase(AMaxConnectionCount: Integer);
begin
  SetMaxConnectionCountToBaseAsStr(IntToStr(AMaxConnectionCount));
end;

procedure SetMaxConnectionCountToBaseAsStr(AMaxConnectionCount: String);
var
  MaxConnectionCountCR: String;
begin
  // CRYPTION
  MaxConnectionCountCR := CryptStr(AMaxConnectionCount, 0);
  F_NormBase.DM.UpdateStrTableFieldAllRec(tnSettings, fnTmpMaxConnCount, MaxConnectionCountCR);
end;

procedure SetPathCheckSumFromBase(APathCheckSum: Integer);
begin
  SetPathCheckSumFromBaseAsStr(IntToStr(APathCheckSum));
end;

procedure SetPathCheckSumFromBaseAsStr(APathCheckSum: String);
var
  PathCheckSumCR: String;
begin
  // CRYPTION
  PathCheckSumCR := CryptStr(APathCheckSum, 0);
  F_NormBase.DM.UpdateStrTableFieldAllRec(tnSettings, fnTmpPathCheckSum, PathCheckSumCR);
end;

function CanConnectByLicenceType(ALicenceType: TLicenceType): TCheckConnectResult;
var
  ServerName, LocalPath: string;

  AnswerCode: string;
  MACAddrServer: string;
  CurrConnectionCount: Integer;
  CurrPathCheckSum: Integer;

  AnswerCodeFromBase: string;
  MACAddrFromBase: string;
  MaxConnectionCountFromBase: Integer;
  PathCheckSumFromBase: Integer;
begin
  Result := [];
  if F_NormBase.DM.Database_SCS.Connected then
  begin
    //*** Определит поля в таблице
    DefineUseFieldsInBase(F_NormBase);

    //*** определит имя сервера и локальный путь к базе
    ExtractServerName(F_NormBase.DM.Database_SCS.DBName, ServerName, LocalPath);
    //*** анализ корректности типа лицензирования
    case ALicenceType of
      ltLocal:
        if ServerName = '' then
          Result := Result + [ccrSuccess]
        else
          Result := Result + [ccrIsRemotePathInLocal];
      ltMultiUser:
        begin
          if ServerName <> '' then
          begin
            //*** Получение параметров программы
            AnswerCode := GetAnswerCodeFromProgram;
            MACAddrServer := GetMACAddrFromIP(GetIPAddressFromName(ServerName));
            CurrConnectionCount := F_NormBase.DM.Database_SCS.UserNames.Count;
            CurrPathCheckSum := GetStrCheckSum(AnsiUpperCase(LocalPath));

            //*** Получение параметров из базы
            AnswerCodeFromBase := GetAnswerCodeFromBase;
            MACAddrFromBase := GetMACAddrFromBase;
            MaxConnectionCountFromBase := GetMaxConnectionCountFromBase;
            PathCheckSumFromBase := GetPathCheckSumFromBase;

            { Для теста
            SetAnswerCodeToBase(AnswerCode+'112233445566');
            SetMACAddrToBase(MACAddrServer);
            SetMaxConnectionCountToBase(9);
            SetPathCheckSumFromBase(CurrPathCheckSum);}

            //*** проверка ответного кода
            if (AnswerCodeFromBase = '') or (AnswerCode = '') then
            begin
              if AnswerCodeFromBase = '' then
                Result := Result + [ccrNoAnswerCodeInBase];
              if AnswerCode = '' then
                Result := Result + [ccrNoAnswerCodeInProg];
            end
            else
            if AnswerCodeFromBase <> AnswerCode then
              Result := Result + [ccrNoProperAnswerCode];

            //*** проверка MAC адреса
            if (MACAddrFromBase = '') or (MACAddrServer = '') then
            begin
              if MACAddrFromBase = '' then
                Result := Result + [ccrNoMACAddrInBase];
              if MACAddrServer = '' then
                Result := Result + [ccrNoMACAddrInProg];
            end
            else
            if MACAddrFromBase <> MACAddrServer then
              Result := Result + [ccrNoProperMACAddr];

            //*** проверка количества подключений
            if MaxConnectionCountFromBase = -1 then
              Result := Result + [ccrNoMaxConnectionCountInBase]
            else
            if MaxConnectionCountFromBase < CurrConnectionCount then
              Result := Result + [ccrNoProperConnectionCount];

            //*** проверка контрольной суммы пути к базе
            if PathCheckSumFromBase = -1 then
              Result := Result + [ccrNoPathCheckSumInBase]
            else
            if PathCheckSumFromBase < CurrConnectionCount then
              Result := Result + [ccrNoProperPathCheckSum];

            if Result = [] then
              Result := Result + [ccrSuccess];
          end
          else
            Result := Result + [ccrIsLocalPathInMultiUser];
        end;
    end;
  end
  else
    Result := Result + [ccrBaseNoConnected];
end;

procedure CheckConnectResultHandler(ACheckConnectResult: TCheckConnectResult);
var
  StrMsg: string;

  procedure AddMessgToStr(AMsg: String);
  begin
    if StrMsg <> '' then
      StrMsg := StrMsg +';'+ #10#13;
    StrMsg := '-'+AMsg;
  end;

begin
  StrMsg := '';

  if ccrIsRemotePathInLocal in ACheckConnectResult then
    AddMessgToStr('для локального типа лицензирования задан сетевой путь');
  if ccrIsLocalPathInMultiUser in ACheckConnectResult then
    AddMessgToStr('для многопользовательского типа лицензирования задан локальный путь');
  if ccrNoAnswerCodeInProg in ACheckConnectResult then
    AddMessgToStr('не удалось найти ответный код программы');
  if ccrNoMACAddrInProg in ACheckConnectResult then
    AddMessgToStr('не удалось определит MAC адресс сервера');

  if (ccrNoAnswerCodeInBase in ACheckConnectResult) and
     (ccrNoMACAddrInBase in ACheckConnectResult) and
     (ccrNoMaxConnectionCountInBase in ACheckConnectResult) and
     (ccrNoPathCheckSumInBase in ACheckConnectResult) then
    AddMessgToStr('не установлен ключ лицензирования')
  else
  if (ccrNoAnswerCodeInBase in ACheckConnectResult) or
     (ccrNoMACAddrInBase in ACheckConnectResult) or
     (ccrNoMaxConnectionCountInBase in ACheckConnectResult) or
     (ccrNoPathCheckSumInBase in ACheckConnectResult) then
    AddMessgToStr('установленный ключ лицензирования поврежден');
  if ccrNoProperAnswerCode in ACheckConnectResult then
    AddMessgToStr('ответный код ключа не соответствует ответному коду программы');
  if ccrNoProperMACAddr in ACheckConnectResult then
    AddMessgToStr('MAC адресс ключа не соответствует MAC адресу сервера');
  if ccrNoProperConnectionCount in ACheckConnectResult then
    AddMessgToStr('количество подключений превышает максимальное');
  if ccrNoProperPathCheckSum in ACheckConnectResult then
    AddMessgToStr('контрольная сумма ключа не соответствует программе');

  if StrMsg <> '' then
  begin
    MessageModal(StrMsg, ApplicationName, MB_OK or MB_ICONINFORMATION);
  end;
end;

function CheckProtectionBase(ABindingShow: Boolean; ABasePath: string=''): TCheckConnectResult;
var
  ParamsFromReg: TProtectionBaseParams;
  NewParams: TProtectionBaseParams;

  ShowParams: Boolean;
  AutoShowParams: Boolean;
  LicenseTypeInt: Integer;
  CurrServerName: String;
  CurrLocalPath: String;

  CkConnect: TCheckConnectResult;
begin
  Result := [];
  try
    CkConnect := [ccrSuccess];
    try
      ZeroMemory(@ParamsFromReg, SizeOf(TCheckConnectResult));

      ShowParams := ABindingShow;
      try
        ExtractServerName(F_NormBase.DM.Database_SCS.DBName, CurrServerName, CurrLocalPath);
      except
      end;
      //*** Получить параметры с реестра
      //

      {$IF Defined(FLASH_SCS)}
        AutoShowParams := GSCSIni.NB.AutoShowParams;
        ParamsFromReg.NoAsk := Not AutoShowParams;
      {$ELSE}
        AutoShowParams := GetBoolFromRegistry(pnShowLicenceType, true);
        ParamsFromReg.NoAsk := Not AutoShowParams;
      {$IFEND}

      ParamsFromReg.LicenceType := ltNone;
      {$IF Defined(FLASH_SCS)}
        LicenseTypeInt := GSCSIni.NB.LicenseTypeInt;
      {$ELSE}
        LicenseTypeInt := GetIntFromRegistry(pnLicenseTypeNB, Ord(ltNone));
      {$IFEND}

      if TLicenceType(LicenseTypeInt) = ltLocal then
        ParamsFromReg.LicenceType := ltLocal
      else
      if TLicenceType(LicenseTypeInt) = ltMultiUser then
        ParamsFromReg.LicenceType := ltMultiUser;
      //*** Если тип лицензирования не удалось его найти, определить его по типу пути к базе
      if ParamsFromReg.LicenceType = ltNone then
      begin
        if CurrServerName = '' then
          ParamsFromReg.LicenceType := ltLocal
        else
          ParamsFromReg.LicenceType := ltMultiUser;
      end;
      if ABasePath = '' then
      begin
        {$IF Defined(FLASH_SCS)}
          ParamsFromReg.ServerName := GSCSIni.NB.ServerName;
          ParamsFromReg.LocalPathToNB := GSCSIni.NB.LocalPathToNB;
        {$ELSE}
          ParamsFromReg.ServerName := GetStrFromRegistry(pnServerNameNB, CurrServerName);
          ParamsFromReg.LocalPathToNB := GetStrFromRegistry(pnLocalPathToNB, CurrLocalPath);
        {$IFEND}
      end
      else
      begin
        ExtractServerName(ABasePath, CurrServerName, CurrLocalPath);
        ParamsFromReg.ServerName := CurrServerName;
        ParamsFromReg.LocalPathToNB := CurrLocalPath;
      end;

      if Not ShowParams then
        ShowParams := AutoShowParams;

      //*** Определить можно ли работать с базой по параметрам лицензирования
      try
        CkConnect := CanConnectByLicenceType(ParamsFromReg.LicenceType);
        if Not (ccrSuccess in CkConnect) then
          ShowParams := true;
      except
        ShowParams := true;
      end;

      if ShowParams then
      begin
        NewParams := ShowProtectionBaseParams(ParamsFromReg, false, false, true);
        if NewParams.IsOk then
        begin
          //*** Определить можно ли работать с базой по новым параметрам лицензирования
          CkConnect := CanConnectByLicenceType(NewParams.LicenceType);
          //*** Сохранить в реестр
          //
          {$IF Defined(FLASH_SCS)}
            GSCSIni.NB.AutoShowParams := Not NewParams.NoAsk;
            GSCSIni.NB.LicenseTypeInt := Ord(NewParams.LicenceType);
            GSCSIni.NB.ServerName := NewParams.ServerName;
            GSCSIni.NB.LocalPathToNB := NewParams.LocalPathToNB;
            WriteNBIni(GSCSIni.NB);
            
          {$ELSE}
            SaveBoolToRegistry(pnShowLicenceType, Not NewParams.NoAsk);
            SaveIntToRegistry(pnLicenseTypeNB, Ord(NewParams.LicenceType));
            SaveStrToRegistry(pnServerNameNB, NewParams.ServerName);
            SaveStrToRegistry(pnLocalPathToNB, NewParams.LocalPathToNB);
          {$IFEND}
        end;
      end;
    finally
      if Not (ccrSuccess in CkConnect) then
      begin
//        ExitProcess(0);
      end;
    end;
    Result := CkConnect;
  except
    on E: Exception do AddExceptionToLogEx('CheckProtectionBase', E.Message);
  end;
end;

function ConnectToNBByParams(AProtectionBaseParams: TProtectionBaseParams; ATestConnect, AShowMessages: Boolean): Boolean;
var
  MsgError: string;
  CanConnect: Boolean;

  CurrServerName: string;
  CurrLocalPath: string;
  DBPath: string;

  OpenBaseResult: TOpenBaseResult;
begin
  Result := false;
  CanConnect := true;

  DBPath := '';
  MsgError := '';
  if AProtectionBaseParams.LicenceType = ltLocal then
  begin
    ExtractServerName(AProtectionBaseParams.PathToNB, CurrServerName, CurrLocalPath);
    if CurrServerName <> '' then
    begin
      CanConnect := false;
      if AShowMessages then
        MessageModal('Путь '+AProtectionBaseParams.PathToNB+' не является локальным', ApplicationName, MB_OK or MB_ICONINFORMATION);
    end;
    DBPath := AProtectionBaseParams.PathToNB;
    if DBPath = '' then
      DBPath := GetPathToDefNB;
  end
  else
  if AProtectionBaseParams.LicenceType = ltMultiUser then
  begin
    if AProtectionBaseParams.ServerName = '' then
    begin
      CanConnect := false;
      if AShowMessages then
        MessageModal('Не определено имя сервера', ApplicationName, MB_OK or MB_ICONINFORMATION);
    end
    else
    if AProtectionBaseParams.LocalPathToNB = '' then
    begin
      CanConnect := false;
      if AShowMessages then
        MessageModal('Не определен удаленный путь к базе', ApplicationName, MB_OK or MB_ICONINFORMATION);
    end;
    DBPath := AProtectionBaseParams.ServerName+':'+AProtectionBaseParams.LocalPathToNB; 
  end;

  if CanConnect then
  begin
    OpenBaseResult := F_NormBase.GSCSBase.Open(DBPath, true, Not ATestConnect);
    if obrSuccess = OpenBaseResult then
    begin
      Result := true;
      if ATestConnect then
        F_NormBase.GSCSBase.SimpleClose(false)
      else
        OpenBaseResultHandler(OpenBaseResult, F_NormBase, true, false);
    end
    else
    begin
      OpenBaseResultHandler(OpenBaseResult, F_NormBase, true, false, ord(AProtectionBaseParams.LicenceType));
    end;
  end;
end;

function ConnecToNBWizard(ABindingShow, ATestConnect, ADisableEdit, ACanRemotaPath: Boolean): Boolean;
var
  ParamsFromReg: TProtectionBaseParams;
  NewParams: TProtectionBaseParams;
  DefNBPath: string;

  ShowParams: Boolean;
  AutoShowParams: Boolean;
  LicenseTypeInt: Integer;
  CurrServerName: string;
  CurrLocalPath: string;
begin
  Result := false;
  try
    ZeroMemory(@ParamsFromReg, SizeOf(TCheckConnectResult));

    ShowParams := ABindingShow;

    {$IF Defined (TRIAL_SCS) and Defined(SCS_PE)}
      AutoShowParams := ABindingShow;
      ParamsFromReg.NoAsk := Not AutoShowParams;
    {$ELSE}
      //*** Получить параметры с реестра
      //
      AutoShowParams := GetBoolFromRegistry(pnShowLicenceType, true);
      ParamsFromReg.NoAsk := Not AutoShowParams;
      {$IF Defined(FLASH_SCS)}
        AutoShowParams := GSCSIni.NB.AutoShowParams;
        ParamsFromReg.NoAsk := Not AutoShowParams;
      {$IFEND}
    {$IFEND}
    ParamsFromReg.LicenceType := ltLocal;
    {$IF Defined(FLASH_SCS)}
      LicenseTypeInt := GSCSIni.NB.LicenseTypeInt;
    {$ELSE}
      LicenseTypeInt := GetIntFromRegistry(pnLicenseTypeNB, Ord(ParamsFromReg.LicenceType));
    {$IFEND}
    if TLicenceType(LicenseTypeInt) = ltLocal then
      ParamsFromReg.LicenceType := ltLocal
    else
    if TLicenceType(LicenseTypeInt) = ltMultiUser then
      ParamsFromReg.LicenceType := ltMultiUser;
    if Not ACanRemotaPath then
      ParamsFromReg.LicenceType := ltLocal;
    {$IF Defined(FLASH_SCS)}
      ParamsFromReg.ServerName := GSCSIni.NB.ServerName;
      ParamsFromReg.LocalPathToNB := GSCSIni.NB.LocalPathToNB;
    {$ELSE}
      ParamsFromReg.ServerName := GetStrFromRegistry(pnServerNameNB, CurrServerName);
      ParamsFromReg.LocalPathToNB := GetStrFromRegistry(pnLocalPathToNB, CurrLocalPath);
    {$IFEND}
    ParamsFromReg.PathToNB := GSCSIni.NB.Common.DBPath;
    DefNBPath := GetPathToDefNB;
    if ParamsFromReg.PathToNB = '' then
      ParamsFromReg.PathToNB := DefNBPath;


    if Not ShowParams then
      ShowParams := AutoShowParams;

    //*** Если не удается подключится к базе, то вывести форму
    if Not ShowParams then
    begin
      if Not ConnectToNBByParams(ParamsFromReg, ATestConnect, false) then
      begin
        // for flash try local connect
        {$IF Defined(FLASH_SCS)}
          if (ParamsFromReg.LicenceType = ltMultiUser) then
          begin
            ParamsFromReg.PathToNB := '';
            ParamsFromReg.LocalPathToNB := '';
            ParamsFromReg.ServerName := '';
            ParamsFromReg.LicenceType := ltLocal;
            GSCSIni.NB.LocalPathToNB := '';
            GSCSIni.NB.ServerName := '';
            GSCSIni.NB.LicenseTypeInt := 1;
            GSCSIni.NB.SaveConnParams := False;
            if Not ConnectToNBByParams(ParamsFromReg, ATestConnect, false) then
              ShowParams := true
            else
              Result := true;
          end
          else
            ShowParams := true;
        {$ELSE}
          ShowParams := true;
        {$IFEND}
      end
      else
        Result := true;
    end;

    if ShowParams then
    begin
      NewParams := ShowProtectionBaseParams(ParamsFromReg, ATestConnect, ADisableEdit, ACanRemotaPath);
      if NewParams.IsOk then
      begin
        Result := true;

        try
          //  raise Exception.Create('');
          RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
        except
          GProtectionType := NewParams.LicenceType;
        end;

        {//06.04.2009
        //*** Сохранить в реестр
        //
        SaveBoolToRegistry(pnShowLicenceType, Not NewParams.NoAsk);
        SaveIntToRegistry(pnLicenseTypeNB, Ord(NewParams.LicenceType));
        SaveStrToRegistry(pnServerNameNB, NewParams.ServerName);
        SaveStrToRegistry(pnLocalPathToNB, NewParams.LocalPathToNB);

        if AnsiUpperCaseFileName(NewParams.PathToNB) = AnsiUpperCaseFileName(DefNBPath) then
          NewParams.PathToNB := '';
        GSCSIni.NB.Common.DBPath := NewParams.PathToNB;
        WriteNBIni(GSCSIni.NB);}
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('CheckProtectionBase', E.Message);
  end;
end;


function GetProtectionType: TLicenceType;
var
  ParamsFromReg: TProtectionBaseParams;
  NewParams: TProtectionBaseParams;

  ShowParams: Boolean;
  AutoShowParams: Boolean;
  LicenseTypeInt: Integer;
  CurrServerName: String;
  CurrLocalPath: String;

  CkConnect: TCheckConnectResult;
begin
  try
    result := ltLocal;
    try
      ZeroMemory(@ParamsFromReg, SizeOf(TCheckConnectResult));
      //*** Получить параметры с реестра
      //
      begin
        LicenseTypeInt := GetIntFromRegistry(pnLicenseTypeNB, Ord(ltLocal));
        if TLicenceType(LicenseTypeInt) = ltLocal then
          result := ltLocal
        else
        if TLicenceType(LicenseTypeInt) = ltMultiUser then
          result := ltMultiUser;
      end;
    finally
    end;
  except
    on E: Exception do AddExceptionToLogEx('GetProtectionType', E.Message);
  end;
end;


function ShowProtectionBaseParams(AProtectionBaseParams: TProtectionBaseParams; ATestConnect, ADisableEdit, ACanRemotePath: Boolean): TProtectionBaseParams;
var
  F_ProtectionBaseParams: TF_ProtectionBaseParams;
begin
  ZeroMemory(@Result, SizeOf(TProtectionBaseParams));
  Result := AProtectionBaseParams;
  Result.IsOk := false;

  F_ProtectionBaseParams := TF_ProtectionBaseParams.Create(nil);
  try
    if Not ACanRemotePath then
      AProtectionBaseParams.LicenceType := ltLocal;

    F_ProtectionBaseParams.SetParams(AProtectionBaseParams);
    //F_ProtectionBaseParams.gbLicenseType.Enabled := Not ADisableEdit;
    F_ProtectionBaseParams.cbLocal.Enabled := Not ADisableEdit;
    F_ProtectionBaseParams.cbMultiUser.Enabled := Not ADisableEdit;
    F_ProtectionBaseParams.edPathToNB.ReadOnly := ADisableEdit;
    F_ProtectionBaseParams.edServerName.ReadOnly := ADisableEdit;
    F_ProtectionBaseParams.edLocalPathName.ReadOnly := ADisableEdit;
    F_ProtectionBaseParams.btSelectPathToNB.Enabled := Not ADisableEdit;

    if Not ACanRemotePath then
      F_ProtectionBaseParams.cbMultiUser.Enabled := false;

    F_ProtectionBaseParams.FDisableEdit := ADisableEdit;
    F_ProtectionBaseParams.FTestConnect := ATestConnect;

    if F_ProtectionBaseParams.ShowModal = mrOk then
    begin
      Result := F_ProtectionBaseParams.GetParams;
      Result.IsOk := true;
    end;
  finally
    FreeAndNil(F_ProtectionBaseParams);
  end;
end;

end.