expertcad/SRC/Protection/U_Protection.pas
2025-05-12 10:07:51 +03:00

3524 lines
94 KiB
ObjectPascal

// Íóæíûå êîìïîíåíòû:
// 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.