mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-12 00:45:40 +02:00
946 lines
31 KiB
ObjectPascal
946 lines
31 KiB
ObjectPascal
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.
|