// Нужные компоненты:
// dcpcrypt - X:\Components\dcpcrypt\dcpdelphi6.dpk
// msysinfo - X:\Components\msysinfo\d6\MSI_*.dpk
unit U_Protection;

interface

uses
  Windows, FastStrings, Forms,{ BZ2,} SysUtils, Variants, Classes, StdCtrls, Registry,
  {MSI_IDE, MSI_Machine,}

  MyMSI_Storage, MyMiTeC_WinIOCTL,

   DCPsha1, ComObj, DCPrc4,
  IniFiles, StrUtils, Dialogs, U_ProtectionCommon,
  {$IF Not Defined(SCS_SPA)}
    {$IF Defined(PROCAT_SCS) AND Not Defined(TRIAL_SCS)}
      U_ProtRutinP,
    {$ELSE}
      {$IF Defined(TRIAL_SCS)}
        U_ProtRutin,
      {$IFEND}
    {$IFEND}
  {$IFEND}

  {$IF Defined (SCS_SPA) AND Not Defined(TRIAL_SCS)}
    U_ProtRutinSPA,
  {$IFEND}

  {$IF Defined (SCS_SPA) AND Defined(TRIAL_SCS)}
    U_ProtRutin,
  {$IFEND}

 U_ProtectionBase, U_USB;

const
//{$M-}

  EndNumRun = '!олкетси яндогес ан ыммаргорп воксупаз овтсечилоК';
  InpKod = '...док етидевВ';

  RegKeyNameReg = 'MemUse';
  RegKeyNameReg1 = 'DiskUse';
  LicenseFileName = 'license.key';
  DefaultID = '6666666666666666';

  abc = 'abcdefghijklmnopqrstuvwxyz';

  ALG_CLASS_HASH = (4 shl 13);
  ALG_TYPE_ANY = (0);
  ALG_SID_MD5 = 3;
  AT_SIGNATURE = 2;
  CALG_MD5 = (ALG_CLASS_HASH or ALG_TYPE_ANY or ALG_SID_MD5);
  MS_DEF_PROV = 'Microsoft Base Cryptographic Provider v1.0';
  PROV_RSA_FULL = 1;
  CRYPT_VERIFYCONTEXT  = DWORD($F0000000);

type
  HCRYPTPROV = ^Longword;
  ALG_ID = Cardinal;
  HCRYPTKEY = ^longint;
  HCRYPTHASH = ^longint;

  TKeyVer = (PRO, TRIAL);

  TProgID = record
    Data1: string[4];
    Data2: string[4];
    Data3: string[4];
    Data4: string[4];
  end;

  TAnswer = record
    Data1: string[4];
    Data2: string[4];
  end;

  TAnswerls = record
    Data1: string[4];
    Data2: string[4];
    Data3: string[4];
    Data4: string[4];
  end;

  TAnswerscs = record
    Data1: string[4];
    Data2: string[4];
    Data3: string[5];
    Data4: string[4];
  end;

  TLicense = record
    ProgID: TProgID;
    Period: TPeriod;
    StartDate: integer;
    EndDate: integer;
  end;

  ELicense = class(Exception)
  public
    IsTerm: boolean;
    constructor Create(Msg: string; Term: boolean=false);
  end;

  TLicenseFile = class
  private
    FList: TStringList;
    FVersion: integer;
    FisLoading: boolean;
    FFileName: string;
    FMode : Word;

    procedure Load;
    procedure Save;
    function GetCount: integer;
    function GetLicense(Index: integer): TLicense;
  public
    constructor Create(FileName: string; FileMode: Word);
    destructor Destroy; override;

    procedure Add(License: TLicense);
    procedure Delete(Index: integer);
    procedure Clear;
    function FindLicense(AProgID: TProgID): integer;
    property License[Index: integer]: TLicense read GetLicense;
    property Count: integer read GetCount;
    property Version: integer read FVersion write FVersion;

  end;

  TProtection = class
  private
    FHardDriveSerialNumber: string;
    function CheckAnswerKey(AnswerKey: TAnswer): BOOL;
    function CheckAnswerKeyls(AnswerKey: TAnswerls): BOOL;
    function CheckAnswerKeyscs(AnswerKey: TAnswerscs): BOOL;
    function getHardDriveComputerID: string;
    function getHardDriveComputerIDOld: string;
    function GetNSerial8: string;
    function ReadDrivePortsInWin9X: Boolean;
    function ReadDrivePortsInWin9XOld: Boolean;
    function GetIDESerial: TProgID;
    function GetIDESerialOld: TProgID;
    function GetVolume(_drivenum:word): dword;
    function BuildHash(SourceStr: string): string;
    function GenBaseSerial: TProgID;
  public
    AnswerReg: TAnswerls;
    function CheckIsVer(CheckingVer: TKeyVer): Boolean;
    function CheckIsVerls(CheckingVer: TKeyVer): Boolean;
    function CheckIsVer2(CheckingVer: TKeyVer; var kodm: integer): Boolean;
    function CheckIsVerLic(aProgCode, aUserCode: string; CheckingVer: TKeyVer): Boolean;
    function RegisterProg(Answer: TAnswer): Boolean;
    function RegisterProgls(Answer: TAnswerls): Boolean;
    function GenProgID2: TProgID;
    function RegisterProgscs(Answer: TAnswerscs): Boolean;
    function IsRegisterProg1: Boolean;
    function GenProgID: TProgID;
    function GenAnswer(AProgID: TProgID; KeyVer: TKeyVer): TAnswer; overload;
    function GenAnswer(AProgID: TProgID): TAnswer; overload;
    function GenAnswerLS(AProgID: TProgID; NumbLic: integer;
      KeyVer: TKeyVer): TAnswerls;
    function GetConnCount: integer;
    function GetLicense(AProgID: string = ''): TLicense;
  end;

  function FormatForUser(SrcStr: string): string;
  function FormatForProg(SrcStr: string): string;
  function StrToProgID(str: string): TProgID;
  function ProgIDToStr(AProgID: TProgID): string;
  procedure SyncLicenseFile(APath: string);
  function CheckParity(Key: string): dword;
  function CorrectCod(source: string): string;
  function CRC32(SrcStr: string; Parity: DWORD): string;
  function BuildFileHash(aPath: string): string;  
  procedure BuildFHash;
  procedure GetLic;
  function CheckProt: dword;
  function CheckProt1: dword;
  function CheckProt2: dword;

type
  TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP,wv2003, wvVista, wv7, wv8);

  function DetectWinVersion : TWinVersion;

var
  GLicExt: string;
  ConnCount: integer;
  // Tolik 24/06/2019 --
  //bufflic: PChar;
  bufflic: PAnsiChar;
  //
  IsVista: Boolean;
  Source: TStream;
  Digest: array[0..15] of byte;
  ProgID: TProgID;
  ProgProtection: TProtection;
  {$if Defined(DOCwIMAGES)}
    OkAlfaSet: set of char = ['0','1','2','3','4','5','6','7','8','9'];//,'A','B','C','D','E','F'];
  {$else}
    OkAlfaSet: set of char = ['0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'];
  {$ifend}
  RegistryKod: string;
  PortAddress: word;
  PortValue: byte;
  PortValue2: word;
  DevNo: byte;
  NTOs: boolean;
  baseAddress: word;
  diskdata: array [1..256] of word;
  IDT : array [0..5] of byte;
  lpOldGate : integer;
  hHash: HCRYPTHASH;
  HashString: String;

function BuildBuffHash(Buff: PByte; BuffSize: integer): string;

function GetOsVer: word;

function CryptAcquireContext(
    var phProv : HCRYPTPROV;
    pszContainer,
    pszProvider : LPCSTR;
    dwProvType,
    dwFlags : DWORD): BOOL; stdcall; external 'advapi32.dll' name 'CryptAcquireContextA';

function CryptCreateHash(hProv: HCRYPTPROV; Algid: ALG_ID;
hKey: HCRYPTKEY; dwFlags: DWORD; var phHash: HCRYPTHASH): BOOL; stdcall; external
'advapi32.dll' name 'CryptCreateHash';

function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): BOOL; stdcall; external
'advapi32.dll' name 'CryptReleaseContext';

function CryptDestroyHash(hHash: HCRYPTHASH): BOOL; stdcall; external
'advapi32.dll' name 'CryptDestroyHash';

function CryptSignHash(hHash: HCRYPTHASH; dwKeySpec: cardinal; sDescription: LPCSTR;
  dwFlags: DWORD; pbSignature: PBYTE; var plen: DWORD): BOOL; stdcall; external
'advapi32.dll' name 'CryptSignHashA';

function CryptHashData(hHash: HCRYPTHASH; pbData: PBYTE; pdwSigLen: DWORD; pbflag: DWORD): BOOL; stdcall; external
'advapi32.dll' name 'CryptHashData';

function CryptGetHashParam(hHash: HCRYPTHASH; dwParam: DWORD; pbData: PBYTE; var pdwDataLen: DWORD; dwFlags: DWORD): BOOL; stdcall; external
'advapi32.dll' name 'CryptGetHashParam';

function GetDateID: string;

implementation

uses U_Main, USCS_Main, IcsPlus, U_BaseCommon, U_BaseSettings;

function GetDateID: string;
var
  ts: TTimeStamp;
begin
  result := '';
  ts := DateTimeToTimeStamp(StrToDateU(DateEXE));
  result := IntToHex(ts.Date, 5);
  {$IF Defined(PROCAT_SCS)}
    {$IF Defined(FLASH_SCS)}
      result := result + '7';
    {$ELSE}
      {$IF Defined(OEM_NIKOMAX)}
        result := result + '8';
      {$ELSE}
        result := result + '9';
      {$IFEND}
    {$IFEND}
  {$ELSE}
    {$IF Defined(OEM_NIKOMAX)}
      result := result + '8';
    {$ELSE}
      result := result + '5';
    {$IFEND}
  {$IFEND}
end;

////////////////////////////////////////////////////////////
function DetectWinVersion : TWinVersion;
var
  OSVersionInfo : TOSVersionInfo;
begin
  Result := wvUnknown;                      // Неизвестная версия ОС
  OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
  if GetVersionEx(OSVersionInfo)
    then
      begin
        case OSVersionInfo.DwMajorVersion of
          3:  Result := wvNT3;              // Windows NT 3
          4:  case OSVersionInfo.DwMinorVersion of
                0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT
                   then Result := wvNT4     // Windows NT 4
                   else Result := wv95;     // Windows 95
                10: Result := wv98;         // Windows 98
                90: Result := wvME;         // Windows ME
              end;
          5:  case OSVersionInfo.DwMinorVersion of
                0: Result := wvW2K;         // Windows 2000
                1: Result := wvXP;          // Windows XP
                2: Result := wv2003;        // Windows 2003
              end;
          6:  begin Result := wv7; {Result := wvVista;} {showmessage('Vista');} end;
          7:  Result := wv7; //wvVista;
          8:  Result := wv8;
        end;
      end;
end;

procedure GetLic;
var
  Source: TMemoryStream;
begin
  Source := TMemoryStream.Create;
  try
    TMemoryStream(Source).LoadFromFile(Application.ExeName + GLicExt);
    Source.Position := 0;
    Source.ReadBuffer(bufflic^, 16);
  except
  end;
  Source.Free;
end;  

function BuildFileHash(aPath: string): string;
var
  Source1: TMemoryStream;
  Digest: array[0..15] of byte;
  i: integer;
begin
  result := '';
  Source1:= nil;
  try
    Source1 := TMemoryStream.Create;
    TMemoryStream(Source1).LoadFromFile(aPath);
  except
  end;
  if (Source1 <> nil) and (Source1.Size > 0) then
  begin
    FSCS_Main.DCP_md41.Init;                                   // initialize it
    FSCS_Main.DCP_md41.UpdateStream(Source1, Source1.Size);
    FSCS_Main.DCP_md41.Final(Digest);
    Source1.Free;
  end;
  for i := 0 to 15 do
    result := result + IntToHex(Digest[i], 2);
  //ShowMessage(result);  
end;


procedure BuildFHash;
begin
  Source:= nil;
  try
    Source:= TMemoryStream.Create;
    TMemoryStream(Source).LoadFromFile(Application.ExeName);  // , fmShareCompat);  // open the file specified by Edit1
  except
    MessageDlg('Невозможно открыть файл!',mtError,[mbOK],0);
  end;
  if Source <> nil then
  begin
    FSCS_Main.DCP_md41.Init;                                   // initialize it
    FSCS_Main.DCP_md41.UpdateStream(Source, Source.Size - CheckProt - CheckProt1 - CheckProt2);       // hash the stream contents
    FSCS_Main.DCP_md41.Final(Digest);                          // produce the digest
    Source.Free;
  end;
end;


procedure SyncLicenseFile(APath: string);
var
  FileNameOld, FileNameNew: string;
  FileInStream, FileOutStream: TFileStream;
  LicenseFileNew, LicenseFileOld: TLicenseFile;
begin
  FileNameNew := CorrectPath(APath) + LicenseFileName;

  if not FileExists(FileNameNew) then
    exit;

  FileNameOld := CorrectPath(ExeDir) + LicenseFileName;

  if FileExists(FileNameOld) then
  begin
    LicenseFileNew := TLicenseFile.Create(FileNameNew, fmOpenRead);
    try
      LicenseFileOld := TLicenseFile.Create(FileNameOld, fmOpenRead);
      try
        if LicenseFileNew.Version < LicenseFileOld.Version then
          exit;
      finally
        LicenseFileOld.Free;
      end;
    finally
      LicenseFileNew.Free;
    end;

    EraseFile(FileNameOld);
  end;

  FileInStream := TFileStream.Create(FileNameNew, fmOpenRead);
  try
    FileOutStream := TFileStream.Create(FileNameOld, fmCreate);
    try
      FileInStream.Position := 0;
      FileOutStream.CopyFrom(FileInStream, FileInStream.Size);
    finally
      FileOutStream.Free;
    end;
  finally
    FileInStream.Free;
  end;
end;

function ProgIDToStr(AProgID: TProgID): string;
begin
  Result := AProgID.Data1 + AProgID.Data2 + AProgID.Data3 + AProgID.Data4;
end;

function StrToProgID(str: string): TProgID;
begin
  with Result do
  begin
    Data1 := Copy(str, 1, 4);
    Data2 := Copy(str, 5, 4);
    Data3 := Copy(str, 9, 4);
    Data4 := Copy(str, 13, 4);
  end;
end;

function LicenseToStr(License: TLicense): string;
begin
  with License do
    Result := ProgIDToStr(ProgID) + '|' +
              IntToStr(Integer(Period)) + '|' + IntToStr(StartDate) + '|' +
              IntToStr(EndDate) + '|';
end;

function StrToLicense(str: string): TLicense;
var
  i: integer;
  element: integer;
  s: string;
  tempstr: string;
begin
  element := 0;
  s := str;
  i := Pos('|', s);
  while (length(s) > 0) and (i > 0) do
  begin
    tempstr := Copy(s, 1, i - 1);
    case element of
      0:
        Result.ProgID := StrToProgID(tempstr);
      1:
        Result.Period := TPeriod(StrToInt(tempstr));
      2:
        Result.StartDate := StrToInt(tempstr);
      3:
        Result.EndDate := StrToInt(tempstr);
    end;
    Delete(s, 1, i);
    i := Pos('|', s);
    Inc(element);
  end;
end;

function FormatForProg(SrcStr: string): string;
var i: integer;
begin
  result := '';
  result := copy(SrcStr, 1, length(SrcStr));
  for i := 1 to length(result) do
  begin
    case result[i] of
      'А': result[i] := 'A';
      'Б': result[i] := 'B';
      'В': result[i] := 'C';
      'Г': result[i] := 'D';
      'Д': result[i] := 'E';
      'Е': result[i] := 'F';
      'O': result[i] := '0';
      'О': result[i] := '0';
    end;
  end;
end;

function FormatForUser(SrcStr: string): string;
var i: integer;
begin
  result := '';
  result := copy(SrcStr, 1, length(SrcStr));
  {$IF Not Defined(SCS_PE) and Not Defined(SCS_SPA) }
    for i := 1 to length(result) do
    begin
      case result[i] of
        'A': result[i] := 'А';
        'B': result[i] := 'Б';
        'C': result[i] := 'В';
        'D': result[i] := 'Г';
        'E': result[i] := 'Д';
        'F': result[i] := 'Е';
      end;
    end;
  {$IFEND}  
end;

function CRC32(SrcStr: string; Parity: DWORD): string;
var
  i: integer;
  CheckSumm: dword;
  strl: integer;
  TempRes: Dword;
  MASK: Dword;
  TmpStr: PChar;
  BufS: integer;
  resstr: string;
begin
  CheckSumm := 0;
  strl := length(SrcStr);
  i := 1;
  while i <= strl do
  begin
    CheckSumm := HiWord(CheckSumm) + (CheckSumm XOR ord(SrcStr[i])) + ord(SrcStr[i]);
    CheckSumm := CheckSumm SHL 8;
    i := i + 1;
    if i <= strl then
    begin
      CheckSumm := CheckSumm + (LoWord(CheckSumm) XOR ord(SrcStr[i]));
      CheckSumm := CheckSumm + ord(SrcStr[i]) * ord(SrcStr[i]);
    end;
    i := i + 1;
  end;

  {$if Defined(DOCwIMAGES)}
    {$if Defined(RUS_SI)}
      TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $BCA;
    {$else}
      TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $CBA;
    {$ifend}
  {$else}
    TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $ABC;
  {$ifend}

  {$if Defined(FINAL_SCS)}
    {$IF Defined(SCS_SPA)}
      TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $59D;
    {$ELSE}
      TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $A74; //$CDA;
    {$IFEND}
  {$ifend}

  {$IF Defined(ES_GRAPH_SC)}
    {$if Defined(TRIAL_SCS)}
      TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $6A4;
    {$IFEND}
  {$ifend}

  result := inttohex(TempRes, 8);
  MASK := $00080000;
  SetLength(Result, 8);
  While CheckParity(result) <> Parity do
  begin
    TempRes := TempRes XOR MASK;
    result := inttohex(TempRes, 8);
  end;
  i := 1;
  while Length(Result) < 8 do
  begin
    Result := Result + SrcStr[i];
    i := i + 1;
  end;
  SetLength(Result, 8);
  Result := CorrectCod(Result);
end;

function CRC32_OLD(SrcStr: string): string;
var
  i: integer;
  CheckSumm: dword;
  strl: integer;
  TempRes: Dword;
begin
  //Tolik
  Result := '';
  //
  CheckSumm := 0;
  strl := length(SrcStr);
  i := 1;
  while i <= strl do
  begin
    CheckSumm := HiWord(CheckSumm) + (CheckSumm XOR ord(SrcStr[i])) + ord(SrcStr[i]);
    CheckSumm := CheckSumm SHL 8;
    i := i + 1;
    if i <= strl then
    begin
      CheckSumm := CheckSumm + (LoWord(CheckSumm) XOR ord(SrcStr[i]));
      CheckSumm := CheckSumm + ord(SrcStr[i]) * ord(SrcStr[i]);
    end;
    i := i + 1;
  end;
 {$if Defined(DOCwIMAGES)}
  TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $CBA;
 {$else}
  TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $ABC;
 {$ifend}
  result := inttohex(TempRes, 8);
  i := 1;
  while Length(Result) < 8 do
  begin
    Result := Result + SrcStr[i];
    i := i + 1;
  end;
  SetLength(Result, 8);
  {$if Defined(DOCwIMAGES)}
    Result := CorrectCod(Result);
  {$ifend}
end;

function BuildBuffHash(Buff: PByte; BuffSize: integer): string;
var
hProv: HCRYPTPROV;
newhash: array [1..16] of byte;
i: integer;
len: DWORD;
begin
  len := 16;
  result := 'null';
  new(hProv);
  hProv^ := 0;
  new(hHash);
  hHash^ := 0;
  if CryptAcquireContext(hProv, nil, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) then
    if CryptCreateHash(hProv, CALG_MD5, 0, 0, hHash) then
      if CryptHashData(hHash, Buff, BuffSize, 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 TProtection.GenAnswer(AProgID: TProgID; KeyVer: TKeyVer): TAnswer;
var
  Tempstr: String;
  TempKey: integer;
begin
{$if Defined(ADMIN_UA) or Defined(ADMIN_RU)}
  if KeyVer = PRO then
    TempStr := CRC32(ProgIDToStr(AProgID), 0)
  else
    TempStr := CRC32(ProgIDToStr(AProgID), 1);
  result.Data1 := Copy(TempStr, 1, 4);
  result.Data2 := Copy(TempStr, 5, 4);
{$ifend}
end;

// Tolik 21/06/2019 --
function ClearProgID(StrProgID: string): string;
var tempstr: AnsiString;
begin
  tempstr := StrProgID;
  //Result := Trim(AnsiReplaceStr(StrProgID, '-', ''));
  Result := Trim(AnsiReplaceStr(tempstr, '-', ''));
end;
{
function ClearProgID(StrProgID: string): string;
begin
  Result := Trim(AnsiReplaceStr(StrProgID, '-', ''));
end;
}
//

function TProtection.GenAnswerLS(AProgID: TProgID; NumbLic: integer; KeyVer: TKeyVer): TAnswerls;
var
  Tempstr: String;
  TempKey: integer;
  UserKey: TAnswer;
  Buffer: PByte;
  CurMd5: string;
  InetMd5: string;
  s, s1: string;
  Conn1: integer;
  Conn2: byte;
  ThPart: integer;
  ThPartTxt: string;
  TempB: PChar;
  KodInt: Integer;
  KodInt1: Integer;
  CRCKod: Integer;
  CRCTxt: string;
begin
{$if Defined(ADMIN_UA) or Defined(ADMIN_RU)}
  with TProtection.Create do
  begin
    try
      s := ProgIDToStr(AProgID);
      s := FormatForProg(s);
      s1 := Copy(s, 1, 16);
      UserKey := GenAnswer(StrToProgID(s1), KeyVer);
      try
        GetMem(TempB, 8);
        Conn1 := NumbLic;
        Conn1 := (Conn1 SHL 6) + Conn1; // 63 предел

        Conn1 :=  Conn1 XOR $1978;
        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(UserKey.Data1)));

        ThPart := (Conn1 SHL (ord(UserKey.Data1[0]) And $00000002)) Xor (KodInt And $0000ffff);

        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(UserKey.Data2)));

        ThPart := ThPart Xor (KodInt And $0000ffff);
        ThPartTxt := IntToHex(ThPart, 4);
        ThPartTxt := FormatForUser(ThPartTxt);



        KodInt1 := StrToInt('$' +  AnsiLowerCase(FormatForProg(ThPartTxt)));
        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(UserKey.Data2)));

        ThPart := KodInt1 Xor (KodInt And $0000ffff);
        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(UserKey.Data1)));

        ThPart := ThPart Xor (KodInt And $0000ffff);
        Conn1 := (ThPart SHR (ord(UserKey.Data1[0]) And $00000002));

        Conn1 := Conn1 XOR $1978;
        Conn1 := Conn1 SHR 6;
        Conn1 := Conn1 AND $0000ffff;

        CRCTxt := CRC32(UserKey.Data1 + '-' + UserKey.Data2 + '-' + FormatForProg(ThPartTxt), 1);
        CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(UserKey.Data1))), 4);
        while length(CRCTxt) < 8 do
          CRCTxt := CRCTxt + UserKey.Data1[1];
        CRCTxt := CorrectCod(CRCTxt);
        CRCTxt[1] := CrcTxt[5];
        CRCTxt[2] := CrcTxt[8];
        SetLength(CRCTxt, 4);
      finally
        FreeMem(TempB);
      end;
    finally
      Free;
    end;
  end;
  result.Data1 := UserKey.Data1;
  result.Data2 := UserKey.Data2;
  result.Data3 := ThPartTxt;
  result.Data4 := CrcTxt;
{$ifend}
end;

function TProtection.GenBaseSerial: TProgID;
begin
  //
end;

function TProtection.GenProgID: TProgID;
begin
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcBegin.inc}
  {$IFEND} 
{$IFEND}
  result := GetIDESerial;
  sleep(5);
  ProgID := result;
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcEnd.inc}
  {$IFEND} 
{$IFEND}
end;

function TProtection.RegisterProg(Answer: TAnswer): Boolean;
var
  Reg: TRegistry;
  // Tolik 21/06/2019 --
  //buff: PChar;
  buff: PAnsiChar;
  //
  TempStr: string;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStringList;
begin
  result := false;
  if NOT CheckAnswerKey(Answer) then
    exit;
  if GetOsVer < 3 then
    AProgID := ProgID
  else
    AProgID := GetIDESerial;
  result := false;
  try
    RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
  except
    if (Answer.Data1 + Answer.Data2) = (CRC32(ProgIDToStr(AProgID), CheckParity(Answer.Data1 + Answer.Data2))) then
    begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := RegRootKey;
        Reg.OpenKey(RegPath, True);
        GetMem(buff, 255);
        TempStr := Answer.Data1 + Answer.Data2;
        HexToBin(PChar(TempStr), buff, 255);
        KodInt := integer(buff[0]) shl 24 + integer(buff[1]) shl 16 + integer(buff[2]) shl 8 + integer(buff[3]);
        RegistryKod := IntToHex(KodInt, 8);
        KodInt := KodInt XOR $10091978;
        Reg.WriteInteger(RegKeyNameReg, KodInt);
        Reg.WriteBool(FirstRunKey, false);
        FreeMem(buff);
        Reg.CloseKey;
        Reg.Free;
        result := True;
      except
        try
          Reg.CloseKey;
          Reg.Free;
        finally
        end;
      end;
    end;
  end;
end;

function TProtection.GenProgID2: TProgID;
begin
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcBegin.inc}
  {$IFEND}
{$IFEND}
  result := GetIDESerial;
  sleep(5);
  ProgID := result;
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcEnd.inc}
  {$IFEND} 
{$IFEND}
end;

function TProtection.RegisterProgls(Answer: TAnswerls): Boolean;
var
  Reg: TRegistry;
  // Tolik 21/06/2019 --
  //buff: PChar;
  buff: PAnsiChar;
  //
  TempStr: string;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStringList;
  CodCRC: integer;
  CRCTxt: string;
  ListSt: TList;
  KodInt1: integer;
  Ini: TIniFile;
begin
  result := false;
  try
//    ListSt.Add(nil);
    RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
  except
    try
      CRCTxt := CRC32(Answer.Data1 + '-' + Answer.Data2 + '-' + FormatForProg(Answer.data3), 1);
      CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(Answer.Data1))), 4);
      while length(CRCTxt) < 8 do
        CRCTxt := CRCTxt + Answer.Data1[1];
      CRCTxt := CorrectCod(CRCTxt);
      CRCTxt[1] := CrcTxt[5];
      CRCTxt[2] := CrcTxt[8];
      SetLength(CRCTxt, 4);
      if CRCTxt <> Answer.Data4 then
        Answer.Data1 := '    ';
    except
      Answer.Data1 := '    ';
    end;
  end;

  if NOT CheckAnswerKeyls(Answer) then
    exit;
  if GetOsVer < 3 then
    AProgID := ProgID
  else
    AProgID := GetIDESerial;
  result := false;
  try
//    LList.Add('Ok');
    RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
  except
    if (Answer.Data1 + Answer.Data2) = (CRC32(ProgIDToStr(AProgID), CheckParity(Answer.Data1 + Answer.Data2))) then
    begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := RegRootKey;
        Reg.OpenKey(RegPath, True);
        GetMem(buff, 255);
        TempStr := Answer.Data1 + Answer.Data2;
        HexToBin(PChar(TempStr), buff, 255);
        KodInt := integer(buff[0]) shl 24 + integer(buff[1]) shl 16 + integer(buff[2]) shl 8 + integer(buff[3]);
        RegistryKod := IntToHex(KodInt, 8);
        KodInt := KodInt XOR $10091978;
        {$IF Not Defined(FLASH_SCS)}
          Reg.WriteInteger(RegKeyNameReg, KodInt);
        {$ELSE}
          try
            Ini := TIniFile.Create(GetIniPath);
            Ini.WriteInteger('REG', RegKeyNameReg, KodInt);
            Ini.Free;
          except
          end;
        {$IFEND}

        Reg.WriteBool(FirstRunKey, false);

        TempStr := Answer.Data3 + Answer.Data4;
        HexToBin(PChar(TempStr), buff, 255);
        KodInt1 := integer(buff[0]) shl 24 + integer(buff[1]) shl 16 + integer(buff[2]) shl 8 + integer(buff[3]);
        RegistryKod := IntToHex(KodInt1, 8);
        KodInt1 := KodInt1 XOR $10091978;
        {$IF Not Defined(FLASH_SCS)}
          Reg.WriteInteger(RegKeyNameReg1, KodInt1);
        {$ELSE}
          try
            Ini := TIniFile.Create(GetIniPath);
            Ini.WriteInteger('REG', RegKeyNameReg1, KodInt1);
            Ini.Free;
          except
          end;
        {$IFEND}

        FreeMem(buff);
        Reg.CloseKey;
        Reg.Free;
        result := True;
      except
        try
          Reg.CloseKey;
          Reg.Free;
        finally
        end;
      end;
    end;
  end;
end;

function TProtection.RegisterProgscs(Answer: TAnswerscs): Boolean;
var
  Reg: TRegistry;
  // Tolik 21/06/2019 --
  //buff: PChar;
  buff: PAnsiChar;
  //
  TempStr: string;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStringList;
  CodCRC: integer;
  CRCTxt: string;
  ListSt: TList;
  KodInt1: integer;
  Ini: TIniFile;
begin
  result := false;
  if GProtectionType = ltLocal then
  begin
    try
//      ListSt.Add(nil);
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      try
        CRCTxt := CRC32(Answer.Data1 + '-' + Answer.Data2 + '-' + FormatForProg(Answer.data3), 1);
        CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(Answer.Data1))), 4);
        while length(CRCTxt) < 8 do
          CRCTxt := CRCTxt + Answer.Data1[1];
        CRCTxt := CorrectCod(CRCTxt);
        CRCTxt[1] := CrcTxt[5];
        CRCTxt[2] := CrcTxt[8];
        SetLength(CRCTxt, 4);
        if CRCTxt <> Answer.Data4 then
          Answer.Data1 := '    ';
      except
        Answer.Data1 := '    ';
      end;
    end;

    if NOT CheckAnswerKeyscs(Answer) then
      exit;
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    result := false;
    try
//      LList.Add('Ok');
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      if (Answer.Data1 + Answer.Data2) = (CRC32(ProgIDToStr(AProgID), CheckParity(Answer.Data1 + Answer.Data2))) then
      begin
        Reg := TRegistry.Create;
        try
          Reg.RootKey := RegRootKey;
          Reg.OpenKey(RegPath, True);
          GetMem(buff, 255);
          TempStr := Answer.Data1 + Answer.Data2;
          HexToBin(PChar(TempStr), buff, 255);
          KodInt := integer(buff[0]) shl 24 + integer(buff[1]) shl 16 + integer(buff[2]) shl 8 + integer(buff[3]);
          RegistryKod := IntToHex(KodInt, 8);
          KodInt := KodInt XOR $10091978;
          {$IF Not Defined(FLASH_SCS)}
            Reg.WriteInteger(RegKeyNameReg, KodInt);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              Ini.WriteInteger('REG', RegKeyNameReg, KodInt);
              Ini.Free;
            except
            end;
          {$IFEND}

          Reg.WriteBool(FirstRunKey, false);

          TempStr := Answer.Data3 + Answer.Data4;
          HexToBin(PChar(TempStr), buff, 255);
          KodInt1 := integer(buff[0]) shl 24 + integer(buff[1]) shl 16 + integer(buff[2]) shl 8 + integer(buff[3]);
          RegistryKod := IntToHex(KodInt1, 8);
          KodInt1 := KodInt1 XOR $10091978;
          {$IF Not Defined(FLASH_SCS)}
            Reg.WriteInteger(RegKeyNameReg1, KodInt1);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              Ini.WriteInteger('REG', RegKeyNameReg1, KodInt1);
              Ini.Free;
            except
            end;
          {$IFEND}

          FreeMem(buff);
          Reg.CloseKey;
          Reg.Free;
          result := True;
        except
          try
            Reg.CloseKey;
            Reg.Free;
          finally
          end;
        end;
      end;
    end;
  end
  else
  begin
    try
//      ListSt.Add(nil);
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      try
        CRCTxt := CRC32(Answer.Data1 + '-' + Answer.Data2 + '-' + FormatForProg(Answer.data3), 1);
        CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(Answer.Data1))), 4);
        while length(CRCTxt) < 8 do
          CRCTxt := CRCTxt + Answer.Data1[1];
        CRCTxt := CorrectCod(CRCTxt);
        CRCTxt[1] := CrcTxt[5];
        CRCTxt[2] := CrcTxt[8];
        SetLength(CRCTxt, 4);
        if CRCTxt <> Answer.Data4 then
          Answer.Data1 := '    ';
      except
        Answer.Data1 := '    ';
      end;
    end;

    if NOT CheckAnswerKeyscs(Answer) then
      exit;
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    result := false;
    try
//      LList.Add('Ok');
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      if (Answer.Data1 + Answer.Data2) = (CRC32(ProgIDToStr(AProgID), CheckParity(Answer.Data1 + Answer.Data2))) then
      begin
        try
          TempStr := Answer.Data1 + Answer.Data2;
          TempStr := TempStr + Answer.Data3 + Answer.Data4;
          SetAnswerCodeToBase(TempStr);
          result := True;
        except
        end;
      end;
    end;
  end;
end;

function TProtection.IsRegisterProg1: Boolean;
var
  Reg: TRegistry;
  Kod: String;
  KodInt: integer;
  AProgID: TProgID;
  ListV: TStringList;
begin
  try
//    ListV.Add('0');
    RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
  except
    Reg := TRegistry.Create;
    Kod := '';
    try
      Reg.RootKey := RegRootKey;
      Reg.OpenKeyReadOnly(RegPath);
      try
        KodInt := Reg.ReadInteger(RegKeyNameReg);
        KodInt := KodInt XOR $10091978;
        Kod := IntToHex(KodInt, 8);
      except
      end;
    finally
      try
        Reg.CloseKey;
        Reg.Free;
      finally
      end;
    end;
    result := True;
    if Kod = '' then
    begin
      result := False;
      exit;
    end;
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    try
      Exception.Create('Error');
    except
      if Kod <> CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
        result := False;
    end
  end;
end;

function TProtection.CheckIsVer(CheckingVer: TKeyVer): Boolean;
var
  Reg: TRegistry;
  Kod: String;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStream;
  TempAnsw: string;
  Ini: TIniFile;
begin
  {$IF Defined(ADMIN_RU) or Defined(ADMIN_UA)}
    Result := true;
  {$ELSE}
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcBegin.inc}
  {$IFEND} 
{$IFEND}
  Result := false;
  if GProtectionType = ltLocal then
  begin
    Result := false;
    try
//      LList.Size;
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      Reg := TRegistry.Create;
      Kod := '';
      try
        Reg.RootKey := RegRootKey;
        try
          Reg.OpenKeyReadOnly(RegPath);
        except
        end;
        try
          {$IF Not Defined(FLASH_SCS)}
            KodInt := Reg.ReadInteger(RegKeyNameReg);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              KodInt := Ini.ReadInteger('REG', RegKeyNameReg, 0);
              Ini.Free;
            except
            end;
          {$IFEND}
          KodInt := KodInt XOR $10091978;
          Kod := IntToHex(KodInt, 8);
        except
          Kod := '';
        end;
      finally
        try
          Reg.CloseKey;
          Reg.Free;
        finally
        end;
      end;
      result := True;
      if Kod = '' then
      begin
        result := False;
        exit;
      end;
      if GetOsVer < 3 then
        AProgID := ProgID
      else
        AProgID := GetIDESerial;
      result := False;
      if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
      begin
        // Tolik 19/08/2019 -- так быстрее будет, потому что сначала вызывается первое условие, потом второе и т.п....
        // в данном случае происходит лишний вызов функции, т.к. CheckingVer здесь нам известно -- приходит параметром...
        if ((CheckingVer = TRIAL) AND (CheckParity(Kod) = 1)) then
          result := True;
        if ((CheckingVer = PRO) AND (CheckParity(Kod) = 0)) then
          result := True;

        //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
        //  result := True;
        //if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
        //  result := True;
      end;
    end;
  end
  else
  begin
    // From Base
    TempAnsw := GetAnswerCodeFromBase;
    TempAnsw := FormatForProg(TempAnsw);
    kod := '';
    try
      kod := copy(TempAnsw, 1, 8);
    except
    end;
    if Kod = '' then
    begin
      result := False;
      exit;
    end;
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    result := False;
    if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
    begin
      // Tolik 19/08/2019
      // то же самое..см выше
      if ((CheckingVer = TRIAL) AND (CheckParity(Kod) = 1)) then
        result := True;
      if ((CheckingVer = PRO) AND (CheckParity(Kod) = 0)) then
        result := True;

      //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
      //  result := True;
      //if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
      //  result := True;
    end;
  end;
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcEnd.inc}
  {$IFEND} 
{$IFEND}
  {$IFEND}
end;

function TProtection.CheckIsVerLic(aProgCode, aUserCode: string; CheckingVer: TKeyVer): Boolean;
var
  Reg: TRegistry;
  Kod: String;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStream;
begin
  {$IF Defined(ADMIN_RU) or Defined(ADMIN_UA)}
    Result := true;
  {$ELSE}
  Result := false;
  try
//    LList.Size;
    RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
  except
    Kod := aUserCode;
    if Kod = '' then
    begin
      result := False;
      exit;
    end;
    AProgID := StrToProgID(aProgCode);
    result := False;
    if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
    begin
      if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
        result := True;
      if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
        result := True;
    end;
  end;
  {$IFEND}
end;

function TProtection.CheckIsVer2(CheckingVer: TKeyVer; var kodm: integer): Boolean;
var
  Reg: TRegistry;
  Kod: String;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStream;
  TempAnsw: string;
  Ini: TIniFile;
begin
  {$IF Defined(ADMIN_RU) or Defined(ADMIN_UA)}
    Result := true;
    kodm := 0;
  {$ELSE}
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
    {$I Inc\DelphiCrcBegin.inc}
  {$IFEND}  
{$IFEND}
  Result := false;
  if GProtectionType = ltLocal then
  begin
    Result := false;
    kodm := strtoint(CRC32(ProgIDToStr(PROGID), 1));
    if kodm = 0 then
      kodm := 255;
    try
//      LList.Size;
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      Reg := TRegistry.Create;
      Kod := '';
      try
        Reg.RootKey := RegRootKey;
        try
          Reg.OpenKeyReadOnly(RegPath);
        except
        end;
        try
          {$IF Not Defined(FLASH_SCS)}
            KodInt := Reg.ReadInteger(RegKeyNameReg);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              KodInt := Ini.ReadInteger('REG', RegKeyNameReg, 0);
              Ini.Free;
            except
            end;
          {$IFEND}
          KodInt := KodInt XOR $10091978;
          Kod := IntToHex(KodInt, 8);
        except
          Kod := '';
        end;
      finally
        try
          Reg.CloseKey;
          Reg.Free;
        finally
        end;
      end;
      result := True;
      if Kod = '' then
      begin
        result := False;
        exit;
      end;
      if GetOsVer < 3 then
        AProgID := ProgID
      else
        AProgID := GetIDESerial;
      result := False;
      kodm := strtoint(kod) - strtoint(CRC32(ProgIDToStr(AProgID), CheckParity(Kod)));
      if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
      begin
        result := True;
        //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
        //  result := True;
        //if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
        //  result := True;
      end;
    end;
  end
  else
  begin
    // From Base
    TempAnsw := GetAnswerCodeFromBase;
    TempAnsw := FormatForProg(TempAnsw);
    kodm := strtoint(CRC32(ProgIDToStr(PROGID), 1));
    if kodm = 0 then
      kodm := 255;
    kod := '';
    try
      kod := copy(TempAnsw, 1, 8);
    except
    end;
    if Kod = '' then
    begin
      result := False;
      exit;
    end;
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    result := False;
    kodm := strtoint(kod) - strtoint(CRC32(ProgIDToStr(AProgID), CheckParity(Kod)));
    if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
    begin
      result := True;
      //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
      //  result := True;
      //if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
      //  result := True;
    end;
  end;
{$IF Not Defined(ES_GRAPH_SC)}
  {$IF Not Defined(TRIAL_SCS)}
   {$I Inc\DelphiCrcEnd.inc}
  {$IFEND} 
{$IFEND}
  {$IFEND}
end;


function TProtection.CheckIsVerls(CheckingVer: TKeyVer): Boolean;
var
  Reg: TRegistry;
  Kod: String;
  Kod2: String;
  KodInt: integer;
  AProgID: TProgID;
  LList: TStream;
  ListSt: TList;
  CRCTxt: string;
  TempB: PChar;
  ThPartTxt: string;
  KodInt1: integer;
  ThPart: integer;
  TempAnsw: string;
  Ini: TIniFile;
begin 
  {$IF Defined(ADMIN_RU) or Defined(ADMIN_UA)}
    Result := true;
    ConnCount := 63;
    ConnCount := (ConnCount SHL 6) + ConnCount;
    ConnCount := ConnCount XOR $1978;
  {$ELSE}
  Result := false;
  if GProtectionType = ltLocal then
  begin
    try
//      LList.Size;
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      Reg := TRegistry.Create; 
      Kod := '';
      Kod2 := '';
      try
        Reg.RootKey := RegRootKey;
        try
          Reg.OpenKeyReadOnly(RegPath);
        except
        end;
        try
          {$IF Not Defined(FLASH_SCS)}
            KodInt := Reg.ReadInteger(RegKeyNameReg);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              KodInt := Ini.ReadInteger('REG', RegKeyNameReg, 0);
              Ini.Free;
            except
            end;
          {$IFEND}
          KodInt := KodInt XOR $10091978;
          Kod := IntToHex(KodInt, 8);
          {$IF Not Defined(FLASH_SCS)}
            KodInt := Reg.ReadInteger(RegKeyNameReg1);
          {$ELSE}
            try
              Ini := TIniFile.Create(GetIniPath);
              KodInt := Ini.ReadInteger('REG', RegKeyNameReg1, 0);
              Ini.Free;
            except
            end;
          {$IFEND}
          KodInt := KodInt XOR $10091978;
          Kod2 := IntToHex(KodInt, 8);
        except
          Kod := '';
          Kod2 := '';
        end;
      finally
        try
          Reg.CloseKey;
          Reg.Free;
        finally
        end;
      end;
      result := True;
      if Kod = '' then
      begin
        result := False;
        ConnCount := 0;
        ConnCount := (ConnCount SHL 6) + ConnCount;
        ConnCount := ConnCount XOR $1978;
        exit;
      end; 
      if GetOsVer < 3 then
        AProgID := ProgID
      else
        AProgID := GetIDESerial;
      result := False; 

      try
        AnswerReg.Data1 := copy(kod, 1, 4);
        AnswerReg.Data2 := copy(kod, 5, 4);
        AnswerReg.Data3 := copy(kod2, 1, 4);
        AnswerReg.Data4 := copy(kod2, 5, 4);
      except
      end;
      try
//        ListSt.Add(nil);
        RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
      except
        try
          CRCTxt := CRC32(AnswerReg.Data1 + '-' + AnswerReg.Data2 + '-' + FormatForProg(AnswerReg.data3), 1);
          CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data1))), 4);
          while length(CRCTxt) < 8 do
            CRCTxt := CRCTxt + AnswerReg.Data1[1];
          CRCTxt := CorrectCod(CRCTxt);
          CRCTxt[1] := CrcTxt[5];
          CRCTxt[2] := CrcTxt[8];
          SetLength(CRCTxt, 4);
          if CRCTxt <> AnswerReg.Data4 then
          begin
            AnswerReg.Data1 := '    ';
            kod := '1612';
          end;
        except
          AnswerReg.Data1 := '    ';
          kod := '1612';
        end;
      end;

      if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
      begin
        if ((CheckParity(Kod) = 0) AND (CheckingVer = PRO))
          or ((CheckParity(Kod) = 1) AND (CheckingVer = TRIAL))
          or ((CheckParity(Kod) = 1) AND (CheckingVer = PRO)) then
        begin
          result := True;
          if ((CheckParity(Kod) = 1) AND (CheckingVer = PRO)) then
            result := False;
          GetMem(TempB, 8);
          ThPartTxt := AnswerReg.Data3;
          KodInt1 := StrToInt('$' +  AnsiLowerCase(FormatForProg(ThPartTxt)));
          KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data2)));

          ThPart := KodInt1 Xor (KodInt And $0000ffff);
          KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data1)));

          ThPart := ThPart Xor (KodInt And $0000ffff);
          ConnCount := (ThPart SHR (ord(AnswerReg.Data1[0]) And $00000002));

          FreeMem(TempB);
  //{
          ConnCount := ConnCount XOR $1978;
          ConnCount := ConnCount SHR 6;
          ConnCount := ConnCount AND $0000ffff;
          ConnCount := (ConnCount SHL 6) + ConnCount;
          ConnCount := ConnCount XOR $1978;
  //}
        end;
        //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
        //begin
        //  result := True;
        //  ConnCount := 1;
        //  ConnCount := (ConnCount SHL 6) + ConnCount;
        //  ConnCount := ConnCount XOR $1978;
        //end;
      end
      else
      begin
        ConnCount := 0;
        ConnCount := (ConnCount SHL 6) + ConnCount;
        ConnCount := ConnCount XOR $1978;
      end;
    end;
  end
  else
  begin
    // From Base
    TempAnsw := GetAnswerCodeFromBase;
    TempAnsw := FormatForProg(TempAnsw);
    kod := '';
    try
      kod := copy(TempAnsw, 1, 8);
    except
    end;

    AnswerReg.Data1 := copy(TempAnsw, 1, 4);
    AnswerReg.Data2 := copy(TempAnsw, 5, 4);
    AnswerReg.Data3 := copy(TempAnsw, 9, 4);
    AnswerReg.Data4 := copy(TempAnsw, 13, 4);

    try
//      ListSt.Add(nil);
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      try
        CRCTxt := CRC32(AnswerReg.Data1 + '-' + AnswerReg.Data2 + '-' + FormatForProg(AnswerReg.data3), 1);
        CRCTxt := IntToHex(strtoint('$' + AnsiLowerCase(FormatForProg(CRCTxt))) XOR strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data1))), 4);
        while length(CRCTxt) < 8 do
          CRCTxt := CRCTxt + AnswerReg.Data1[1];
        CRCTxt := CorrectCod(CRCTxt);
        CRCTxt[1] := CrcTxt[5];
        CRCTxt[2] := CrcTxt[8];
        SetLength(CRCTxt, 4);
        if CRCTxt <> AnswerReg.Data4 then
        begin
          AnswerReg.Data1 := '    ';
          kod := '1612';
        end;
      except
        AnswerReg.Data1 := '    ';
        kod := '1612';
      end;
    end;

    if Kod = '' then
    begin
      result := False;
      exit;
    end; 
    if GetOsVer < 3 then
      AProgID := ProgID
    else
      AProgID := GetIDESerial;
    result := False;
    if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
    begin
      if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
        result := True;
      if (CheckParity(Kod) = 0) AND (CheckingVer = PRO) then
        result := True;
    end;
    if Kod = CRC32(ProgIDToStr(AProgID), CheckParity(Kod)) then
    begin
      if ((CheckParity(Kod) = 0) AND (CheckingVer = PRO))
        or ((CheckParity(Kod) = 1) AND (CheckingVer = TRIAL))
        or ((CheckParity(Kod) = 1) AND (CheckingVer = PRO)) then
      begin
        result := True;
        if ((CheckParity(Kod) = 1) AND (CheckingVer = PRO)) then
          result := False;
        GetMem(TempB, 8);
        ThPartTxt := AnswerReg.Data3;
        KodInt1 := StrToInt('$' +  AnsiLowerCase(FormatForProg(ThPartTxt)));
        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data2)));

        ThPart := KodInt1 Xor (KodInt And $0000ffff);
        KodInt := strtoint('$' + AnsiLowerCase(FormatForProg(AnswerReg.Data1)));

        ThPart := ThPart Xor (KodInt And $0000ffff);
        ConnCount := (ThPart SHR (ord(AnswerReg.Data1[0]) And $00000002));

        FreeMem(TempB);
//{
        ConnCount := ConnCount XOR $1978;
        ConnCount := ConnCount SHR 6;
        ConnCount := ConnCount AND $0000ffff;
        ConnCount := (ConnCount SHL 6) + ConnCount;
        ConnCount := ConnCount XOR $1978;
//}
      end;
      //if (CheckParity(Kod) = 1) AND (CheckingVer = TRIAL) then
      //begin
      //  result := True;
      //  ConnCount := 1;
      //  ConnCount := (ConnCount SHL 6) + ConnCount;
      //  ConnCount := ConnCount XOR $1978;
      //end;
    end
    else
    begin
      ConnCount := 0;
      ConnCount := (ConnCount SHL 6) + ConnCount;
      ConnCount := ConnCount XOR $1978;
    end;
  end;
  {$IFEND}
end;

function TProtection.CheckAnswerKey(AnswerKey: TAnswer): BOOL;
var tempstr: string;
  i: integer;
begin
  result := True;
  tempstr := AnswerKey.Data1 + AnswerKey.Data2;
  for i := 1 to length(tempstr) do
    if Not (tempstr[i] in OkAlfaSet) then
      result := False;
end;

function TProtection.CheckAnswerKeyls(AnswerKey: TAnswerls): BOOL;
var tempstr: string;
  i: integer;
begin
  result := True;
  tempstr := AnswerKey.Data1 + AnswerKey.Data2;
  for i := 1 to length(tempstr) do
    if Not (tempstr[i] in OkAlfaSet) then
      result := False;
end;

function TProtection.CheckAnswerKeyscs(AnswerKey: TAnswerscs): BOOL;
var tempstr: string;
  i: integer;
begin
  result := True;
  tempstr := AnswerKey.Data1 + AnswerKey.Data2;
  for i := 1 to length(tempstr) do
    if Not (tempstr[i] in OkAlfaSet) then
      result := False;
end;

function GetOsVer: word;
var
  dwVersion: DWord;
  Reg: TRegistry;
  temp: string;
begin

  Result := 0;
  try
    dwVersion := GetVersion();
    if (dwVersion < $80000000) then
    begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows NT\CurrentVersion') then
        begin
          temp := Reg.ReadString('CurrentVersion');
          if temp = '4.0' then
          begin
            Result := 5;
            exit;
          end;
          temp := Reg.ReadString('ProductName');
          if temp = 'Microsoft Windows XP' then
            Result := 4
          else
            Result := 3;
        end;
      finally
        Reg.CloseKey;
        Reg.Free;
      end;
    end
    else
    begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKeyReadOnly('\SOFTWARE\Microsoft\Windows\CurrentVersion') then
        begin
          temp := Reg.ReadString('ProductName');
          if temp = 'Microsoft Windows 98' then
            Result := 1;
          if temp = 'Microsoft Windows ME' then
            Result := 2;
        end;
      finally
        Reg.CloseKey;
        Reg.Free;
      end;
    end;
  except
    Result := 0;
  end;
end;

function TProtection.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, MS_DEF_PROV, 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 TProtection.GetVolume(_drivenum:word): dword;
const
  abc = 'abcdefghijklmnopqrstuvwxyz';
var
  VolumeSerialNumber,MCL,FSF: Dword;
  temp: string;
  _os: word;
  buff: PChar;
begin
  _os := GetOsVer;
  // Tolik 21/06/2019 --
  //GetMem(buff, 255);
  GetMem(buff, 256*2);
  //
  GetSystemDirectory(buff, 255);

  if _os = 0 then
  begin
    Result := 0;
    exit;
  end;
  if _os >= 3 then
    temp := abc[_drivenum] + ':\\'
  else
    temp := abc[_drivenum] + ':\';
  try
    if GetVolumeInformation(PChar(temp),nil,0,@VolumeSerialNumber,MCL,FSF,nil,0) then
      Result := VolumeSerialNumber
    else
      Result := 0;
  except
    Result := 0;
  end;
  freemem(buff);
end;

function CorrectCod(source: string): string;
begin
  Result := FastReplace(source, 'A', '3');
  Result := FastReplace(Result, 'B', '4');
  Result := FastReplace(Result, 'C', '6');
  Result := FastReplace(Result, 'D', '1');
  Result := FastReplace(Result, 'E', '7');
  Result := FastReplace(Result, 'F', '9');
end;

function GetSerialHard: string;
var
  temps: string;
  temp: string;
  _os: dword;
  VolumeSerialNumber,MCL,FSF: Dword;
  vol: dword;
begin
  _os := GetOsVer;
  temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
  if _os >= 3 then
    temp := temps + '\\'
  else
    temp := temps + '\';
  try
    if GetVolumeInformation(PChar(temp),nil,0,@VolumeSerialNumber,MCL,FSF,nil,0) then
      vol := VolumeSerialNumber
    else
      vol := 0;
      if vol > 0 then
        Result := inttostr(vol)
      else
        Result := '3456789';
      Exit;
  except
    Result := '3456789';
  end;
end;

function TProtection.GetIDESerialOld: TProgID;
var
    Storage: TMiTeC_Storage;
  //infomem: TMachine;
  Serial: string;
  Serial2: string;
  tmpstr, tempstr2: string;
  tempstr3: string;
  tempstr4: string;
  tempstr5: string;
  i, j: integer;
begin
  Serial := '';
  Result := StrToProgID(DefaultID);
  if IDESerialG = '' then
  begin
    try
      if GetOsVer < 3 then
      begin
        Serial := getHardDriveComputerID;
//        sleep(100);
//        Serial := getHardDriveComputerID;
      end
      else
      begin
        if (ParamCount > 0) and (AnsiLowerCase(ParamStr(1)) = '/fix') then
        begin
          serial := GetSerialHard;
        end
        else
        begin
          Storage := TMiTeC_Storage.Create(nil);
          Storage.RefreshData;
          serial := '';
          serial2 := '';
          tmpstr := '';
          for i := 0 to Storage.LogicalCount - 1 do
          begin
            j := Storage.Logical[i].PhysicalIndex;
            if UpperCase(Storage.Logical[i].Drive) = UpperCase(copy(ExtractFileDrive(Application.ExeName), 1, 1)) then
            begin
              if (Storage.Physical[j].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[j].Removable) then
                tmpstr := Storage.Physical[j].SerialNumber;
              if Trim(tmpstr) <> '' then
              begin
                Serial := tmpstr;
                break;
              end;
            end;
          end;

          Storage.RefreshData;
          tmpstr := '';
          for i := 0 to Storage.LogicalCount - 1 do
          begin
            j := Storage.Logical[i].PhysicalIndex;
            if UpperCase(Storage.Logical[i].Drive) = UpperCase(copy(ExtractFileDrive(Application.ExeName), 1, 1)) then
            begin
              if (Storage.Physical[j].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[j].Removable) then
                tmpstr := Storage.Physical[j].SerialNumber;
              if Trim(tmpstr) <> '' then
              begin
                Serial2 := tmpstr;
                break;
              end;
            end;
          end;


          {for i := 0 to Storage.PhysicalCount - 1 do
          begin
            if (Storage.Physical[i].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[i].Removable) then
              tmpstr := Storage.Physical[i].SerialNumber;
            if Storage.Physical[i].Drive = copy(ExtractFileDrive(Application.ExeName), 1, 1) then
            begin
              Storage.Physical[i].
              if Trim(tmpstr) <> '' then
              begin
                Serial := tmpstr;
                break;
              end;
            end;
            //if Trim(serial) <> '' then
            //  break;
          end;
          }
          if (serial = '') or (serial <> serial2) then
          begin
            serial := GetSerialHard;
          end;
          try
            Storage.Free;
          except
          end;
        end;

        //infoMem :=  TMachine.Create;
        //if DetectWinVersion <> wvvista then
        //  if Not IsVista then
        //    infoMem.GetInfo(0);
      end;
      Serial2 := '';
      if Serial = '' then
      begin
        Serial := IntToHex(GetVolume(3), 8) + inttostr(1485) + 'EF23';
      end;
      if GetOsVer < 3 then
        Serial2 := String(Pchar(Ptr($FFFF5)))
      else
      begin
        if DetectWinVersion <> wvvista then
        begin
          //if Not IsVista then
          //  serial2 := serial2 + InfoMem.BIOS.Date
          //else
          serial2 := '01/01/01';
        end
        else
          serial2 := '01/01/01';
      end;
      Serial := BuildHash(Serial);
      tempstr2 := copy(Serial, 1, 6);
      tempstr3 := copy(Serial, 13, 4);
      tempstr4 := copy(Serial, 27, 2);
      if length(serial2) < 8 then
        serial2 := '01/01/01';
      tempstr5 := CRC32(serial2, 1);
      tempstr5 := copy(tempstr5, 5, 4);

      if tempstr2 = '' then
        tempstr2 := '6666';
      if tempstr3 = '' then
        tempstr3 := '7777';
      if tempstr4 = '' then
        tempstr4 := '8888';
      if tempstr5 = '' then
        tempstr5 := '9999';

      {$if Defined(DOCwIMAGES)}
        result := StrToProgID(CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5));
        IDESerialG := CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5);
      {$else}
        result := StrToProgID(tempstr2 + tempstr3 + tempstr4 + tempstr5);
        IDESerialG := tempstr2 + tempstr3 + tempstr4 + tempstr5;
      {$ifend}
      try
      except
      end;
    finally
    end;
  end
  else
  begin
    result := StrToProgID(IDESerialG);
  end;
//  TODO 4: for test only
//  result := StrToProgID('BB9F086EBA857CE0' + tempstr5);
end;

{ TLicenseFile }

procedure TLicenseFile.Add(License: TLicense);
var
  s: string;
begin
  {$if Defined(ADMIN_UA) or Defined(ADMIN_RU)}
    s := LicenseToStr(License);
    if Length(s) > 0 then
      FList.Add(s)
    else
      raise ELicense.Create('Неверная структура лицензии!')
  {$ifend}
end;

procedure TLicenseFile.Clear;
begin
  FList.Clear;
end;

constructor TLicenseFile.Create(FileName: string; FileMode: Word);
begin
  FFileName := FileName;
  FMode := FileMode;
  FList := TStringList.Create;
  FVersion := -1;
  if not (FileMode = fmCreate) then
    Load;
end;

procedure TLicenseFile.Delete(Index: integer);
begin
  if (Index >= 0) and (Index <= (FList.Count - 1)) then
    FList.Delete(Index);
end;

destructor TLicenseFile.Destroy;
begin
  if not(FMode = fmOpenRead) then
    Save;
  FList.Free;
  inherited;
end;

function TLicenseFile.FindLicense(AProgID: TProgID): integer;
var
  s: string;
  i: integer;
begin
  Result := -1;
  s := ProgIDToStr(AProgID);
  for i := 0 to FList.Count - 1 do
    if Pos(s, FList.Strings[i]) = 1 then
    begin
      Result := i;
      break;
    end;
end;

function TLicenseFile.GetCount: integer;
begin
  Result := FList.Count;
end;

function TLicenseFile.GetLicense(Index: integer): TLicense;
var
  s: string;
begin
  s := FList.Strings[Index];
  try
    if length(s) = 0 then
      raise ELicense.Create('');
    Result := StrToLicense(s)
  except
    raise ELicense.Create('Неверная структура лицензии!')
  end;
end;

procedure TLicenseFile.Load;
var
  FileStream: TFileStream;
  MemStream: TMemoryStream;
  TempStream: TMemoryStream;
  CRC, NewCRC: LongWord;
  Cipher: TDCP_rc4;
begin
  if not FileExists(FFileName) then
    exit;

  FileStream := TFileStream.Create(FFileName, fmOpenRead);

  try
    FileStream.Read(FVersion, SizeOf(FVersion));
    MemStream := TMemoryStream.Create;
    try
      Cipher:= TDCP_rc4.Create(nil);
      try
        {$if Defined(DOCwIMAGES)}
          {$if Defined(RUS_SI)}
            Cipher.InitStr('erobnf rhenfz',TDCP_sha1);
          {$else}
            Cipher.InitStr('pfobnf rhenfz',TDCP_sha1);
          {$ifend}
        {$else}
          Cipher.InitStr('rhenfz pfobnf',TDCP_sha1);
        {$ifend}
        Cipher.DecryptStream(FileStream, MemStream, FileStream.Size - SizeOf(Version) - SizeOf(CRC));
        Cipher.Burn;
      finally
        Cipher.Free;
      end;
      FileStream.Read(CRC, SizeOf(CRC));
      MemStream.Position := 0;
      Crc32Initialization;
      NewCRC:=Crc32Stream(MemStream,0);
      MemStream.Position := 0;

      if not(NewCRC = CRC) then
        raise ELicense.Create('Файл лицензий поврежден!');

      TempStream := TMemoryStream.Create;
      try
        UnPakStream(MemStream, TempStream);
        TempStream.Position := 0;

        FList.LoadFromStream(TempStream);
      finally
        TempStream.Free;
      end;
    finally
      MemStream.Free;
    end;
  finally
    FileStream.Free;
  end;
end;

procedure TLicenseFile.Save;
var
  FileStream: TFileStream;
  MemStream: TMemoryStream;
  TempStream: TMemoryStream;
  CRC: LongWord;
  Cipher: TDCP_rc4;
begin
  {$if Defined(ADMIN_UA) or Defined(ADMIN_RU)}
  EraseFile(FFileName);
  FileStream := TFileStream.Create(FFileName, fmCreate);
  try
    FileStream.Write(FVersion, SizeOf(FVersion));
    MemStream := TMemoryStream.Create;
    try
      FList.SaveToStream(MemStream);
      MemStream.Position := 0;
      TempStream := TMemoryStream.Create;
      try
        PakStream(MemStream, TempStream);
        TempStream.Position := 0;

        Crc32Initialization;
        CRC:=Crc32Stream(TempStream,0);
        TempStream.Position := 0;

        Cipher:= TDCP_rc4.Create(nil);
        try
          {$if Defined(DOCwIMAGES)}
            {$if Defined(RUS_SI)}
              Cipher.InitStr('erobnf rhenfz',TDCP_sha1);
            {$else}
              Cipher.InitStr('pfobnf rhenfz',TDCP_sha1);
            {$ifend}
          {$else}
            Cipher.InitStr('rhenfz pfobnf',TDCP_sha1);   // initialize the cipher
          {$ifend}
          Cipher.EncryptStream(TempStream, FileStream, TempStream.Size); // encrypt some known data
          Cipher.Burn;
        finally
          Cipher.Free;
        end;
        FileStream.Write(CRC, SizeOf(CRC));
      finally
        TempStream.Free;
      end;
    finally
      MemStream.Free;
    end;

  finally
    FileStream.Free;
  end;
  {$ifend}
end;

function TProtection.GetLicense(AProgID: string = ''): TLicense;
var
  i: integer;
begin

  with TLicenseFile.Create(ExtractFilePath(Application.ExeName) + LicenseFileName, fmOpenRead) do
  begin
    try
      if AProgID = '' then
        i := FindLicense(ProgID)
      else
        i := FindLicense(StrToProgID(AProgID));

      if i >= 0 then
        Result := License[i]
      else
        raise ELicense.Create('Лицензия не найдена');
    finally
      Free;
    end;
  end;
end;
// Tolik 21/06/2019 -- старая закомменчена -- см ниже
function CheckParity(Key: string): dword;
var
  TempStr: PByte;
  Len: integer;
  BinVal: DWord;
  i: integer;
  MASK: Dword;

begin
  GetMem(TempStr, 128);
  Len := HexToBin(PWideChar(Key), PAnsiChar(TempStr), 127);
  BinVal := TempStr^ SHL 24;
  inc(TempStr);
  BinVal := BinVal OR (TempStr^ SHL 16);
  inc(TempStr);
  BinVal := BinVal OR (TempStr^ SHL 8);
  inc(TempStr);
  BinVal := BinVal OR TempStr^;
  Dec(TempStr, 3);
  FreeMem(TempStr);
  MASK := 1;
  result := 0;
  for i := 1 to 32 do
  begin
    if (BinVal AND MASK) <> 0 then
      inc(result);
    MASK := MASK SHL 1;
  end;
  result := result mod 2;
end;
{
function CheckParity(Key: string): dword;
var
  TempStr: PByte;
  Len: integer;
  BinVal: DWord;
  i: integer;
  MASK: Dword;
begin
  GetMem(TempStr, 128);
  Len := HexToBin(PChar(Key), PChar(TempStr), 127);
  BinVal := TempStr^ SHL 24;
  inc(TempStr);
  BinVal := BinVal OR (TempStr^ SHL 16);
  inc(TempStr);
  BinVal := BinVal OR (TempStr^ SHL 8);
  inc(TempStr);
  BinVal := BinVal OR TempStr^;
  Dec(TempStr, 3);
  FreeMem(TempStr);
  MASK := 1;
  result := 0;
  for i := 1 to 32 do
  begin
    if (BinVal AND MASK) <> 0 then
      inc(result);
    MASK := MASK SHL 1;
  end;
  result := result mod 2;
end;
}
function TProtection.GenAnswer(AProgID: TProgID): TAnswer;
var
  Tempstr: String;
begin
  {$if Defined(ADMIN_UA) or Defined(ADMIN_RU)}
  TempStr := CRC32_OLD(ProgIDToStr(AProgID));
  result.Data1 := Copy(TempStr, 1, 4);
  result.Data2 := Copy(TempStr, 5, 4);
  {$ifend}
end;


{ ELicense }

constructor ELicense.Create(Msg: string; Term: boolean);
begin
  IsTerm := Term;
  inherited Create(Msg);

end;


procedure OReadPort; stdcall;
const
  ExceptionUsed = $03;
begin
  asm
    sidt IDT
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    cli
    mov dx, word ptr [ebx+6]
    shl edx, 16d
    mov dx, word ptr [ebx]
    mov [lpOldGate], edx
    mov eax, offset @@Ring0Code
    mov word ptr [ebx], ax
    shr eax, 16d
    mov word ptr [ebx+6], ax
    int ExceptionUsed
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    mov edx, [lpOldGate]
    mov word ptr [ebx], dx
    shr edx, 16d
    mov word ptr [ebx+6], dx
    ret
  @@Ring0Code:
    mov eax,cr0
    mov dx, PortAddress
    in al,dx
    mov PortValue, al
    iretd
  end;
end;

procedure OReadPort2; stdcall;
const
  ExceptionUsed = $03;
begin
  asm
    sidt IDT
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    cli
    mov dx, word ptr [ebx+6]
    shl edx, 16d
    mov dx, word ptr [ebx]
    mov [lpOldGate], edx
    mov eax, offset @@Ring0Code2
    mov word ptr [ebx], ax
    shr eax, 16d
    mov word ptr [ebx+6], ax
    int ExceptionUsed
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    mov edx, [lpOldGate]
    mov word ptr [ebx], dx
    shr edx, 16d
    mov word ptr [ebx+6], dx
    ret
  @@Ring0Code2:
    mov eax,cr0
    mov dx, PortAddress
    in ax,dx
    mov PortValue2, ax
    iretd
  end;
end;

procedure OWritePort; stdcall;
const
  ExceptionUsed = $03;
begin
  asm
    sidt IDT
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    cli
    mov dx, word ptr [ebx+6]
    shl edx, 16d
    mov dx, word ptr [ebx]
    mov [lpOldGate], edx
    mov eax, offset @@Ring0Code1
    mov word ptr [ebx], ax
    shr eax, 16d
    mov word ptr [ebx+6], ax
    int ExceptionUsed
    mov ebx, dword ptr [IDT+2]
    add ebx, 8*ExceptionUsed
    mov edx, [lpOldGate]
    mov word ptr [ebx], dx
    shr edx, 16d
    mov word ptr [ebx+6], dx
    ret
  @@Ring0Code1:
    mov eax,cr0
    mov dx, PortAddress
    mov al, portvalue
    out dx, al
    iretd
  end;
end;

function TProtection.getHardDriveComputerIDOld: string;
var Done: Boolean;
begin
  done := FALSE;
  FHardDriveSerialNumber := '';
  done := ReadDrivePortsInWin9X;
  result := FHardDriveSerialNumber;
end;

function TProtection.ReadDrivePortsInWin9XOld: Boolean;
var done, drive: integer;
  strdata: array [1..512] of char;
  nm, nn, waitLoop,index: integer;
begin
  done := 0;
  drive := 0;
   for drive := 0 to 7 do
   begin
      baseAddress := 0;   //  Base address of drive controller
      portValue := 0;
      waitLoop := 0;
      index := 0;
      case drive div 2 of
       0: baseAddress := $1f0;
       1: baseAddress := $170;
       2: baseAddress := $1e8;
       3: baseAddress := $168;
      end;
      if ((drive mod 2) = 0)then
      begin
        DevNo := 0;
      end
      else
      begin
        DevNo := 1;
      end;
      waitLoop := 50000;
      while waitLoop > 0 do
      begin
         waitLoop := waitLoop - 1;
         portValue := 0;
         PortAddress := baseAddress + 7;
         OReadPort;
//            //  drive is ready
         if ((portValue AND $40) = $40) then
           break;
//            //  previous drive command ended in error
         if ((portValue AND $01) = $01) then
           break;
      end;
      if waitLoop < 1 then
        continue;
         //  Set Master or Slave drive
      if ((drive mod 2) = 0)then
      begin
        PortValue := $A0;
        PortAddress := baseAddress + 6;
        OWritePort;
      end
      else
      begin
        PortValue := $B0;
        PortAddress := baseAddress + 6;
        OWritePort;
      end;
        PortValue := $EC;
        PortAddress := baseAddress + 7;
        OWritePort;
         //  Get drive info data
         // Wait for data ready
      waitLoop := 50000;
      while waitLoop > 0 do
      begin
        waitLoop := waitLoop - 1;
        portValue := 0;
        PortAddress := baseAddress + 7;
        OReadPort;
//            //  see if the drive is ready and has it's info ready for us
        if ((portValue AND $48) = $48) then
          break;
//            //  see if there is a drive error
        if ((portValue AND $01) = $01) then
          break;
      end;
         //  check for time out or other error
      if (waitLoop < 1) OR ((portValue AND $1) = $01) then
        continue;
//  read drive id information
      for index := 1 to 255 do
      begin
         portValue2 := 0;
         PortAddress := baseAddress;
         OReadPort2;
         diskdata[index] := PortValue2;
      end;
      nn := 1;
      nm := 9;
      while nm<21 do
      begin
        strdata[nn] := char (diskdata[nm] div 256);
        nn := nn + 1;
        strdata[nn] := char (diskdata[nm] mod 256);
        nn := nn + 1;
        nm := nm + 1;
      end;
      done := 1;
      FHardDriveSerialNumber := '';
      for nn:=5 to 25 do
      begin
        if strdata[nn] = #0 then
          break;
        FHardDriveSerialNumber := FHardDriveSerialNumber + strdata[nn];
      end;
      if pos('   ', FHardDriveSerialNumber) <> 0 then
        SetLength(FHardDriveSerialNumber, pos('   ', FHardDriveSerialNumber) - 1);
      portValue2 := diskdata[9];
      portValue := 0;
      for nn := 10 to 21 do
        if portValue2 <> diskdata[nn] then
          PortValue := 1;
      if portValue = 1 then
        break
      else
        FHardDriveSerialNumber := '';
   end;
   result := true;
end;

function TProtection.ReadDrivePortsInWin9X: Boolean;
var done, drive: integer;
  strdata: array [1..512] of char;
  nm, nn, waitLoop,index: integer;
begin
  done := 0;
  drive := 0;
   for drive := 0 to 7 do
   begin
      baseAddress := 0;   //  Base address of drive controller
      portValue := 0;
      waitLoop := 0;
      index := 0;
      case drive div 2 of
       0: baseAddress := $1f0;
       1: baseAddress := $170;
       2: baseAddress := $1e8;
       3: baseAddress := $168;
      end;
      if ((drive mod 2) = 0)then
      begin
        DevNo := 0;
      end
      else
      begin
        DevNo := 1;
      end;
      waitLoop := 70000;
      while waitLoop > 0 do
      begin
         waitLoop := waitLoop - 1;
         portValue := 0;
         PortAddress := baseAddress + 7;
         OReadPort;
//            //  drive is ready
         if ((portValue AND $40) = $40) then
           break;
//            //  previous drive command ended in error
         if ((portValue AND $01) = $01) then
           break;
      end;
      if waitLoop < 1 then
        continue;
         //  Set Master or Slave drive
      if ((drive mod 2) = 0)then
      begin
        PortValue := $A0;
        PortAddress := baseAddress + 6;
        OWritePort;
      end
      else
      begin
        PortValue := $B0;
        PortAddress := baseAddress + 6;
        OWritePort;
      end;
        PortValue := $EC;
        PortAddress := baseAddress + 7;
        OWritePort;
         //  Get drive info data
         // Wait for data ready
      waitLoop := 70000;
      while waitLoop > 0 do
      begin
        waitLoop := waitLoop - 1;
        portValue := 0;
        PortAddress := baseAddress + 7;
        OReadPort;
//            //  see if the drive is ready and has it's info ready for us
        if ((portValue AND $48) = $48) then
          break;
//            //  see if there is a drive error
        if ((portValue AND $01) = $01) then
          break;
      end;
         //  check for time out or other error
      if (waitLoop < 1) OR ((portValue AND $1) = $01) then
        continue;
//  read drive id information
      for index := 1 to 255 do
      begin
         portValue2 := 0;
         PortAddress := baseAddress;
         OReadPort2;
         diskdata[index] := PortValue2;
      end;
      nn := 1;
      nm := 9;
      while nm<21 do
      begin
        strdata[nn] := char (diskdata[nm] div 256);
        nn := nn + 1;
        strdata[nn] := char (diskdata[nm] mod 256);
        nn := nn + 1;
        nm := nm + 1;
      end;
      done := 1;
      FHardDriveSerialNumber := '';
      for nn:=5 to 25 do
      begin
        if strdata[nn] = #0 then
          break;
        FHardDriveSerialNumber := FHardDriveSerialNumber + strdata[nn];
      end;
      if pos('   ', FHardDriveSerialNumber) <> 0 then
        SetLength(FHardDriveSerialNumber, pos('   ', FHardDriveSerialNumber) - 1);
      portValue2 := diskdata[9];
      portValue := 0;
      for nn := 10 to 21 do
        if portValue2 <> diskdata[nn] then
          PortValue := 1;
      if portValue = 1 then
        break
      else
        FHardDriveSerialNumber := '';
   end;
   result := true;
end;

function TProtection.getHardDriveComputerID: string;
var
  Done: Boolean;
begin
  try
    result := '';
    done := FALSE;
    FHardDriveSerialNumber := '';
    done := ReadDrivePortsInWin9X;
    result := FHardDriveSerialNumber;
  finally
//    if length(result) < 8 then
//    begin
//      try
//        while length(result) < 8 do
//        begin
//          result := result + GetVolumeSerialNumber('C') + 'F';
//          while Pos('-', result) <> 0 do
//            Delete(result, Pos('-', result), 1);
//        end;
//        SetLength(result, 8);
//      except
//        result := 'FFFFFFFF';
//      end;
//    end;
//    SetLength(result, 8);
  end;
end;

function GetVolume(_drivenum: word): dword ;
var
  VolumeSerialNumber,MCL,FSF: Dword;
  temp: string;
  _os: word;
begin
  _os := GetOsVer;
  if _os = 0 then
  begin
    Result := 0;
    exit;
  end;
  if _os >= 3 then
    temp := abc[_drivenum] + ':\\'
  else
    temp := abc[_drivenum] + ':\';
  try
    if GetVolumeInformation(PChar(temp),nil,0,@VolumeSerialNumber,MCL,FSF,nil,0) then
      Result := VolumeSerialNumber
    else
      Result := 0;
  except
    Result := 0;
  end;
end;

function TProtection.GetNSerial8: string;
var
  //Info1: TIDE;
  Storage: TMiTeC_Storage;
  serial2, tmpstr, serial: string;
  i, FixDiskA, FixDisk, FixDiskP: integer;
  LoadDisk: char;
  Buff: PChar;
  SysDiskModel: string;
  SerialI: string;
  j,k: integer;
begin 
  j := 0;
  result := '';
  serial := '';
//  try
//    while length(serial) < 8 do
//    begin
//      loglist.Add(DateTimeToStr(Now) +  ': Get serial C...');
//      serial := serial + GetVolumeSerialNumber('C') + 'F';
//      serial := serial + inttostr(GetVolume(3));
//      loglist.Add(DateTimeToStr(Now) +  ': Serial C: ' + serial);
//      while Pos('-', serial) <> 0 do
//        Delete(serial, Pos('-', serial), 1);
//    end;
//    SetLength(serial, 8);
//  except
//    serial := 'FFFFFFFF';
//  end;

//  result := serial;
//  loglist.Add(DateTimeToStr(Now) +  ': Exit Serial: ' + result);
//  exit;


  try
    // Tolik 20/06/2019 --
    //GetMem(Buff, 255);
    GetMem(Buff, 256*2);
    //
    GetSystemDirectory(Buff, 250);
    LoadDisk := Buff[0];
    FreeMem(Buff);
    SysDiskModel := 'FFFF';

    if ((GetKeyState(VK_SHIFT) AND $80) = $80) and ((GetKeyState(VK_LCONTROL) AND $80) = $80) then
    begin
      serial := inttostr(GetVolume(3));
    end
    else
    begin
      if (ParamCount > 0) and (AnsiLowerCase(ParamStr(1)) = '/fix') then
      begin
        serial := GetSerialHard;
      end
      else
      begin
        Storage := TMiTeC_Storage.Create(nil);
        Storage.RefreshData;
        serial := '';
        serial2 := '';
        tmpstr := '';
        for i := 0 to Storage.LogicalCount - 1 do
        begin
          j := Storage.Logical[i].PhysicalIndex;
          if UpperCase(Storage.Logical[i].Drive) = UpperCase(copy(ExtractFileDrive(Application.ExeName), 1, 1)) then
          begin
            if (Storage.Physical[j].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[j].Removable) then
              tmpstr := Storage.Physical[j].SerialNumber;
            if Trim(tmpstr) <> '' then
            begin
              Serial := tmpstr;
              break;
            end;
          end;
        end;

        Storage.RefreshData;
        tmpstr := '';
        for i := 0 to Storage.LogicalCount - 1 do
        begin
          j := Storage.Logical[i].PhysicalIndex;
          if UpperCase(Storage.Logical[i].Drive) = UpperCase(copy(ExtractFileDrive(Application.ExeName), 1, 1)) then
          begin
            if (Storage.Physical[j].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[j].Removable) then
              tmpstr := Storage.Physical[j].SerialNumber;
            if Trim(tmpstr) <> '' then
            begin
              Serial2 := tmpstr;
              break;
            end;
          end;
        end;


        {for i := 0 to Storage.PhysicalCount - 1 do
        begin
          if (Storage.Physical[i].DeviceType = FILE_DEVICE_DISK) and Not (Storage.Physical[i].Removable) then
            tmpstr := Storage.Physical[i].SerialNumber;
          if Storage.Physical[i].Drive = copy(ExtractFileDrive(Application.ExeName), 1, 1) then
          begin
            Storage.Physical[i].
            if Trim(tmpstr) <> '' then
            begin
              Serial := tmpstr;
              break;
            end;
          end;
          //if Trim(serial) <> '' then
          //  break;
        end;
        }
        if (serial = '') or (serial <> serial2) then
        begin
          serial := GetSerialHard;
        end;
        try
          Storage.Free;
        except
        end;
      end;
  //    while length(serial) < 8 do
  //    begin
  //      serial := serial + GetVolumeSerialNumber('C') + 'F';
  //      while Pos('-', serial) <> 0 do
  //        Delete(serial, Pos('-', serial), 1);
  //    end;
  //    SetLength(serial, 8);
    end;
  finally
    try
//      k := round(1/j);
      RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
    except
      result := serial;
    end;
  end;
end;

{$IF Defined(FLASH_SCS)}
function CRC32F(SrcStr: string; Parity: DWORD): dword;
var
  i: integer;
  CheckSumm: dword;
  strl: integer;
  TempRes: Dword;
  MASK: Dword;
  TmpStr: PChar;
  BufS: integer;
  resstr: string;
begin
  CheckSumm := 0;
  strl := length(SrcStr);
  i := 1;
  while i <= strl do
  begin
    CheckSumm := HiWord(CheckSumm) + (CheckSumm XOR ord(SrcStr[i])) + ord(SrcStr[i]);
    CheckSumm := CheckSumm SHL 8;
    i := i + 1;
    if i <= strl then
    begin
      CheckSumm := CheckSumm + (LoWord(CheckSumm) XOR ord(SrcStr[i]));
      CheckSumm := CheckSumm + ord(SrcStr[i]) * ord(SrcStr[i]);
    end;
    i := i + 1;
  end;
  TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $528;
  result := TempRes;
end;

function CRC32P1(SrcStr: string; Parity: DWORD): dword;
var
  i: integer;
  CheckSumm: dword;
  strl: integer;
  TempRes: Dword;
  MASK: Dword;
  TmpStr: PChar;
  BufS: integer;
  resstr: string;
begin
  CheckSumm := 0;
  strl := length(SrcStr);
  i := 1;
  while i <= strl do
  begin
    CheckSumm := HiWord(CheckSumm) + (CheckSumm XOR ord(SrcStr[i])) + ord(SrcStr[i]);
    CheckSumm := CheckSumm SHL 8;
    i := i + 1;
    if i <= strl then
    begin
      CheckSumm := CheckSumm + (LoWord(CheckSumm) XOR ord(SrcStr[i]));
      CheckSumm := CheckSumm + ord(SrcStr[i]) * ord(SrcStr[i]);
    end;
    i := i + 1;
  end;
  TempRes := (HiWord(CheckSumm) SHL 16) + LoWord(CheckSumm) XOR $315;
  result := TempRes;
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, MS_DEF_PROV, 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;

procedure DecryptStream(aInStream: TMemoryStream; var aOutStream: TMemoryStream);
var
  CRC, NewCRC: LongWord;
  Cipher: TDCP_rc4;
begin
  Cipher:= TDCP_rc4.Create(nil);
  try
    Cipher.InitStr('trcgthn',TDCP_sha1);
    Cipher.DecryptStream(aInStream, aOutStream, aInStream.Size - SizeOf(CRC));
    Cipher.Burn;
   finally
     Cipher.Free;
   end;
   aInStream.Read(CRC, SizeOf(CRC));
   aOutStream.Position := 0;
   Crc32Initialization;
   NewCRC:=Crc32Stream(aOutStream,0);
   aOutStream.Position := 0;
   if not(NewCRC = CRC) then
   begin
     aOutStream.SetSize(0);
   end;
end;
{$IFEND}


function CheckProt2: dword;
var
  TempS: string;
  TempCRC: Dword;
  TempStream: TMemoryStream;
  CrStream: TMemoryStream;
  i: integer;
  templen: integer;
  temps1: string[255];
  // Tolik 21/06/2019 --
  //TempBuff: PChar;
  TempBuff: PAnsiChar;
  //
begin
  result := 0;
  {$IF Defined(FLASH_SCS)}
    try
      result := 132;
      temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
      temps := GetDEVID(temps);
      if (temps = '') and IsRemoveableUSBHard(copy(ExtractFileDir(Application.ExeName), 1, 2)) then
      begin
        temps := GetDEVIDOther(copy(ExtractFileDir(Application.ExeName), 1, 2));
        temps := copy(temps, pos('&rev', temps), pos('{', temps) - pos('&rev', temps) - 1);
        temps := FastReplace(temps, '#', '\');
      end;

{
      temps := copy(temps, 1, pos('#{', temps));
      if temps = '' then
        temps := '9';
      TempCRC := CRC32P(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + BuildHash(temps);
      templen := length(temps);
}
      if temps = '' then
        temps := '9';
      TempCRC := CRC32F(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + '-' + BuildHash(temps);
      templen := length(temps);
      try
        TempStream := TMemoryStream.Create;
        CrStream := TMemoryStream.Create;
        CrStream.LoadFromFile(GetExeDir + '\scs.dll');
        CrStream.Position := 0;

        DecryptStream(CrStream, TempStream);

        TempStream.Position := 0;

        GetMem(TempBuff, TempStream.Size);
        TempStream.ReadBuffer(TempBuff^, TempStream.Size);
        temps1 := copy(TempBuff, 1, TempStream.Size);
        if Length(temps) = Length(temps1) then
        begin
          result := 0;
          for i := 1 to Length(temps1) do
            result := result + (ord(temps[i]) - ord(temps1[i]));
        end;
      finally
        FreeMem(TempBuff);
        TempStream.Free;
        CrStream.Free;
      end;
    except
    end;
  {$IFEND}
end;

// Tolik 24/06/2019 --
function CheckProt: dword;
var
  TempS: string;
  TempCRC: Dword;
  TempStream: TMemoryStream;
  CrStream: TMemoryStream;
  i: integer;
  templen: integer;
  temps1: string[255];
  //Tolik 24/06/2019 - -
  //TempBuff: PChar;
  TempBuff: PAnsiChar;
  TTemps: AnsiString;
  ssize: integer;
  //
begin
  result := 0;
  {$IF Defined(FLASH_SCS)}
    try
      result := 132;
      temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
      temps := GetDEVID(temps);
      if (temps = '') and IsRemoveableUSBHard(copy(ExtractFileDir(Application.ExeName), 1, 2)) then
      begin
        temps := GetDEVIDOther(copy(ExtractFileDir(Application.ExeName), 1, 2));
        temps := copy(temps, pos('&rev', temps), pos('{', temps) - pos('&rev', temps) - 1);
        temps := FastReplace(temps, '#', '\');
      end;
{
      temps := copy(temps, 1, pos('#{', temps));
      if temps = '' then
        temps := '9';
      TempCRC := CRC32P(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + BuildHash(temps);
      templen := length(temps);
}
      if temps = '' then
        temps := '9';
      TempCRC := CRC32F(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + '-' + BuildHash(temps);
      templen := length(temps);
      TTemps := temps; // Tolik 24/06/2019
      try
        TempStream := TMemoryStream.Create;
        CrStream := TMemoryStream.Create;
        CrStream.LoadFromFile(GetExeDir + '\scs.dll');
        ssize := CrStream.size;
        CrStream.Position := 0;

        DecryptStream(CrStream, TempStream);

        ssize := TempStream.size;
        TempStream.Position := 0;

        GetMem(TempBuff, TempStream.Size);
        TempStream.ReadBuffer(TempBuff^, TempStream.Size);
        temps1 := copy(TempBuff, 1, TempStream.Size);
        if Length(temps) = Length(temps1) then
        begin
          result := 0;
          for i := 1 to Length(temps1) do
            //result := result + (ord(temps[i]) - ord(temps1[i]));
            result := result + (ord(TTemps[i]) - ord(temps1[i]));
        end;
      finally
        FreeMem(TempBuff);
        TempStream.Free;
        CrStream.Free;
      end;
    except
    end;
  {$IFEND}
end;
(*
function CheckProt: dword;
var
  TempS: string;
  TempCRC: Dword;
  TempStream: TMemoryStream;
  CrStream: TMemoryStream;
  i: integer;
  templen: integer;
  temps1: string[255];
  TempBuff: PChar;
begin
  result := 0;
  {$IF Defined(FLASH_SCS)}
    try
      result := 132;
      temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
      temps := GetDEVID(temps);
      if (temps = '') and IsRemoveableUSBHard(copy(ExtractFileDir(Application.ExeName), 1, 2)) then
      begin
        temps := GetDEVIDOther(copy(ExtractFileDir(Application.ExeName), 1, 2));
        temps := copy(temps, pos('&rev', temps), pos('{', temps) - pos('&rev', temps) - 1);
        temps := FastReplace(temps, '#', '\');
      end;
{
      temps := copy(temps, 1, pos('#{', temps));
      if temps = '' then
        temps := '9';
      TempCRC := CRC32P(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + BuildHash(temps);
      templen := length(temps);
}
      if temps = '' then
        temps := '9';
      TempCRC := CRC32F(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + '-' + BuildHash(temps);
      templen := length(temps);
      try
        TempStream := TMemoryStream.Create;
        CrStream := TMemoryStream.Create;
        CrStream.LoadFromFile(GetExeDir + '\scs.dll');
        CrStream.Position := 0;

        DecryptStream(CrStream, TempStream);

        TempStream.Position := 0;

        GetMem(TempBuff, TempStream.Size);
        TempStream.ReadBuffer(TempBuff^, TempStream.Size);
        temps1 := copy(TempBuff, 1, TempStream.Size);
        if Length(temps) = Length(temps1) then
        begin
          result := 0;
          for i := 1 to Length(temps1) do
            result := result + (ord(temps[i]) - ord(temps1[i]));
        end;
      finally
        FreeMem(TempBuff);
        TempStream.Free;
        CrStream.Free;
      end;
    except
    end;
  {$IFEND}
end;
*)

function CheckProt1: dword;
var
  TempS: string;
  TempCRC: Dword;
  TempStream: TMemoryStream;
  CrStream: TMemoryStream;
  i: integer;
  templen: integer;
  temps1: string[255];
  // Tolik  24/06/2019 --
  //TempBuff:PChar;
  TempBuff:PAnsiChar;
  //
begin
  result := 0;
  {$IF Defined(FLASH_SCS)}
    try
      result := 132;
      temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
      temps := GetDEVID(temps);
      if (temps = '') and IsRemoveableUSBHard(copy(ExtractFileDir(Application.ExeName), 1, 2)) then
      begin
        temps := GetDEVIDOther(copy(ExtractFileDir(Application.ExeName), 1, 2));
        temps := copy(temps, pos('&rev', temps), pos('{', temps) - pos('&rev', temps) - 1);
        temps := FastReplace(temps, '#', '\');
      end;
{
      temps := copy(temps, 1, pos('#{', temps));
      if temps = '' then
        temps := '9';
      TempCRC := CRC32P(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + BuildHash(temps);
      templen := length(temps);
}
      if temps = '' then
        temps := '9';
      TempCRC := CRC32F(temps, 1);
      temps := inttostr(TempCRC) + temps;
      temps := temps + '-' + BuildHash(temps);
      templen := length(temps);
      try
        TempStream := TMemoryStream.Create;
        CrStream := TMemoryStream.Create;
        CrStream.LoadFromFile(GetExeDir + '\scs.dll');
        CrStream.Position := 0;

        DecryptStream(CrStream, TempStream);

        TempStream.Position := 0;

        GetMem(TempBuff, TempStream.Size);
        TempStream.ReadBuffer(TempBuff^, TempStream.Size);
        temps1 := copy(TempBuff, 1, TempStream.Size);
        if Length(temps) = Length(temps1) then
        begin
          result := 0;
          for i := 1 to Length(temps1) do
            result := result + (ord(temps[i]) - ord(temps1[i]));
        end;
      finally
        FreeMem(TempBuff);
        TempStream.Free;
        CrStream.Free;
      end;
    except
    end;
  {$IFEND}
end;

function GetUSBSerial: string;
var
  temps: string;
  temp: string;
  _os: dword;
  VolumeSerialNumber,MCL,FSF: Dword;
  vol: dword;
begin
  _os := GetOsVer;
  temps := copy(ExtractFileDir(Application.ExeName), 1, 2);
  if _os >= 3 then
    temp := temps + '\\'
  else
    temp := temps + '\';
  try
    if GetVolumeInformation(PChar(temp),nil,0,@VolumeSerialNumber,MCL,FSF,nil,0) then
      vol := VolumeSerialNumber
    else
      vol := 0;
      if vol > 0 then
        Result := inttostr(vol)
      else
        Result := '9876543';
      Exit;
  except
    Result := '9876543';
  end;
end;

function TProtection.GetIDESerial: TProgID;
var
  Serial: string;
  Serial2: string;
  tempstr2: string;
  tempstr3: string;
  tempstr4: string;
  tempstr5: string;
begin
  if GProtectionType = ltLocal then
  begin
    Serial := '';
    Result := StrToProgID(DefaultID);
    if IDESerialG = '' then
    begin
      try
        //infoMem := TMachine.Create;
        //if DetectWinVersion <> wvvista then
        //  if Not IsVista then
        //    infoMem.GetInfo(0);
        if GetOsVer < 3 then
        begin
          Serial := getHardDriveComputerID;
        end
        else
        begin
          Serial := GetNSerial8;
        end;
        Serial2 := '';
        if Serial = '' then
        begin
          Serial := IntToHex(GetVolume(3), 8) + inttostr(1485) + 'EF23';
        end;
        if GetOsVer < 3 then
        begin
          try
            Serial2 := String(Pchar(Ptr($FFFF5)))
          except
            serial2 := '01/01/01';
          end;
        end
        else
        begin
  //        serial2 := serial2 + '01/01/05';
          if DetectWinVersion <> wvvista then
          begin
            //if Not IsVista then
            //  serial2:=serial2 + InfoMem.BIOS.Date
            //else
            serial2 := '01/01/01';
          end
          else
            serial2 := '01/01/01';
        end;
        {$IF Defined(FLASH_SCS)}
          Serial := GetUSBSerial;
          serial2 := '01/01/01';
        {$IFEND}

        Serial := BuildHash(Serial);
        {$IF Defined(PROCAT_SCS)}
          tempstr3 := copy(Serial, 6, 6);
          tempstr2 := copy(Serial, 13, 4);
          tempstr4 := copy(Serial, 23, 2);
        {$ELSE}
          tempstr3 := copy(Serial, 1, 6);
          tempstr2 := copy(Serial, 13, 4);
          tempstr4 := copy(Serial, 27, 2);
        {$IFEND}  
        if length(serial2) < 8 then
          serial2 := '01/01/01';
        tempstr5 := CRC32(serial2, 1);
        tempstr5 := copy(tempstr5, 5, 4);

        if tempstr2 = '' then
          tempstr2 := '6666';
        if tempstr3 = '' then
          tempstr3 := '7777';
        if tempstr4 = '' then
          tempstr4 := '8888';
        if tempstr5 = '' then
          tempstr5 := '9999';

        {$IF Defined(OEM_NIKOMAX)}
          tempstr5 := '8' + copy(tempstr5, 2, 2) + '8';
        {$ELSE}
          {$IF Defined(PROCAT_SCS)}
            tempstr5 := 'A' + copy(tempstr5, 2, 2) + 'A';
          {$ELSE}
            tempstr5 := '6' + copy(tempstr5, 2, 2) + '6';
          {$IFEND}
        {$IFEND}  

        {$if Defined(FINAL_SCS)}
          result := StrToProgID(CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5));
          IDESerialG := CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5);
        {$else}
          result := StrToProgID(tempstr2 + tempstr3 + tempstr4 + tempstr5);
          IDESerialG := tempstr2 + tempstr3 + tempstr4 + tempstr5;
        {$ifend}
        try
          //infomem.Free;
        except
        end;
      finally
      end;
    end
    else
    begin
      result := StrToProgID(IDESerialG);
    end;
  end
  else
  begin
    serial := GetStrFromRegistry(pnServerNameNB, '');
    if Serial = '' then
      exit;
    serial2 := AnsiLowerCase(GetStrFromRegistry(pnLocalPathToNB, ''));
    if Serial2 = '' then
      exit;

    serial := GetMACAddrFromIP(GetIPAddressFromName(serial));

    if serial = '' then
      exit;

    Serial := BuildHash(Serial + serial2);
    tempstr3 := copy(Serial, 1, 6);
    tempstr2 := copy(Serial, 13, 4);
    tempstr4 := copy(Serial, 27, 2);
    if length(serial2) < 8 then
      serial2 := '01/01/01';
    tempstr5 := CRC32(serial2, 1);
    tempstr5 := copy(tempstr5, 5, 4);

    if tempstr2 = '' then
      tempstr2 := '6666';
    if tempstr3 = '' then
      tempstr3 := '7777';
    if tempstr4 = '' then
      tempstr4 := '8888';
    if tempstr5 = '' then
      tempstr5 := '9999';

    {$IF Defined(OEM_NIKOMAX)}
      tempstr5 := '7' + copy(tempstr5, 2, 2) + '7';
    {$ELSE}
      {$IF Defined(PROCAT_SCS)}
        tempstr5 := '5' + copy(tempstr5, 2, 2) + '5';
      {$ELSE}
        tempstr5 := '1' + copy(tempstr5, 2, 2) + '1';
      {$IFEND}
    {$IFEND}

    {$if Defined(FINAL_SCS)}
      result := StrToProgID(CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5));
      IDESerialG := CorrectCod(tempstr2) + CorrectCod(tempstr3) + CorrectCod(tempstr4) + CorrectCod(tempstr5);
    {$else}
      result := StrToProgID(tempstr2 + tempstr3 + tempstr4 + tempstr5);
      IDESerialG := tempstr2 + tempstr3 + tempstr4 + tempstr5;
    {$ifend}
  end;

end;

function TProtection.GetConnCount: integer;
begin
  result := ConnCount;
end;

initialization
{
  ProgProtection := TProtection.Create;
  ProgID := ProgProtection.GenProgID;
}
finalization
{
  ProgProtection.Free;
  }
end.