{****************************************************************************
 ***                                                                      ***
 ***                GENERAL FILE/STREAM ROUTINES/DEFINITION               ***
 *** FILES                                                                ***
 ****************************************************************************}
{Provides, essentially, a datastream object that gives some extensions to
the existing turbo vision disk streams, particualarly opening as shared,
extended error checking and notifying, and reading/writing methods.

Also, a SharedStream, which is a series of "routers".  Any process/object that
wishes to use a multi-user/multi-process stream/file, should log on to that
stream using the SharedStream, and again use that array element to access
the stream, which routes all calls to a particular file on disk through
one interface. This means we can use a buffered stream (in singleuser systems)
and reduces the number of file handles required.

The parent TDataItem provides a record number (pointing to it's own position on
disk) and a lock byte with methods to turn it on and off

WARNING! IMPORTANT!
Even the multi-user version uses a buffered stream (it was too slow without
it), and this means that when any important information (eg pointers, etc)
have been written to disk, the stream *MUST* be *FLUSHED*.  And before any
important information is *read* from the disk.
}

{}
{$I compdirs}  {check for singleuser bit}
unit Files;

INTERFACE

uses
			global, {for datapath}
			objects;

const
	{Hmmm...  TBufStream seems to always read a full buffer size on each
	read...?? which means that a very large buffer makes it slow to read
	trees etc of fragmented data

	The buffer only seems to be useful when reading each record, so set
	individually for each stream, preferably (ie index stream set to record
	size), use this constant for unknowns:}
	StreamBufSize = 500; {set for roughly one DOS read? experiment!}
	MinStreamBufSize = 100; {the minimum size for small-read files, eg id index}

	{--- Constants to mark lock or not ----}
	{Action to lock:}
	lkLeave  =   0;  {Leaves lock as it was}
	lkOn     =   1;  {Locks record, but checks first}
	lkOff    =   2;  {Remove lock}

	{Action on finding lock:}
	lkCheck  = $00;  {Check for lock - "default"}
	lkIgnore = $10;  {Don't return anything, no messages - eg for lists}
	lkNoMess = $20;  {Don't display messages, but do usual returns if locked}
								{Used to set lock if unsure whether already locked; sr returns whether it was}
	lkIgnoreLocal = $30; {no mess/return if lock is local - o/w message & return}

	StreamErrMess : array[-6..0] of string[21] =
																		(' Put Unrecognized obj',
																		 ' Get Unrecognized obj',
																			' Cannot expand stream',
																			' Read error',
																			' Cannot initialise',
																			' Access error',
																			' No error');


{========= TOPPING UP RECORDS ===========================}
procedure TopUpRecord(var S : TStream; RecSize : integer; StartPos : longint);
function CheckRecOver(var S : TStream; RecSize : integer; StartPos : longint) : boolean;

{====== READING COMMA-SEPARATED VARIABLES =================}
function ReadCSV(var TextFile : text; var Field : string) : longint; {Read comma separated variable}


type
 {*************************************
	***    PARENT STANDARD DATA ITEM  ***
	*************************************}
	PDataItem = ^TDataItem;
	TDataItem = object(TObject)
		RecNo : longint;
		LockTerminal : byte;
		LockCount : byte;
		constructor Init;

		function GetLock : byte;         virtual;
		procedure SetLock(On : boolean);  virtual;
	end;

	{*************************************
	 ***     DATA STREAM               ***
	 *************************************}
	 {Provides a basis for all disk-based streams.  Adds some extra functions
	 to the TDosStream provided by TurboVision - note that this means that
	 all Load/Store procedures will expect var S : TDataStream as a parameter.}

	PDataStream = ^TDataStream;
	TDataStream = object(TBufStream){}

		{-- Data --}
		FileName : FNameStr;            {Used only as referance, eg debug}
		RecSize : word;
		ErrorComment : string[50];          {Set before task, as comment if it falls over}
		ChangeVer : byte;							{changes if data is updated by this terminal,
																					to let "users" of this object know its been changed by other "users"}
{		LastResult : byte;  {of rsxxx constants type.  Ought to try and incorporate into status}

		{--Methods--}
		constructor Init(NFileName : FNameStr; NRecSize : word; NBufSize : word);

		{--- Routines for working with record numbers rather than byte positins ------}
		function  NoRecs : longint;                   {No. recs in file}
		procedure SeekRec (RecNo : longint);           {Go to position}
		function GetRecPos : longint;              {Current pos in recs}

		function  GetAt(RecNo : longint) : PObject; virtual;  {Seek & get combined}
		procedure PutAt(RecNo : longint; P : PObject); virtual;  {Seek and put combined}

		{error processing}
		procedure ErrorMsg(const Comment : string);
		function StatusText : string; {returns text status/info}
		function StatusNums : string; {returns brief status/info numbers as text}

		{extra methods}
{		function GetWithLock(RecNo : longint; lkType : word) : PObject; virtual;{}

		procedure WriteFixedStr(FixedStr : Pstring; LengthStr : byte);
		function ReadFixedStr(LengthStr : byte) : string;
		function  ReadStr : string; {returns string - parent one returns nil if empty...}

		{replacing parent menthods}
		function  Get : PObject; virtual;           {make virtual - allow get & put to be overriden by descendants}
		procedure Put(P : PObject); virtual;

		{version update}
		procedure NewVer;

		procedure MultiUserFlush; virtual; {IF SINGLEUSER, DOES *NOT* CALL FLUSH}
	end;




 {*********************************************
	***           FILE ADMIN FOR PROGRAM      ***
	*********************************************}

{============ GLOBAL FILE STREAMS ===================}
{Used to direct all information to/from a file through the one stream -
otherwise DOS runs out of handles or something pretty quick - even with
80 files open. So instead refer to PersonFile^ - and use PersonFileLogOn to
register use, and PersonFileLogOff to register unuse. This will open the
stream at 1+ objects using it it, and dispose of it with 0.}

{Keeps track of number of users of a stream, closing
it down when unused. Provides an avenue to closing streams and
reopening to provide file handles.  Use fixxx constants in global.
Streams will still need their own Open procedures, 'cos we need a New
object and I can't be bothered passing procedures as parameters any
more...}

type
	TFileCreator = function : PStream;

	PFileAdmin = ^TFileAdmin;
	TFileAdmin = object

{		fiType : word; {reference constant}
		Name : PString;

		FilePtr : PStream;
		CreatorFunc : TFileCreator;

		Count : integer;   {No. of "users" (objects) logged on to using}
{		Next : PFileAdmin;{}

		constructor Init({AfiType : byte;{} AName : string; ACreatorFunc : TFileCreator);
		destructor Done; virtual;
		procedure LogOn;
		procedure LogOff;
		procedure Close;
		procedure Open;
	end;

function Stream(const fiType : byte) : PDataStream; {shorthand access to Fileadmin chain}
function FileAdmin(const fiType : byte) : PFileAdmin;
procedure NewFileAdmin(const Afitype : byte; AName : string; ACreatorFunc : TFileCreator);

{routines for objects that are stored one to a file, eg printer drivers,
etc}
{given file name, loads/stores first object}
function GetObjFromFile(const FileName : FNameStr) : PObject;
procedure PutObjToFile(const FileName : FNameStr; const P : PObject);


procedure ShutDownFiles; {closes all file admin'd files, and checks all are logged off}
procedure CloseAllFiles;
procedure ReOpenAllFiles;


{======= MESSAGE BOXES ============================}
function DBaseMessage(const Stream : PDataStream; const Message : string; mfOptions,HelpCtx : word) : word;


{const
	FirstFileAdmin : PFileAdmin =nil;  {first file admin in chain}
	{used to store as a chain, now as an array to try and speed up
	processing (ie rather than hunting through chain, now accesses direct
	through array}
var
	SharedStream : array [1..fiMaxfi] of PFileAdmin;

{****************************************************
 ***                                              ***
 ***                IMPLEMENTATION                ***
 ***                                              ***
 ****************************************************}


IMPLEMENTATION

uses  minilib,  {for inlongintrange for seekrec check}
			tasks, {for registering shutdown}
			messtext, {io errors}
			dosutils,
			help,
{$IFDEF Windows}
			strings,
			winmsgs;
{$ELSE}
			tuimsgs; {for error messages}
{$ENDIF}


function GetObjFromFile(const FileName : FNameStr) : PObject;
var	Stream : PDataStream;
begin
	GetObjFromFile := nil;

	{only do if already exists - o/w it will create an empty file}
	if not EmptyFileName(FileName) and FileExists(FileName) then begin
		New(Stream, init(FileName,1, StreamBufSize));
		GetObjFromFile := Stream^.Get;
		if Stream^.Status<>stOK then Stream^.ErrorMsg('Could not load');
		dispose(Stream, done);
	end;
end;

procedure PutObjToFile(const FileName : FNameStr; const P : PObject);
var Stream : PDataStream;
begin
	New(Stream, init(FileName,1, StreamBufSize));
	Stream^.Put(P); {store}
	if Stream^.Status<>stOK then Stream^.ErrorMsg('Could not load');
	dispose(Stream, Done);
end;


{*********************************************
 ***          ERROR MESSAGES               ***
 *********************************************}
function DBaseMessage(const Stream : PDataStream; const Message : string; mfOptions,HelpCtx : word) : word;
var Title : string;
begin
	if Stream<>nil then begin
		{$IFDEF Windows}
			Title := StrPas(Stream^.FileName);
		{$ELSE}
			Title := GetFileName(Stream^.FileName);
		{$ENDIF}
		Title := 'STREAM '+Title
										+ ' '+N2Str(Stream^.Status)+'/'+N2Str(Stream^.ErrorInfo)
	end else
		Title := 'DATABASE';

	if mfOptions = mfError 		then mfOptions := mfError or mfContinueButton or mfErrorBleep;
	if mfOptions = mfWarning 	then mfOptions := mfWarning or mfContinueButton or mfWarningBleep;

	{$IFDEF WIndows}
	{$ELSE}
		DBaseMessage := MessageBox(Title, Message, mfOptions, HelpCtx);
	{$ENDIF}
	RecordError(Title,Message,'');
end;




{*********************************************
 ***             Fill Up Record            ***
 *********************************************}

{Fills up rest of record EXACTLY otherwise either Seek to end of
file doesn't work properly if short of end, or it partially overwrites
the next one. Bargain extra check for record overflow if you pass StartPos>-1}

{- For some reason this wasn't required after all - some kind of mistake made
early on in development methinks - and has been removed so that descendants
don't have to worry about filled bits in parent load/stores.  Instead it now
just does an overflow check}

{- BUT Oh dear oh dear, it IS required in such places as the jimmy file, where
variable length jimmys are stored in a file of bytes, so that space is reserved
after the jimmy for future expansion, and also to allow for variable length fields.
So the name has been changed to TopUpRecord, and the overflow check below to
CheckRecOver}

{const
	Filler : string = 'FILLERfillerFILLERfillerFILLERfillerFILLERfillerFILLER';{}

procedure TopUpRecord(var S : TStream; RecSize : integer; StartPos : longint);
var Used,Pos,Size : longint;
		Filler : PChar;
begin
	{Check for overflow}
	if CheckRecOver(S,RecSize,StartPos) then begin
		Pos := S.GetPos; Size := S.GetSize;
		if Pos=-1 then begin
			if S.Status = stReadError then
				DBaseMessage(@S,'Read Past end of file'#13'Reading in .Store method?', mfError, hcInternalErrorMsg)
			else
				DBaseMessage(@S,'Files.pas TopUpRecord',mfError, hcInternalErrorMsg);
			exit;
		end else begin
			Used := Pos-StartPos +2;  {Allow for sr ID, as startpos gets measured after sr ID written}

			{Fill up rest *if last record in file*}
			if (Pos=Size) and (RecSize>Used) then begin {last record - last thing written is at end}
				GetMem(Filler, RecSize - Used);
				FillChar(Filler[0], RecSize - Used, #0);
				S.Write(Filler[0], RecSize - Used);                 {Write the appropriate length}
				FreeMem(Filler, RecSize-Used);
			end;
		end;
  end;
end;


{************************************
 ***       CHECK RECORD LENGTH    ***
 ************************************}
function CheckRecOver(var S : TStream; RecSize : integer; StartPos : longint) : boolean;
var Used : longint;
begin
	{Check for overflow}
	Used := S.GetPos-StartPos +2;  {Allow for sr ID, as startpos gets measured after sr ID written}
	CheckRecOver := True; {OK}

	if (StartPos>-1) and (Used>RecSize) then begin
		{$IFDEF WIndows}
		DBaseMessage(nil,'Record Overflowed; Startpos='+N2Str(StartPos)+' bytes (Rec '+N2Str(StartPos div RecSize)
													+'?), Size='+N2Str(RecSize)+' bytes'+#13#10
													+'By '+N2Str(Used-RecSize)+' bytes.  File='+PDataStream(@S)^.FileName^, mfError, hcInternalErrorMsg);
		{$ELSE}
		DBaseMessage(nil,'Record Overflowed; Startpos='+N2Str(StartPos)+' bytes (Rec '+N2Str(StartPos div RecSize)
													+'?), Size='+N2Str(RecSize)+' bytes'+#13#10
													+'By '+N2Str(Used-RecSize)+' bytes.  File='+PDataStream(@S)^.FileName, mfError, hcInternalErrorMsg);
		{$ENDIF}
		CheckRecOver := False;
	end;

end;

{********************************************************
 ***        READ COMMA-DELIMITED FIELD FROM TEXT FILE ***
 ********************************************************}
{Returns also number of bytes read}
var	ReadCSVString : string;  {Used by ReadCSV - reads complete line then splits}
		ReadCSVPos : word;

function ReadCSV(var TextFile : text; var Field : string) : longint;

{Assumes an end of line is [13] followed by [10]}
{NOT ACTUALLY PERFECT - ASSUMES THAT THERE IS AN EOLN *BEFORE* EOF}

var
	 C : char;
	 Quoted : boolean;
	 EOField : boolean;
	 BytesRead : longint;

{Attempt to read "buffered" - ie per line. Only lines are often >255 chars long}

{begin
			 Field := ''; Quoted := False; EOField := false; BytesRead := 0;

			 if ReadCSVPos>=length(ReadCSvString) then begin
							Readln(F, ReadCSVString);
							ReadCSVPos := 0;
							BytesRead := BytesRead + 2;  {LF & CR}
{       end;   {Last field got to an eoln}

{       while not EOField and not eof(F) do begin
							ReadCSVPos := ReadCSVPos +1;
							C := ReadCSVString[ReadCSVPos];
							BytesRead := BytesRead + 1;

							if (C = ',') and (not Quoted) then EOField := True
							else if C='"' then Quoted := (not Quoted)
														 else Field := Field + C;

							if ReadCSVPos>=length(ReadCSVString) then EOField := True;    {End of line = end of field}

{       end;

			 ReadCSV := BytesRead;
end;
{}


{Old method of reading char by char from file. Slow}
begin
	Field := ''; Quoted := False; EOField := false; BytesRead := 0; C := #0;

	{May be a blank line -> don't want to read anything yet}
	while not EOField and not eoln(TextFile) and not eof(TextFile) do begin
		read(TextFile, C); BytesRead := BytesRead + 1;

    if (C = ',') and (not Quoted) then EOField := True
			else if C='"' then Quoted := (not Quoted)
				 else Field := Field + C;

		if eoln(TextFile) then EOField := True;    {End of line = end of field}

  end;

	{Got to end of line, but do not do just after comma}
	{commenting this out means that it'll "stick" at the end of the line,
	handy for importing data/etc where number of fields might vary and you
	want to know always the beginning of the line by "resetting" to the next
	line with a readln
	if eoln(TextFile) and (C<>',') then begin
		Read(TextFile, C); Read(TextFile, C);
		BytesRead := BytesRead + 2;
	end;{}

  ReadCSV := BytesRead;
end;



{*******************
 *** DATA ITEM   ***
 *******************}
constructor TDataItem.Init;
begin
	inherited Init;
	RecNo := -1;
	LockTerminal := 0; {clear lock}
	LockCount := 0;
end; {clear lock}


function TDataItem.GetLock : byte;
begin GetLock := LockTerminal; end;

procedure TDataItem.SetLock(On : boolean);
begin if on then LockTerminal := TerminalNo else LockTerminal := 0; end;




{***************************************************************************
 ***                  DATA STREAM DEFINITION                             ***
 ***************************************************************************}
{ A Dos stream with added routines to convert from
 the usual byte-position getting to record-position
 getting}


{=== INITIALISATION ======}
constructor TDataStream.Init;
begin
	ErrorComment := 'IGNORE';                          {Ignore if it gets upset over first one}
	{$IFDEF Windows}
		if StrPos(NFileName,'\')=nil then StrPrefixPS(NFileName, DataPath); {string type pchar in windows}
	{$ELSE}
		if Pos('\',NFileName)=0 then NFileName := DataPath + NFileName; {if no path given, add configurable data path}
	{$ENDIF}
	inherited Init(NFileName, stOpenShare, NBufSize);{}

	ErrorComment := 'INITIALISATION';
	if (Status = stInitError) and (ErrorInfo=2) then begin
		{File not found}
		Reset;                                          {Clear error}
		FreeMem(Buffer, BufSize);{}
		inherited Init(NFileName, stCreateShare, NBufSize);{}
	end;
	FileName := NFileName;                             {Set fields}
	RecSize := NRecSize;
	if Status<>stOK then ErrorMsg('Initialising');
	ErrorComment := '';
end;

{========= PROVIDING RECORD-BASED METHODS ==============}
function TDataStream.NoRecs : longint;
begin
	if (GetSize mod RecSize) = 0 then                     {if no remainder...}
		NoRecs := (GetSize div RecSize)                     {No Recs is current size in bytes / rec size in bytes}
	else
		NoRecs := (GetSize div RecSize)+1;								{o/w round up}
	if Status<>stOK then ErrorMsg('Get No.Recs');                           {Check it worked all ok}
end;

function TDataStream.GetRecPos : longint;
begin
	GetRecPos := GetPos div RecSize;                   {Current record no is current pos in bytes / rec size}
	if Status<>stOK then ErrorMsg('GetPos in Recs');
end;


procedure TDataStream.SeekRec(RecNo : Longint);
begin
	{Add the 1.0 to force a "real" calcultation}
	if not inLongintRange(1.0*RecNo*RecSize) then begin {see minilib extras}
		ProgramError('Attempt to Seek '+R2Str(1.0*RecNo*RecSize,0,0)+'?!', hcInternalErrorMsg);{}
		Seek(GetSize);  {move to end so get fails below}
	end else begin
		{seek very rarely causes an error, but it will not work if there was an error beforehand}
		if Status<>stOk then ErrorMsg('Untrapped error, found at SeekRec '+N2Str(RecNo));
		Seek(RecNo * RecSize);                             {Seek record no times record size in bytes}
	end;
end;

{does seekrec and get, and sets recno}
function TDataStream.GetAt;
var D : PDataItem;
begin
	if RecNo = -1 then {a blank record number...}
		GetAt := nil      {.. translates to a blank memory pointer}
	else begin
		SeekRec(RecNo);
		D := PDataItem(Get);
		if D<>nil then D^.RecNo := RecNo;
		GetAt := D;
	end;
end;

procedure TDataStream.PutAt;
begin
	SeekRec(RecNo);
	if P=nil then begin
		ErrorMsg('PUTTING NIL? AT '+N2Str(REcNo))
	end else begin
		Put(P);
		PDataItem(P)^.RecNo := RecNo;
		if Status<>stOK then ErrorMsg('Putting At '+N2Str(RecNo));
	end;
end;


{========== ERROR HANDLING ==================}
procedure TDataStream.ErrorMsg(const Comment : string);
var S : string;
begin
{ Error(Status, ErrorInfo);{}
	if (Status <> stOK) then begin                {if Not OK...}
		if (Status<>stReadError) then begin              {..and not a "read past end of file" - do that a lot}
			if (Comment<>'IGNORE') then begin         {..and not to be ignored - eg opening stream - see init proc}
				{$IFDEF WIndows}
					S :=FileName^+' ('+Comment+')';
				{$ELSE}
					S :=FileName+' ('+Comment+')';
				{$ENDIF}
				S := S+#13+#13+'STATUS:'+StatusText;
				DBaseMessage(@Self,S, mfError, hcInternalErrorMsg); {Display DBaseError box - see errors unit}
			end;
		end;
		Reset;
	end;
end;

function TDataStream.STatusText : string;
var S : string;
begin
	S := N2Str(Status); if (Status>=-6) and (Status<0) then S:=S+StreamErrMess[Status];

	{Error info holds some extra data}
	if Status > -5 then
		S := S+'/Info='+IOError(ErrorInfo)
	else
		if Status = stGetError then
			S := S+'/Obj ID='+N2Str(ErrorInfo)
		else
			S := S+'/VMT offset='+N2Str(ErrorInfo);

	StatusText := S;
end;

function TDataStream.STatusNums : string;
begin
	StatusNums := N2Str(Status)+'/'+N2Str(ErrorInfo);
end;


{updates changeVer so that views can check for redisplaying, also updates
status file if multi user so that other terminals can update}
procedure TDataStream.NewVer;
begin
	inc(ChangeVer);
	{$IFNDEF SingleUser}
{		ProgramStatus.SetfiVer(fiType, ChangeVer)}
	{$ENDIF}
end;

procedure TDataStream.MultiUserFlush;
begin
{$IFNDEF SingleUser}
	Flush;
{$ENDIF}
end;



{================== OVERRIDING PARENT MEHTODS ===================}
{put these in marked virtually, so that any of the above/below methods
will call descendants Get/Put rather than the std tvision one}
function TDataStream.Get;
begin
	Get := inherited Get;
end;

procedure TDataStream.Put;
begin
	inherited Put(P);
{	NewVer; don't do here as it'll slow it down horribly...}
end;



{========== EXTRA METHODS ================}
{function TDataStream.GetwithLock;
var DataItem : PDataItem;
		LockLo, LockHi : byte;
		Control : word;

begin
	LastResult := rsFail;  GetwithLock := nil;               {Assume fail for exits}
{	LockLo := lkType and $F;                        {locking status}
{	LockHi := lkType and $F0;                       {locking message status}

{	if (RecNo<0) or (RecNo>=NoRecs) then begin  {Check range is valid}
{		lastResult := rsOutofRange;                          {o/w return problem}
{		exit;                                             {exit procedure}
{	end;

	DataItem := PDataItem(GetAt(RecNo));           {Load onto heap}

	{Check loaded OK}
{	if DataItem = nil then begin
		DBAseMessage(@Self,'Failed to load DataItem'#13#10'GetwithLock; Rec '+N2Str(RecNo),mfError);{}
{		exit;
	end;

	{Check if locked}
	{$IFNDEF fixit} {ignore if in fixit program}
{	if (DataItem^.GetLock <> 0) and ((LockHi and lkIgnore)=0) then begin
		if (LockHi and lkNoMess)=0 then Control := LockMessage('Getting Data Item'+#13+'GetWithLock '+N2Str(RecNo),
																																	DataItem^.GetLock, mfWarning)
															 else Control := cmCancel;  {Assume cancel - just (quietly) checking}
		{Retry}
{		if Control = cmRetry then begin
			Dispose(DataItem, Done); DataItem := nil;        {Remove from heap}
{			GetwithLock := GetwithLock(RecNo, lkType); {Round again}
{			exit;
		end;
		{Cancel}
{		if Control = cmCancel then begin
			GetwithLock := nil;
			dispose(DataItem, done);
			LastResult := rsLocked;                         {Return with problem}
{			exit;
		end;
		{Override - just continue}
{	end;{}
	{$ENDIF}

{	LastResult := rsOK; {OK so far then}

	{Lock requested}
	{$IFNDEF SingleUser}
{	if (LockLo = LkOn) then begin
		 DataItem^.SetLock(True);
		 Putat(RecNo, DataItem); {only main ID record is marked as locked, so just store that}
{	end;{}
	{$ENDIF}
{
	GetwithLock := DataItem;
end;

{Reads fixed-length string from Stream S. Saves having
to store length byte - useful esp for short strings, eg scodes}
procedure TDataStream.WriteFixedStr;
begin
	if length(FixedStr^)<LengthStr then FixedStr^ := PadSpaceR(FixedStr^,LengthStr);
	Write(FixedStr^[1], LengthStr);
end;

function TDataStream.ReadFixedStr;
var S : string;
begin
	Read(S[1], LengthStr);  {Read each character}
	S[0] := chr(LengthStr);   {Set length}
	ReadFixedStr := S;
end;

{Reads string written by WriteStr, always returning some kind of string}
function TDataStream.ReadStr : string;
var P : PString;
begin
	P := inherited ReadStr;                           {Set pointer to new string on heap}
	if P<>nil then begin                      {Check if nil}
		ReadStr := P^;                         {Set to contents read}
		FreeMem(P, length(P^)+1);              {Free heap of contents read}
	end else
		ReadStr := '';                          {Simply clear string - nothing on heap to free}
end;

{***************************************
***         FILE ADMIN               ***
***************************************}
constructor TFileAdmin.Init;
begin
{	fiType := Afitype;{}
	Name := NewStr(AName+' ');
	Count := 0;
	FilePtr := nil;
	CreatorFunc := ACreatorFunc;
{	Next := nil;{}
end;

destructor TFileAdmin.Done;
begin
{	if Next<>nil then dispose(Next, done);{}
	DisposeStr(Name);
	Close;
end;

procedure TFileAdmin.LogOn;
begin
{These safety checks were justincase, but I've never had any of them report,
as long as the fileadmin objects are used.  They do cause problems though
in the WP link, which runs through the admins closing files to release handles
for WP, then re-opening afterwards.  The main problem then comes with the
fact that index files always log on (or off) main data files, and if that
has been closed then it reports an error (someone using file but its closed)
See KWPLink unit}
{not any more - index (or admin) files no longer auto-log on/off data files}
	if (Count = 0) and (FilePtr <> nil) then ProgramError('Nobody using '+Name^+' but FilePtr<>nil', hcInternalErrorMsg);
	if (Count <> 0) and (FilePtr = nil) then ProgramError('Someone supposed to be using '+Name^+' but FilePtr = nil',
																																hcInternalErrorMsg);{}

	Count := Count +1;
	if FilePtr = nil then Open;
end;

procedure TFileAdmin.LogOff;
begin
	if (Count = 0) and (FilePtr <> nil) then ProgramError('Nobody using '+Name^+' but FilePtr<>nil', hcInternalErrorMsg);
{commented out after new file structure caused problems along the lines of the above comment under logon}
{	if (Count <> 0) and (FilePtr = nil) then ProgramError('Someone supposed to be using '+Name^+' but FilePtr = nil','');{}

	Count := Count -1;
	if Count<0 then ProgramError('Logged Off '+Name^+' too many times'#13#10'Count='+N2Str(Count), hcInternalErrorMsg);
	if (Count = 0) and (FilePtr <> nil) then Close;
end;

procedure TFileAdmin.Close;
begin
	if FilePtr<>nil then
		dispose(FilePtr, done);
	FilePtr := nil;
end;

procedure TFileAdmin.Open;
begin
	FilePtr := CreatorFunc;
end;

{=== Create new file admin & add to the chain ====}
procedure NewFileAdmin(const Afitype : byte; AName : string; ACreatorFunc : TFileCreator);
{var FileAdmin : PFileAdmin;{}
begin
	New(SharedStream[AfiType], init(AName, ACreatorFunc));
{	if FirstFileAdmin = nil then
		FirstFileAdmin := New(PFileAdmin, init(AfiType, AName, ACreatorFunc))
	else begin
		FileAdmin := FirstFileAdmin;
		while FileAdmin^.Next<>nil do FileAdmin := FileAdmin^.Next;

		FileAdmin^.Next := New(PFileAdmin, init(AfiType, AName, AcreatorFunc));
	end;{}
end;

{Should maybe someday get rid of this altogether...}
function FileAdmin(const fiType : byte) : PFileAdmin; {access to fileadmin chain}
{var F : PFileAdmin;{}
begin
	FileAdmin := SharedStream[fiType];
{	F := FirstFileAdmin;

	while (F<>nil) and (F^.fiType<>fiType) do F := F^.Next;

	FileAdmin := F;{}
end;


{=== Reference chain by fitype index =======}
function Stream(const fiType : byte) : PDataStream; {shorthand access through Fileadmin chain to stream}
{var F : PFileAdmin;{}
begin
	if SharedStream[fiType]<>nil then
		Stream := PDataStream(SharedStream[fiType]^.FilePtr)
	else
		Stream := nil;
{	F := FileAdmin(fiType);

	if F = nil then
		Stream := nil
	else
		Stream := PDataStream(F^.FilePtr); {all OK}
end;

{****************************************************
 ***               SHUT DOWN                      ***
 ****************************************************}

procedure ShutDownFiles;
{var FileAdmin : PFileAdmin;{}
var fiType : byte;
begin
	ThinkingOn('Shutting Down Files');
	for fiType := 1 to fiMaxfi do
		if SharedStream[fiType]<>nil then with SharedStream[fiType]^ do begin
			if Count<>0 then begin
				{$IFDEF fixit} ProgramWarning('Still '+N2Str(Count)+' logged onto '+Name^+' on shutdown', hcInternalErrorMsg); {$ENDIF}
				RecordError('DBASE WARNING:','Still '+N2Str(Count)+' "users" of '+Name^+' on shutdown','Closing anyway'){};
			end;
			Close;
		end;


{	FileAdmin := FirstFileAdmin;
	while FileAdmin<>nil do begin
		with FileAdmin^ do begin
			if Count<>0 then begin
				{$IFDEF fixit} {ProgramWarning('Still '+N2Str(Count)+' logged onto '+Name^+' on shutdown'); {$ENDIF}
{				RecordError('DBASE WARNING:','Still '+N2Str(Count)+' "users" of '+Name^+' on shutdown','Closing anyway'){};
{			end;
			Close;
		end;
		FileAdmin := FileAdmin^.Next;
	end;
	if FirstFileAdmin<>nil then dispose(FirstFileAdmin, done); {disposes of whole chain}
	ThinkingOff;
end;

{Close all adminned files - release handles to WP, etc}
procedure CloseAllFiles;
{var FileAdmin : PFileAdmin;{}
var fiType : byte;
begin
	for fitype := 1 to fiMaxfi do
		if SharedStream[fiType] <>nil then
			SharedStream[fiType]^.Close;

{	FileAdmin := FirstFileAdmin;
	while FileAdmin<>nil do begin
		FileAdmin^.Close;
		FileAdmin := FileAdmin^.Next;
	end;{}
end;

{Reopen from above}
procedure ReOpenAllFiles;
var FA : PFileAdmin;{}
		fitype : byte;
begin
	{Open all adminned files}
	{Slightly wierd problem; logging on to files that automatically log onto
	 other ones - eg history stream logs jimmy stream on as well, meaning that
	 on closedown, everythings OK; but on start up, by the time it reaches fiJimmy
	 it reckons Count is >0.  So we need to check FilePtr too to make sure it hasn't
	 already been set.  Do in numeric fi... order so that fijimmys (=1) is
		opened first}
	for fitype := 1 to fiMaxfi do begin
		FA := FileAdmin(fiType);
		if (FA<>nil) and
				(FA^.Count>0) and
					(FA^.FilePtr=nil) then
						FA^.Open;{}
	end;
end;


{*************************************
 ****       INITIALISATION         ***
 *************************************}
var I : byte;
begin
{$IFDEF fixit} writeln('Initialising Files unit'); {$ENDIF}
	ReadCSVPos := 0;
	ReadCSVString := '';

	{StreamError := @StreamErrorProc; {}
{	FirstFileAdmin := nil;{now an initialised constant thing}
	for I := 1 to fiMaxfi do SharedStream[I] := nil;

	RegisterTask(ShutDownTasks, 10, @ShutDownFiles);
end.

