{***********************************************************************
 ***             SIGNING ON PROCEDURE                                ***
 ***********************************************************************}
{$I Compdirs}

unit KUsers;

INTERFACE

uses
	jimmys,
	files,
	tuiedit, views,
	devices, forms,
	address,
	global,
	drivers,
	objects,
	kstaff,
	tuijimmy, inpjimmy,
	kdirctry;

const
	{--- User access types ----}
	saAccessOnly 	= $00;
	saBasic       = $01;

	{accounts}
	saAccountReports = $01;
	saAccountEntry = $02;

	{technical}
	saStdMaintenance = $03;
	saAdvMaintenance = $04;

	saTechnical = $05; {reserved for SBS support User...}

	SuperUserName = 'SUPERVISOR';

{Standard password object.  At the moment just a string of 10 chars, but
defining as an object hopefully means we can do some encryption in the
future}
type
	PPassword = ^TPassword;
	TPassword = object(TObject)
		PW : string[10];
		constructor Init;
		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream);
	end;

type
	PUser = ^TUser;
	TUser = object(TStaff)
		Password : TPassword; {have to be able to enter this carefully...}

		Access : word;

		UserIdx : longint;
		UserAliasIdx : longint;

		{-- Methods --}
		function srType : word; virtual;
		constructor Load(var S : TDataStream);
		procedure   StoreFields(var S : TDataSTream); virtual;

		function PtrOffset : byte; virtual;

		{indexing}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;

		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;
	end;



{standard inputpassword.  Current User is the default password providor.  Also
has ability to extract user from another line (settargetlink of user entry
line to this one - see below signon}
type
	PInputPassword = ^TInputPassword;
	TInputPassword = object(TInputELine)
		User : PUser;
		constructor Init(R : TRect);
		procedure HandleEvent(var Event : TEvent); virtual;
		function Valid (Command : Word) : boolean; virtual;
		procedure SetData(var Rec); virtual;
		procedure GetData(var Rec); virtual;
		function DataSize : word; virtual;
	end;


var
	CurrentUser : PUser;

IMPLEMENTATION

uses tuimsgs,
			scodes,
			jimhooks,
			jimindxs,
			help,
			inplist,
			inptel,
			status, kamsetup, {set who at terminal}
			tasks,
			dosutils,
			tui, tuiapp,
			printers,
		 app, dattime, dialogs, minilib;


{****************************************************
 ***             SIGNON                           ***
 ****************************************************}

procedure Signon; far;
var
	Bounds, R: TRect;
	EditBox : PEditBox; {See INPFLDS}
	Control : word;
	InputRec : record
		User : longint;
		Password : string;
	end;
	UserLine,PasswordLine : PView;
	Linker : PInputLinker;

begin
	R.Assign(0, 0, 34, 9); {Size of box}
	InputRec.User := -1;
	InputRec.Password := '';

	New(editbox, init(R, 'Sign On', Desktop));

	New(Linker, init(nil, EditBox));{}

	with EditBox^ do begin

		Options := Options or ofCenterX or ofCenterY;
		HelpCtx := hcSignOn;

		{--- Set up box interior ---}
		UserLine := InsTitledField(    11, 2, 19, 1, 'User',   New(PInputDirectory, Init(R,20, fiUserIdx, lsUsers, '')));
		with PinputList(UserLine)^ do begin
			Listoptions := ListOptions and not loAllowList and not loCheckSuper;
			{$IFNDEF fixit}	MustInput := True;{$ENDIF}
		end;
		Linker^.SetSourceView(UserLine, 1);{}

		InsTitledField(    11, 4, 10, 1,'PassWord', New(PInputPassword, Init(R)));
		Linker^.SetTargetView(Current,1);{}

		{-- Buttons --}
		InsOKButton(   		 5, 6, @InputRec);
		InsCancelButton(  16, 6);

		SelectNext(False);
	end;

	Control := Desktop^.ExecView(EditBox);

	dispose(EditBox, Done);

	if Control = cmCancel then begin
		dispose(Kameleon, done); {can't do this as it is still being inited}
		halt(0);
	end;

	{as the jimmy will be disposed of, need to reget it}
	CurrentUser := PUser(GetJimmy(InputRec.User));
	if CurrentUser<>nil then ProgramStatus.SetWhoAtTerminal(TerminalNo, CurrentUser^.RecNo);
end;

procedure SignOff; far;
begin
	if CurrentUser<>nil then dispose(CurrentUser, done);{}
	ProgramStatus.SetWhoAtTerminal(TerminalNo, -1); {no-one on}
	CUrrentUSer := nil;
end;

{****************************************************
 ***          PASSWORDS                           ***
 ****************************************************}
constructor TPassword.Init;
begin
	inherited Init;
	PW := '';
end;

constructor TPassword.Load;
begin
	PW := S.ReadStr;
end;

procedure TPassword.Store;
begin
	S.WriteStr(@PW);
end;

{****************************************************
 ***          INPUT PASSWORD                      ***
 ****************************************************}
constructor TInputPassword.Init(R : TRect);
begin
	inherited Init(R, 10);
	UpperCase := True;
	Asterisk := True;
	User := CurrentUser;{}
	HelpCtx := hcInputPassword;
end;

procedure TInputPassword.HandleEvent(var Event : TEvent);
begin
	if (Event.What=evCommand) and (Event.Command=cmUpdatefromLink) then begin
		{assume from a User entry line}
		User := PUser(PInputDirectory(Event.InfoPtr)^.GetJimmy);
		ClearEvent(Event);
	end;{}

	inherited HandleEvent(Event);
end;


function TInputPassword.Valid (Command : Word) : boolean;
var V : boolean;
{		User : PUser;{}
begin
	V := inherited Valid(Command);

	if V and DoValidFor(Command) and (Command<>cmReleasedFocus) then begin
{		if UserLine=nil then
			User := nil
		else
			User := PUser(UserLine^.GetJimmy);{}

		if (User<>nil) then begin
			{compare with users password}
			if delspace(User^.Password.PW)<>delspace(Data^) then begin
				InputWarning('Password incorrect'#13#10'Please re-enter',HelpCtx);
				V := False;
				Focus; {might be OKing}
				Draw; {draw - currently focused}
			end;
		end else begin
			{no user given - specifying password, confirm entry by asking to
				type again}
		end;
	end;



	Valid := V;
end;


procedure TInputPassword.SetData(var Rec);
begin
	Data^ := TPassword(Rec).PW;
end;

procedure TInputPassword.GetData(var Rec);
begin
	TPassword(rec).PW := Data^;
end;

function TInputPassword.DataSize : word;
begin
	DataSize := sizeof(TPassword);
end;

{****************************************************************************
 ***                                                                      ***
 ***                THE User OBJECT                                     ***
 ***                                                                      ***
 ****************************************************************************}


{----- Indexing -------}
{difference between TUser and TStaff, is that ixtypes 8 and 9 are used
to point to the User index (full name and alias), leaving 3-5 for categories
and 6-7 for staff index}
function TUser.NumixTypes;
begin NumixTypes := 9; end;

procedure TUser.GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte);
begin
	inherited GetIndex(ixType, IdxRec, fiType);

	case ixType of
		8 : begin Idxrec := @UserIdx;			fiType := fiUserIdx; end;
		9 : begin Idxrec := @UserAliasIdx;fiType := fiUserIdx; end; {alias}
	end;
end;

function TUser.GetIndexKey(const ixType : byte) : string;
begin
	case ixType of
		8 : GetIndexKey := inherited GetIndexKey(1); {must be inherited so it doesn't trap superuser below}
		9 : GetIndexKey := GetIndexKey(2);
	else
		{super user should not appear in main, full directory}
		if ucase(SurName)=SuperUserName then GetIndexKey := ''
		else GetIndexKey := inherited GetIndexKey(ixType);
	end;
end;

{****************************************************
 *** STREAMING                                    ***
 ****************************************************}
{THE LOAD AND STORE *MUST* MATCH, AS THE INDEX IS CALCULATED ASSUMING
RECORDS ALL OF THE SAME LENGTH. SEE ABOVE "TDatSIZE" CONSTANT TO SET
THE SIZE}
function TUser.PtrOffset;
begin PtrOffset := inherited PtrOffset +1; end; {allow for extra ver no}

const
	 {--- Required for Stream ----}
	 RUser : TStreamRec = (
		 ObjType : srUser;
		 VmtLink : Ofs(TypeOf(TUser)^);
		 Load : @TUser.Load;
		 Store : @TUser.Store
	 );

function TUser.srType;
begin srType := srUser; end;

{------- LOAD MAIN DATA ----------}
constructor TUser.Load;
var I : integer;
		Ver :byte;
		OldTel : string;

begin
	S.Read(Ver, 1); {stored in object}
	case Ver of
		3 : begin
			CommonInit;

			S.Read(Ver, 1); {TStaff ver}
			S.Read(LockTerminal, 1);
			S.Read(Deleted, 1);

			S.Read(Dat2Idx, 32); {all located one after the other}

			S.Read(UserIdx, 4);
			S.Read(UserAliasIdx, 4);

			S.Read(Ptr2History, 12);

			S.Read(AddressID, 4);

			DOReg.Load(S);


			{Surname/Forename also stored in index}
			Surname  := S.ReadStr;
			ForName  := S.ReadStr;
			Title    := S.ReadStr;
			Alias		 := S.ReadStr;

			JobTitle := S.ReadStr;
			Dept := S.ReadStr;

			for I := 1 to 4 do OldTel := S.ReadStr;

			CategoryCodes := S.ReadStr;

			NatID := S.ReadStr;

			Ptr2Contacts := -1;
			Ptr2Accounts := -1;

			S.Read(Access,2);
			Password.Load(S);
		end;
		4 : begin
			{now derived from TStaff }
			inherited Load(S);
			S.Read(Access,2);
			Password.Load(S);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not recognised'#13#10'Loading User',mfError,hcInternalErrorMsg);
		fail;{}
	end; {case}
end; {proc}

{-------- STORE MAIN DATA ----------}
procedure TUser.StoreFields;
var	Ver : byte;

begin
	Ver := 4; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.Write(Access, 2);
	Password.Store(S);
end;


{***************************************************************************
 ***                EDIT User                                          ***
 ***************************************************************************}
procedure TUser.MakeEditBox;
var R : TRect;
		SurLine : PView;
begin
	inherited MakeEditBox(EditBox, Caller);

	{Create box}
{	R.Assign(0, 0, 68, 21); {Size of box}
{	CentreOnView(R, Caller);{}
	Message(EditBox, evCommand, cmSetTitle, NewStr('User Registration'));

	with EditBox^ do begin
{		inherited MakeEditBox(EditBox,Caller);

		SurLine := InsTitledBox(  11, 1,  20, 1, 'S~u~rname',30); {Sizeof(SurName)-1); {}
{		PInputELine(Current)^.MustInput := True; {Force entry}
{		InsTitledBox(  11, 2,  20, 1, 'Forname', 25); {Sizeof(ForName)-1); {}
{		InsTitledBox(  11, 3,  10, 1, 'Title',   10); {Sizeof(Title)-1   ); {}

{		InsTitledBox(  43, 1,   3, 1, 'A~l~ias',   3);
		PInputELine(Current)^.UpperCase := True;
		InsTitledBox(  43, 2,  21, 1, '~J~ob Ttle',     30);
		InsTitledBox(  43, 3,  21, 1, 'Dept',  30);

		{Address}
{		Insert(New(PInputAddress, init(2,5, @Self, True)));

		{Telephone Numbers}
{		InsTitledField(43, 5,  21, 1, '~T~el',   New(PInputTelNum, init(R, 25)));
		InsTitledField(43, 6,  21, 1, '',   New(PInputTelNum, init(R, 25)));
		InsTitledField(43, 7,  21, 1, '',   New(PInputTelNum, init(R, 25)));
		InsTitledField(43, 8,  21, 1, '',   New(PInputTelNum, init(R, 25)));

		InsTitledField(11,13, 30, 1, '~S~earch',   New(PInputSCLine, init(R, 10, scDirectoryCategory)));
{}
		InsTitledField(43,12,  10, 1, '~P~assword',   New(PInputPassword, Init(R)));
		if (CurrentUser<>nil) and (CurrentUser^.RecNo<>RecNo) and (RecNo<>-1) then
			Current^.SetState(sfDisabled, True) {only allow user him/herself to change own password}
		else
			PInputPassword(Current)^.User := nil; {don't try and match with current user}

		InsTitledField(43,13,  5, 1, 'Acc~e~ss',     New(PInputWord, Init(R,5)));

{		InsTitledField(11,15,  43, 5, '~M~ore', New(PDlgHookView,	Init(R, lsMoreAbout, 0, hkMore, @Self)));
		PHookViewer(Current)^.SetFocusKey(kbMore);{}
		SelectNext(False);
{		SelectNext(False);
		SelectNext(False);
		SelectNext(False);{}

		HelpCtx := hcUserEditBox;
	end;

{	SurLine^.Focus;{}

end;




{******************************************
 ***         CREATORS                   ***
 ******************************************}

function NewUser(P : pointer) : pointer; far;
begin NewUser := New(PUser, init); end;

function NewUserIndex : PStream; far;
begin NewUserIndex := New(PIndexedJimmyStream, init('User.IDX',TDirectoryIndexSize)); end;

procedure StartUserList; far;
var Bounds : TRect;
		List : PDirectoryListView;
begin
	Desktop^.GetExtent(Bounds);

	List := New(PDirectoryListView, Init(Bounds, lsUsers, fiUserIdx,''));

	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'User List', List)));
end;


{******************************************
 ***         UNIT INSTALLATION          ***
 ******************************************}
{unit initialisation procedure}
begin
{$IFDEF fixit} writeln('Users...'); {$ENDIF}

	RegisterType(RUser);{}
	CurrentUser := nil;

	NewFileAdmin(fiUserIdx, 'User Index',NewUserIndex);

{$IFDEF kusers}
	RegisterCreator(cmNewUser, NewUser);

	RegisterNewWithList(lsUsers, '~U~ser', cmNewUser);

	if GetJustFileName(ParamStr(0))<>'INSTALL' then begin
		RegisterTask(StartupTasks, 10, @SignOn); {do after status init so that licence details can be checked}
		RegisterTask(ShutDownTasks, 0, @SignOff);
	end;

	RegisterTask(DesktopTasks, cmNewUserList, @StartUserList);
{$ENDIF}

end.


