{**************************************************************************
 ***                                                                    ***
 ***                      ANTI PIRACY PROCEDURES                        ***
 ***                                                                    ***
 **************************************************************************}
{$I compflgs}
{The new anti-piracy was required to allow for not being able to ring SBS
at the moment the code appears - eg in dear old Kenya where the phones are
so bad, but also as a convenience for the UK.  The code would have to be
constant, but different for each machine.  This is what is generated by
GetUniqueCode{}

{Method 1:
A handily available and rarely changed one is the hard disk serial number.
This has to be modified with the trial start date, so that if someone calls
for an extension, their code also changes.  The hard disk + date combination
is returned in the function GetUniqueCode.
However, the hard disk number is different depending on how it is accessed -
and which operating system is used to access it, so switching op systems can
cause the trial to restart.

Method 2:
Generate a random number on the first occasion.  This means moving the data
from computer to computer will not trigger the anti piracy, just people
attempting to install a new version on a new machine

---- Displayed Code -----
The code then has to be presented on the screen for the user to send to us.
For consistency with the old method, and reasonably easy use, it is presented
in two parts as two byte numbers.  This is done in the UniqueCode2UserCode
method.

--- Release code -----
The user release-code entry then needs to be validated.  ReleaseCodeValid tests
the string given, and returns a byte relating to the rcxxx constants
below

The two bytes reflect two purposes - the first is whether to extend/release
the licence, the second specifies the number of licences.{}

unit APiracy;

INTERFACE

uses Dattime;

procedure AntiPiracy;
procedure CheckBomb(BombDate : string);
function AskForReleaseCode : word;  {returns OK/Cancel}

IMPLEMENTATION

uses	windos,
			{$IFDEF Windows}
				winapp, winmsgs,
				winfiles,
			{$ELSE}
				tui, tuiapp, app, views, tuimsgs, tuiedit, dialogs,
				dosutils,
			{$ENDIF}
			strings,
			objects,
			global,
			help,
			status, {for number of terminals}
			kamsetup, {for hd number}
			tasks, {for registering start-up task}
			minilib;


const
	MaxNumEntries = 300; {maximum number of entries allowe during trial period}

	siSecurity = 'SECURITY';

	rcInvalid = $00;
	rcExtend  = $01;
	rcValid   = $02;

{	rcInvalid 		= $00;{}
	rcSingleUser 	= $10;
	rcMultiUser2	= $20;
	rcMultiUser5  = $50;
	rcMultiUser10 = $A0;



{*************************************************
 **               MAKE UP UNIQUE CODE          ***
 *************************************************}
{Unique for this computer and this trial date}
{Returns word}
function GetUniqueCode : word;
var	L : longint;
		Date : TDate;
		Vol, FileSys : PChar;
		SerialNumber : longint;
		Drive : Char;
		W : word;

begin
	{--- Method 1 -------}

	{work out which drive to test ID of}
{	if Copy(DataPath,2,1)=':' then
		Drive := DataPath[1] {get first char of datapath}
{	else
		Drive := '@';

	GetDiskInfo(Drive,SerialNumber, Vol, FileSys); {default drive}
{	ProgramStatus.GetTrialStart(Date);
{$Q-} {overflow checking off, so that this works if negative}
{	L := 	TLongWord(SerialNumber).hi
			+ TLongWord(SerialNumber).Lo
			+ Date.Day
			+ Date.Month
			+ Date.Year;
	if L>65535 then L := L - 65535;
	GetUniqueCode := L;
{DebugNote('Get Unique code '+N2Str(L)+' Ser No:'+N2Str(SerialNumber));{}
{	StrDispose(Vol);
	StrDispose(FileSys);

	{--- Method 2 -------}
	W := ProgramStatus.GetWordAt(52);

	if W = 0 then begin
		{Generate initial random number}
		Randomize;
		W := random(65500);

		ProgramStatus.SetWordAt(52, W);
		ProgramStatus.SetTrialStart(Today); {for upgrades}
	end;

	GetUniqueCode := W;
end;


{****************************************************
 ***             USER DISPLAY OF UNIQUE CODE      ***
 ****************************************************}
function UserCode(const UniqueCode : word) : string;
begin
	UserCode := PadZero(N2Str(hi(UniqueCode)),2)
							+'/'
							+PadZero(N2Str(lo(UniqueCode)),2);
end;

{****************************************************
 ***             UNIQUE CODE VALID                ***
 ****************************************************}
{eg if unique code is from HD number, will need to compare Status HD with
one above}
function UniqueCodeValid : boolean;
begin
	UniqueCodeValid := (GetUniqueCode = ProgramStatus.GetUniqueCode);
end;

{****************************************************
 ***             VALIDATE  PASSWORD               ***
 ****************************************************}
function ReleaseCodeValid(const ReleaseCode : string; const UniqueCode : word) : byte;
var RC1,RC2 : string;
		Code1,Code2 : byte;
		Valid : byte;

begin
	{extract ReleaseCode parts}
	RC1 := Copy(ReleaseCode,1,pos('/',ReleaseCode)-1); {extract first part}
	RC2 := Copy(ReleaseCode,pos('/', ReleaseCode)+1,length(ReleaseCode)); {extract second part}

	{extract code parts}
	Code1 := hi(UniqueCode);
	Code2 := lo(UniqueCode);

	{coding is as follows:
		RC1: Extend add 1, convert add 2, then convert to hex
		RC2: Add number of users allowed, then convert to hex}

	Valid := rcInvalid;

	if RC1=hex(Code1+1) then Valid := rcExtend;
	if RC1=hex(Code1+2) then Valid := rcValid;

	if RC2=hex(Code2+1) then Valid := Valid or rcSingleUser;
	if RC2=hex(Code2+2) then Valid := Valid or rcMultiUser2;
	if RC2=hex(Code2+5) then Valid := Valid or rcMultiUser5;
	if RC2=hex(Code2+10) then Valid := Valid or rcMultiUser10;

	ReleaseCodeValid := Valid;
end;


const
	liValid 	= 0;
	liOnTrial = 1;
	liInvalid = 2; {passed the sell by date/too many terminals/etc}

function LicenceValid : byte;
var StartDate : TDate;
begin
	if UniqueCodeValid then
		LicenceValid := liValid
	else begin
		ProgramStatus.GetTrialStart(StartDate);

		{blank, ie new status field,
		or date of installation later than today... odd, someone messing with dates,
		need to stop someone installing the system "in 1999" and running till then}
		if StartDate.Blank or (StartDate.Days>Today.Days) then begin
			StartDate.SetToToday;
			ProgramStatus.SetTrialStart(StartDate);
		end;

		if (ProgramStatus.GetNumEntries>MaxNumEntries)
		 or (Today.Days>(StartDate.Days+30))
		 or ((ProgramStatus.GetMaxUsers>0) and (ProgramStatus.NumTerminalsRunning>ProgramStatus.GetMaxUsers)) then
			LicenceValid := liInvalid
		else
			LicenceValid := liOnTrial;
	end;
end;


{****************************************************
 ***         PASSWORDED/CODE PROTECTION           ***
 ****************************************************}
type
	PInputReleaseCode = ^TInputReleaseCode;
	TInputReleaseCode = object(TInputELine)
		UniqueCode : word;
		constructor Init(R : TRect; NFieldLen : byte; NCode : word);
		function Valid(Command : word) : boolean; virtual;
	end;

constructor TInputReleaseCode.Init;
begin
	inherited Init(R, NFieldLen);
	UniqueCode := NCode;
	UpperCase := True;
	HelpCtx := hcReleaseCodeField;
end;

{================ VALIDATE PASSWORD ENTERED =====================}
function TInputReleaseCode.Valid;
var	V : boolean;
		rcType : word;

begin
	V := inherited Valid(Command);

	if V and (Command<>cmCancel) then begin

		if delspace(Data^)<>'' then begin

			rcType := ReleaseCodeValid(Data^,GetUniqueCode);

			case rcType and $0F of
				rcInvalid : begin
					V := False;
					InputWarning('Incorrect Release Code',hcAntiPiracy);
				end;
				rcValid :
					if rcType and $F0 = rcInvalid then begin
						V := False;
						InputWarning('Incorrect Release Code',hcAntiPiracy);
					end;
			end;
		end else begin
			{----- No password entered ---------------------}
			{check to see if still in valid trialdate}
			if LicenceValid=liInvalid then begin
				V := False;
				Focus;
				InputWarning('Release Code Required', hcAntiPiracy);
			end;

		end;

	end; {if V...}

	Valid := V;
end;

{************************************************************************
 ***                                                                  ***
 ***                  DO START-UP SECURITY CHECK                      ***
 ***                                                                  ***
 ************************************************************************}


procedure AntiPiracy;
var Control : word;
begin
	ThinkingOn('Checking Anti-Piracy');
	Today.SetToToday;

	{check for blank status/hd changed, or too many users, or too many entries}
	if LicenceValid<>liValid then begin
		Control := AskForReleaseCode;

		if Control=cmCancel then begin
			ShutDownLogOff;
			halt(0);
		end;
	end;


	ThinkingOff;
end;


function AskForReleaseCode;
var	StartDate : TDate;
		EditBox : PEditBox;
		R : TRect;
		NewMaxUsers : word;
		S : String;
		Control,I,rcType : word;

begin
		{====== LICENCE BREACH ======}
		ProgramStatus.GetTrialStart(StartDate); {valid startdate done in licencevalid method}

		ProgramStatus.SetNumEntries(ProgramStatus.GetNumEntries+1);

		{=== WORK OUT TYPE OF LICENCE BREACH ======}
		S := '';
		if (ProgramStatus.GetMaxUsers>0) and (ProgramStatus.NumTerminalsRunning>ProgramStatus.GetMaxUsers) then begin
			{---- too many users -------}
			S := N2Str(ProgramStatus.NumTerminalsRunning)+' users already on (Term ';
			for I := 1 to MaxLockTerminals do
				if ProgramStatus.GetWhoAtTerminal(I)<>-1 then S := S + N2Str(I)+', ';
			S := Copy(S,1,length(S)-1)+')'+#13#10; {chop off last comma}
			S := S + 'Licence is only for '+N2Str(ProgramStatus.GetMaxUsers)+' users'
		end else
			{---- check for trialling ------------}
			if StartDate.Days<(Today.Days-30) then
				S := 'Trial period has expired'
			else
				if ProgramStatus.GetNumEntries>MaxNumEntries then
					S := 'Trial expired: Used over '+N2Str(MaxNumEntries)+' times'
				else
					S := 'On Trial, '+N2Str(StartDate.Days+30-Today.Days)+' days left';

	{==== RELEASE CODE BOX =======}
	R.Assign(0,0,41,12); New(EditBox, init(R, 'LICENCE RELEASE CODE',nil));
	with EditBox^ do begin
		HelpCtx := hcAntiPiracy;
		Options := Options or ofCentered;
		InsTextCX(EditBox, 2, GetLine(S,1));
		InsTextCX(EditBox, 3, GetLine(S,2));
		InsTextCX(EditBox, 4, 'Contact SBS with the following code:');
		InsTextCX(EditBox, 5, UserCode(GetUniqueCode));
		InsTitledField(15,7,10,1, 'Release Code', New(PInputReleaseCode, init(R, 10, GetUniqueCode)));
		InsOKButton(5,9, @S);
		InsCancelButton(20,9);
		SelectNext(False);
	end;

	Control := Desktop^.ExecView(EditBox);

	if Control=cmOK then begin
		rcType := ReleaseCodeValid(S,GetUniqueCode);

		case rcType and $0F of
			rcExtend : begin
				PauseMessage('LICENCE','Temporary Licence Extended', hcAPExtended);
				{no maximum number users with extension}
				ProgramStatus.SetTrialStart(Today);
			end;

			rcValid : begin
				if rcType and $F0 <> rcInvalid then begin
					{set OK marker in status}
					ProgramStatus.SetUniqueCode(GetUniqueCode);
					{---- number of users -----}
					NewMaxUsers := (rcType and $F0) shr 4;
					ProgramStatus.SetMaxUSers(NewMaxUsers);
					ProgramStatus.SetNumEntries(0); {reset so that if moved from HD, etc, not an immediate problem}
{need to keep as is, o/w uniquecode changes...						D.Clear; ProgramStatus.SetTrialStart(D);{}
					if NewMaxUsers=1 then
						S := 'Single User'
					else
						S := 'Maximum Number Users '+N2Str(NewMaxUsers);

					PauseMessage('LICENCE','Temporary Licence Converted'#13#10+S, hcAPConverted);
				end;
			end;
		end; {case}
	end; {if control = ok}

	AskForReleaseCode := Control; {pass back result}
end;


{***********************************
 ***    TIME BOMB PROTECTION     ***
 ***********************************}

{Check for time bomb}
procedure CheckBomb;
var Bomb : TDate;
begin
	Today.SetToToday;
	Bomb.SetToStr(BombDate);
	if not Bomb.blank then begin
		if ToDay.Days > Bomb.Days then begin
			ProgramWarning('LICENCE TO USE HAS EXPIRED'#13#13'PLEASE CONTACT SBS FOR A NEW SYSTEM',hcBombMsg);
			dispose(Kameleon, done);
			Halt(0);     {Return no error code}
		end;
		if Today.Days > (Bomb.Days-30) then
			ProgramWarning('LICENCE TO USE EXPIRES IN '+N2Str(Bomb.Days-Today.Days)+' DAYS'
											+#13#13'PLEASE CONTACT SBS FOR A NEW SYSTEM', hcBombMsg);
	end;
end;

begin
	{$IFNDEF Update}
	RegisterTask(StartupTasks, 0, @AntiPiracy); {do after status init so that licence details can be checked}
	{$ENDIF}
	RegisterTask(DesktopTasks, cmDoLicence, @AntiPiracy);

	{$IFDEF Bombed}
		RegisterTask(StartUpTAsks, 0, CheckBomb);
	{$ENDIF}
end.
