{**************************************************
 ***                STATUS                      ***
 **************************************************}
{$I compdirs}
{needed for m/user, s/user}
{The fields might as well be accessed directly}
{See the global unit for the fields}
{See the kabout unit for status display}
unit Status;

{Layout of file:
 pos(byte)	data
	0					Version (from 4+)
	1 				SubVersion
	2					Release (from d+)
	12-15			Last backup Date (3 bytes)
	18 				Force Close + Exit, do not allow back in, for anything else
						except given terminal
	19				"Fixit is running" marker

	20				Pop-up message marker - set to FF, then each terminal can mark
						when it's read it.  See popupmsg.pas

						--Anti Piracy--
	50-1			Copy of Uniquecode (word) generated by apiracy module, set when
						password correctly entered
	52-3			Used for method 2 fo antipiracy, where random number is initially
						generated and set in here, rather than using HD number
						-- Trial tracking --
	54-5			Number entries to system if on trial
	56				Number of users allowed
	57-9			Start of trial date

	100-399		Terminals logged on to system, 4 bytes each (100 terminals):
								-1 if not logged on, -2 if logged on but ID unknown (no user module)
								o/w ID of user

	400-499		Status of each terminal - only used for newsflash at the moment
						but could be used for data version changes/etc:
								$01 - NewsFlash


	1000-1999	**lock now done in collection** Sentence code locks and versions (2 bytes, first byte=lock)
	2000-2999 File type locks and versions (2 bytes){}


INTERFACE

uses kamsetup, {make sure datapath is set}
			global, {for terminalno & datapath & ver}
			objects, dattime;

const
	{terminal status}
	tsNewsFlash = $01;

type
	{It is rather extra important that the status stream is *not* buffered,
	so that any read/write is done straight from file, and not from any
	memory buffer}
	PStatus = ^TStatus;
	TStatus = object(TDosStream) {do *not* use buffered stream!}

		constructor Init;
		destructor Done; virtual;

		procedure Clear;

		{often-used bits of code}
		function GetWordAt(const Pos : word) : word;
		function GetByteAt(const Pos : word) : byte;
		procedure SetWordAt(const Pos : word; W : word);
		procedure SetByteAt(Const Pos : word; B : byte);



		function NumTerminalsRunning : byte;


		procedure GetDataVer(var Ver : TVer);
		procedure SetDataVer(Ver : TVer);

		{anti piracy}
		function 	GetUniqueCode : word;
		procedure SetUniqueCode(const W : word);

		function 	GetNumEntries : word;
		procedure SetNumEntries(const W : word);
		function 	GetMaxUsers : byte;
		procedure SetMaxUsers(const MaxUsers : byte);
		procedure	GetTrialStart(var Date : TDate);
		procedure SetTrialStart(const Date : TDate);


		 procedure GetLastBackupDate(var Date : TDate);
		 procedure SetLastBackupDate(Date : TDate);

		 procedure 	SetTerminalStat(TerminalNo, Stat : byte);
		 function 	GetTerminalStat(TerminalNo : byte) : byte;

		 function GetWhoAtTerminal(TerminalNo : byte) : longint;
		 procedure SetWhoAtTerminal(TerminalNo : byte; Who : longint);

		 function GetfiVer(fiType : byte) : byte;
		 function GetfiLock(fiType : byte) : byte;
		 PROCEDURE SetfiVer(fiType, Ver : byte);
		 procedure SetfiLock(fiType, Lock : byte);

		 function FixitRunningOn : byte; {returns terminal number, or zero}
		 {$IFDEF Fixit}
		 procedure SetFixitRunning(Terminal : byte);
		 {$ENDIF}

		 function KickOut : byte;
		 procedure SetKickOut(Terminal : byte);

	end;

procedure ShutDownLogOff; {so anti-piracy can shut down OK}

var ProgramStatus : TSTatus;  {Just the one Mrs wembly}

IMPLEMENTATION

uses
			tasks, {for shutdown}
			dosutils,
			files, {for stopenshare}
			{$IFDEF WIndows}
				winmsgs,
				wincrt, {for debugging}
			{$ELSE}
				tuimsgs,
			{$ENDIF}
			help,
			messtext,
			minilib;

const
	{starting offsets in status file}
	TerminalPos = 100;
	TermStatPos = 400;
	scPos = 1000;
	fiPos = 2000;

{*************************
 **         INIT       ***
 *************************}
constructor TStatus.Init;
var L : longint;
begin
	{$IFDEF WIndows}
	inherited Init(StrFromPS(DataPath+'KAMELEON.STA'), stOpenShare);
	{$ELSE}
	inherited Init(DataPath+'KAMELEON.STA',stOpenShare);
	{$ENDIF}

	if {(GetJustFileName(ParamStr(0))='INSTALL') and{}
		(Status = stInitError) and (ErrorInfo=2) then begin
		{File not found - should only happen with install.pas}
		if (GetJustFileName(ParamStr(0))<>'INSTALL') then
			ProgramWarning('Status file KAMELEON.STA not found'#13#10'Creating new one', hcNoContext);
		Reset;  {Clear error}
		inherited Init(DataPath+'KAMELEON.STA', stCreateShare);
	end;

	if Status<>stOK then ProgramError('Could not Initialise status file'#13#10+IOError(ErrorInfo), hcInternalErrorMsg);

	L := getsize;

	if GetSize<=0 then Clear; {new file, fill with zeros}
end;


{****************************
 ***     DONE             ***
 ****************************}
{End of program - take out various bits pertaining to this particular run}
destructor TStatus.Done;
begin
	SetWhoAtTerminal(TerminalNo, -1); {clear who}
	TerminalNo := 0;
	inherited Done;
end;

{*************************************
 ***       MISC                    ***
 *************************************}
procedure TStatus.Clear;
var B : byte;
		I : word;
begin
	ThinkingOn('Clearing status');
	B := 0;
	for I := 0 to 3000 do Write(B, 1);
	for I := 1 to MaxTerminal do SetWhoAtTerminal(I, -1); {clear terminals}
	for I := 1 to MaxTerminal do SetTerminalStat(I, 0); {clear terminal status'}

	SetDataVer(ProgVer);

	ThinkingOff;
end;

{==== OFT USED BITS ============}
procedure TStatus.SetWordAt;
begin
	Seek(Pos);
	Write(W,2);
end;

procedure TStatus.SetByteAt;
begin
	Seek(Pos);
	Write(B,1);
end;

function TStatus.GetWordAt;
var W : word;
begin
	Seek(Pos);
	Read(W,2);
	GetWordAt := W;
end;

function TStatus.GetByteAt;
var B : byte;
begin
	Seek(Pos);
	Read(B,1);
	GetByteAt := B;
end;



{********************************************************
 ***                  DATA VERSION                    ***
 ********************************************************}

procedure TStatus.GetDataVer(var Ver : TVer);
begin
	Seek(0);
	with Ver do begin
		Read(Main, 1);
		Read(Sub, 1);
		Read(Release, 1);
	end;
end;

procedure TStatus.SetDataVer(Ver : TVer);
begin
	Seek(0);
	with Ver do begin
		Write(Main,1);
		Write(Sub, 1);
		Write(Release,1);
	end;
end;

{========== LAST BACKUP DATE ==========}
procedure TStatus.GetLastBackupDate(var Date : TDate);
BEGIN
	Seek(12);
	Date.Load(Self);
end;

procedure TStatus.SetLastBackupDate(Date : TDate);
begin
	Seek(12);
	Date.store(Self);
end;

{================= FIXIT RUNNING ===================}
function TStatus.FixitRunningOn;
var B : byte;
begin
	Seek(19);
	Read(B,1);
	FixitRunningOn := B;
end;

{$IFDEF fixit}
procedure TStatus.SetFixitRunning;
begin
	Seek(19);
	Write(Terminal,1);
end;
{$ENDIF}

{================= FIXIT RUNNING ===================}
function TStatus.KickOut;
var B : byte;
begin
	Seek(18);
	Read(B,1);
	KickOut := B;
end;

procedure TStatus.SetKickOut;
begin
	Seek(18);
	Write(Terminal,1);
end;

{================ POP UP MESSAGE ====================}
procedure TStatus.SetTerminalStat;
begin
	Seek(TermStatPos+TerminalNo);
	Write(Stat,1);
end;

function TStatus.GetTerminalStat;
var B : byte;
begin
	Seek(TermStatPos+TerminalNo);
	Read(B,1);
	GetTerminalStat := B;
end;

{**********************************************
 ***                  ANTI PIRACY           ***
 **********************************************}
{====== UNIQUE CODE STORAGE =============}
function 	TStatus.GetUniqueCode;   		begin GetUniqueCode := GetWordAt(50); end;
procedure TStatus.SetUniqueCode;  		begin SetWordAt(50,W); end;

{function 	TStatus.GetReleaseCode;
begin
	release code is a string... might be able to convert back from hexx....?
	Never mind - when release code is correct, set maxusers (if that is 0,
	the password has not been entered...clear getnumentries
	GetReleaseCode := GetWordAt(52);
end;


procedure TStatus.SetReleaseCode;  		begin SetWordAt(52,W); end;

{=========== TRIAL TRACKING =============}
function  TStatus.GetNumEntries; 			begin GetNumEntries := GetWordAt(54); end;
procedure TStatus.SetNumEntries;			begin SetWordAt(54, W); end;

function 	TStatus.GetMaxUsers;				begin GetMaxUsers := GetByteAt(56); end;
procedure TStatus.SetMaxUsers;        begin SetByteAt(56, MaxUsers); end;

procedure TStatus.GetTrialStart(var Date : TDate);
begin
	Seek(8);
	Date.Load(Self);
end;

procedure TStatus.SetTrialStart(const Date : TDate);
begin
	Seek(8);
	Date.Store(Self);
end;



{************************************
 ***           TERMINALS          ***
 ************************************}

function TStatus.NumTerminalsRunning : byte;
var TerminalNo : byte;
		Num : byte;
begin
	Num := 0;
	for TerminalNo := 1 to MaxLockTerminals do if GetWhoAtTerminal(TerminalNo)<>-1 then inc(Num);
	NumTerminalsRunning := Num;
end;

function TStatus.GetWhoAtTerminal(TerminalNo : byte) : longint;
var Who : longint;
begin
	Seek(TerminalPos + TerminalNo * 4);
	Read(Who, 4);
	GetWhoAtTErminal := Who;
end;

procedure TStatus.SetWhoAtTerminal(TerminalNo : byte; Who : longint);
begin
	Seek(TerminalPos + TerminalNo * 4);
	Write(Who, 4);
end;

{============ File Admin status =========================}
{--- versions -----}
procedure TStatus.SetfiVer;
begin
	Seek(fiPos + fiType * 2 +1);
	Write(Ver, 1);
end;

function TStatus.GetfiVer;
var Ver : byte;
begin
	Seek(fiPos + fiType * 2 +1);
	Read(Ver, 1);
	GetfiVer := Ver;
end;

{--- locks ---}
procedure TStatus.SetfiLock;
begin
	Seek(fiPos + fiType * 2);
  Write(Lock, 1);
end;

function TStatus.GetfiLock;
var Lock : byte;
begin
	Seek(fiPos + fiType * 2);
	Read(Lock, 1);
	GetfiLock := Lock;
end;


procedure ShutDownLogOff;
begin
	{$IFDEF Fixit}
	ProgramStatus.SetFixitRunning(0);
	{$ENDIF}
	ProgramStatus.Done;
end;

{****************************************************
 ***          STATUS INITIALISATION               ***
 ****************************************************}

begin
	{$IFDEF fixit} writeln('Initialising status.pas...'); {$ENDIF}
	ProgramStatus.Init;  {Read in current status details}

	{---- Check Version --------------}
	ProgramStatus.GetDataVer(DataVer);

	if GetJustFileName(ParamStr(0))<>'INSTALL' then begin
		if DataVer.Main=0 then begin
			ProgramError('NO DATA FOUND (.STA Ver=0) AT '+DataPath+#13#10'  Please run install program', hcNoContext);
			halt(0);
		end else
			{$IFNDEF Update}
				if (DataVer.Main<>ProgVer.Main) or (DataVer.Sub<>ProgVer.Sub) then begin
					ProgramWarning('DATA VERSION ('+N2Str(DataVer.Main)+'.'+N2Str(DataVer.Sub)+DataVer.Release
								+') NOT SAME AS PROGRAM VERSION!'#13#10'RUN UPDATE PROGRAM', hcNoContext);
				{$IFNDEF Development}
					{$IFNDEF fixit}
						halt(0);
					{$ENDIF}
				{$ENDIF}
				end;
			{$ENDIF}

		ProgramStatus.GetDataVer(DataVer);
	end;

	{----- Check & set Terminal Number conflict -----------}
	{Ideally I wanted this routine to find a spare terminal number if one was
	not specified in the configuration.  As I have had some problems with logging
	on and off, the terminal number MUST be given for multi-user systems or a
	warning will appear}

	{auto search:}
	{for I:= MaxTerminals downto 1 do if Terminals[I] = ' ' then TerminalNo := I;{}

	if GetJustFileName(ParamStr(0))<>'INSTALL' then begin
		{$IFDEF SingleUser}
			TerminalNo := 1;  {Force number one - handy at the moment for this
											 problem where it doesn't seem to clear terminals properly}

			if ProgramStatus.NumTerminalsRunning>0 then begin
				if (ProgramStatus.NumTerminalsRunning=1) and (ProgramStatus.GetWhoAtTerminal(TerminalNo)<>-1) then
					ProgramError('Crashed out last run?  Have you told SBS?', hcNoContext)
				else
					ProgramError('Single User but other terminals running!', hcNoContext);
			end;
		{$ELSE}
			if TerminalNo=0 then begin
				ProgramError('Multiuser but no Terminal Number Specified'#13#10'Place "Terminal =" command in cfg file', hcNoContext);
				TerminalNo := 1;
			end;
			if (TerminalNo<1) or (TerminalNo>MaxTerminal) then begin
				ProgramError('Terminal No '+N2Str(TerminalNo)+' out of range 1-'+N2Str(MaxTerminal)+
											#13#10'Check configuration file!', hcNoContext);
			end;
			{don't stop for this...}
			if (TerminalNo>MaxLockTerminals) then begin
				ThinkingOn('Terminal No '+N2Str(TerminalNo)+' > '+N2Str(MaxLockTerminals)+
											#13#10'THIS IS A NON-LOCKING TERMINAL!');
				ThinkingOff;
			end;

			if (TerminalNo=99) and (ProgramStatus.GetWhoAtTerminal(TerminalNo)<>-1) then
				ProgramWarning('Terminal Conflict'#13#10
												+'Another Terminal #'+N2Str(TerminalNo)+' already in status'#13#10,
												hcNoContext	{should get user name...});
		{$ENDIF}
	end;

	ProgramStatus.SetWhoAtTerminal(TerminalNo, -2); {would store user ID once signed on}

	{CHECK TO SEE IF FIXIT IS RUNNING}
	{$IFNDEF fixit}
	if ProgramStatus.FixitRunningOn<>0 then begin
		ProgramError('FIXIT RUNNING ON TERMINAL '+N2Str(ProgramStatus.FixitRunningOn)+'!!'#13#10
									+'PLEASE EXIT!', hcNoCOntext);
	end;

	if (ProgramStatus.KickOut<>0) and (ProgramStatus.KickOut<>TerminalNo) then begin
		ProgramError('PLEASE WAIT 5 MINUTES BEFORE RESTARTING '+N2Str(ProgramStatus.KickOut),hcNoContext);
		halt(0);
	end;
	{$ENDIF}

	{$IFDEF Fixit}
	ProgramStatus.SetFixitRunning(TerminalNo);
	{$ENDIF}

	RegisterTask(ShutDownTasks, cmNone, @ShutDownLogOff);
end.
