unit Sb30hdr;

interface

uses
	SysUtils, WinTypes, WinProcs, Messages, Classes, Dialogs;

type

{
/*********************************************************************/
/* definitions of basic types and pointers to basic types            */
/*********************************************************************/
}

	{CHAR	=	Char; Already defined}
	USINT	=	Word;
	SSINT	=	Integer;
	ULINT	=	LongInt;
	SLINT	=	LongInt;

	UXINT	=	USINT;
	RAMINT	=	USINT;
	ERRINT	=	USINT;

	REAL	=	Double;

	HSBFILESYS	=	Pointer;
	HSBFILE		=	Pointer;
	HSBFIELD	=	Pointer;
	HSBINDEX	=	Pointer;

	LPCHAR		=	^Char;
	LPUSINT		=	^USINT;
	LPSSINT		=	^SSINT;
	LPULINT		=	^ULINT;
	LPSLINT		=	^SLINT;
	LPRAMINT	=	^RAMINT;
	LPREAL		=	^REAL;

	LPHSBFILESYS	=	^HSBFILESYS;
	LPHSBFILE		=	^HSBFILE;
	LPHSBFIELD		=	^HSBFIELD;
	LPHSBINDEX		=	^HSBINDEX;

{
/*********************************************************************/
/* definition of structures                                          */
/*********************************************************************/
}

	DATENAMES = record
		months	:	array [0..12,0..10] of CHAR;
		mnths	:	array [0..12,0..3] of CHAR;
		day		:	array [0..6,0..11] of CHAR;
	end;
	LPDATENAMES	=	^DATENAMES;

	DFORM = record
		Fsep	:	CHAR;
		Ssep	:	CHAR;
		Month	:	CHAR;
		Year	:	CHAR;
		Time	:	CHAR;
		Tflags	:	CHAR;
	end;
	LPDFORM	=	^DFORM;

	NFORM = record
		Flags		:	CHAR;
		Plus		:	CHAR;
		Noint		:	CHAR;
		Nodec		:	CHAR;
		Leading		:	CHAR;
		Trailing	:	CHAR;
	end;
	LPNFORM	=	^NFORM;

	NFORMDATA = record
		Decpoint	:	CHAR;
		Commapoint	:	CHAR;
		Trailcurr	:	CHAR;
		Currency	:	array [0..5] of CHAR;
	end;
	LPNFORMDATA	=	^NFORMDATA;

	KEYVAL = record
		size	:	RAMINT;
		key		:	LPCHAR;
	end;
	LPKEYVAL	=	^KEYVAL;

	{bagType1 only used internally by bagType2}
	bagType1 = record
		xstring	:	LPCHAR;
		len		:	RAMINT;
	end;

	{bagType2 only used internally by OPRND}
	bagType2 = record
		odubl	:	REAL;
		olong	:	SLINT;
		oword	:	SSINT;
		s		:	bagType1;
	end;

	OPRND = record
		optype	:	USINT;
		d		:	bagType2;
	end;
	LPOPRND = ^OPRND;

	FLDINFO = record
		fname	:	array [0..30] of CHAR;
		xtype	:	USINT;
		virt	:	CHAR;
		logical	:	CHAR;
		format	:	array [0..30] of CHAR;
	end;
	LPFLDINFO	=	^FLDINFO;

	FILEINFO = record
		recordcount	:	ULINT;
		blockcount	:	ULINT;
		blocksize	:	USINT;
		fileversion	:	USINT;
		hugefile	:	USINT;
		fieldcount	:	ULINT;
		indexcount	:	ULINT;
	end;
	LPFILEINFO	=	^FILEINFO;
{
/*********************************************************************/
/* manifest constants															 */
/*********************************************************************/

 /* FileOpenFile() parameter values */
}
const
	SBFILE_OPEN_ME_WRITE	=	1;
	SBFILE_OPEN_DENY_READ	=	2;
	SBFILE_OPEN_DENY_WRITE	=	4;
	SBFILE_OPEN_ME_DELETE	=	8;
	SBFILE_OPEN_DBASE		=	16;
	SBFILE_OPEN_LOCAL		=	64;

{
 /* FileRead() parameter values */
}
 	GETFIRST	=	1;
	GETLAST		=	2;
	GETNEXT		=	4;
	GETPREV		=	8;
	GETCURR		=	16;
	GETKNEXT	=	32;
	GETKPREV	=	64;

	GETLOCK		=	256;
	GETNOLOCK	=	8192;

{
 /* Type specifier in OPRND.optype and in FLDINFO.type */
 }
 	ASTRING	=	1;
	ADOUBLE	=	2;
	AWORD	=	4;
	ALONG	=	8;
	ADATE	=	16;
	ATIME	=	32;
	ANULL	=	64;

	SPY_PUSHPROC	=	WM_USER + 1000;
  	SPY_PASSED		=	WM_USER + 1001;
	SPY_RETURNED	=	WM_USER + 1002;
	SPY_POPPROC		=	WM_USER + 1003;

{
/*********************************************************************/
/* Class declarations														 */
/*********************************************************************/
}

Type

	TSBSession = class;
	TSBFile = class;
	TSBField = class;
	TSBIndex = class;

	TSBSession = class(TObject)
	public
		{Class Members}
		NumUsers	:	Word;
		NetFilePath	:	String;
		UserInfo	:	String;
		wnd			:	Hwnd;
		NumBuffers	:	Word;
		NumFiles	:	Word;
		OpenFiles	:	TList;

		{Superbase Handles}
		hSBFileSys	:	HSBFILESYS;

		function InitSession:ERRINT;
		function TermSession:ERRINT;
		function OpenFile(FileName: String; OpenMode: Word): Integer;
		function CloseFile(index: Integer):ERRINT;
		procedure CloseAll;
	end;

	TSBFile = class(TObject)
	public
		Session		:	TSBSession;
		FileName	:	String;
		OpenMode	:	Word;
		hSBFile		:	HSBFILE;
		SBIndex		:	TSBIndex;

		RecordCount	:	LongInt;
		BlockCount	:	Longint;
		BlockSize	:	Word;
		FileVersion	:	Word;
		HugeFile	:	Word;
		FieldCount	:	LongInt;
		IndexCount	:	LongInt;

		Fields		:	TList;
		Indexes		:	TList;

		function Open:ERRINT;
		function Close:ERRINT;
		procedure LoadFields;
		procedure ClearFields;
		procedure LoadIndexes;
		procedure ClearIndexes;
		procedure UpdateInfo;
		procedure ReadRecord;
		procedure SetIndex(value : String);
 		function IsDirty: Boolean;
		procedure WriteRecord(p_Force: Boolean);
		function Blank: Boolean;
		function Delete: Boolean;
		function Lock: Boolean;
		function UnLock: Boolean;
	end;

	TSBField = class(TObject)
	public
		SBFile		:	TSBFile;
		FieldIndex	:	ULINT;
		FieldName	:	String;
		FieldType	:	USINT;
		Virt		 :	String;
		Logical		:	String;
		Format		:	String;

		hSBField	:	HSBFIELD;

		Data		:	String;
		Dirty		:	Boolean;

		procedure Load;
		procedure Clear;
		procedure Read;
		procedure Write(p_Force : Boolean);
		procedure Assign(p_Value : String);

	end;

	TSBIndex = class(TObject)
	public
		SBFile		:	TSBFile;

		Index		:	ULINT;
		IndexName	:	String;
		IndexType	:	USINT;

		hSBIndex	:	HSBINDEX;

		procedure Load;
		procedure Clear;
		procedure SelectKey(p_Value : String);
		procedure SelectKeyInt(p_Value : Integer);
		procedure SelectKeyEx(p_Value : Pointer; p_PtrType : USINT);
		function  Select(p_Pos : USINT; p_Lock : Boolean): Boolean;
		procedure SelectFirst;
		procedure SelectPrevious;
		procedure SelectNext;
		procedure SelectLast;
		procedure SelectCurrent;
		function  Lock: Boolean;
		function  UnLock: Boolean;
	end;

implementation

{
/*********************************************************************/
/* function declarations														 */
/*********************************************************************/
}

{$DEFINE DEBUGGING}

function  FileInit( num_users :ULINT ;
								 net_file_path :LPCHAR ;
								 user_info :LPCHAR ;
								 wnd :HWND ;
								 numbuffers :USINT ;
								 numfiles :USINT ;
								 phfsys :LPHSBFILESYS ): ERRINT; far; external 'SBFILE30';
function  FileTerm( hfsys: HSBFILESYS ): ERRINT; far; external 'SBFILE30';
function  FileLogicChars( hfsys: HSBFILESYS ; logicchars: LPCHAR ): ERRINT; far; external 'SBFILE30';
function  FileNForm( hfsys: HSBFILESYS ; nform: LPNFORM ): ERRINT; far; external 'SBFILE30';
function  FileNFormData( hfsys: HSBFILESYS ; nformdata: LPNFORMDATA ): ERRINT; far; external 'SBFILE30';
function  FileDForm( hfsys: HSBFILESYS ; dform: LPDFORM ): ERRINT; far; external 'SBFILE30';
function  FileDateNames( hfsys: HSBFILESYS ; datenames: LPDATENAMES ): ERRINT; far; external 'SBFILE30';
function  FileOpenFile( hfsys: HSBFILESYS ; name: LPCHAR ; mode: USINT ; phfile: LPHSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileCreateFile( hfsys: HSBFILESYS ; name: LPCHAR ; hugefile: USINT ; str1: LPCHAR ; str2: LPCHAR ;
								str3: LPCHAR ; str4: LPCHAR ; str5: LPCHAR ; phfile: LPHSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileCloseFile( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
procedure FileInfoFile( hfile: HSBFILE ; fileinfo: LPFILEINFO ); far; external 'SBFILE30';
function  FileCountFields( hfile: HSBFILE ; pcount: LPULINT ): ERRINT; far; external 'SBFILE30';
function  FileCountIndexes( hfile: HSBFILE ; pcount: LPULINT ): ERRINT; far; external 'SBFILE30';
function  FileNumField( hfile: HSBFILE ; count: ULINT ; phfield: LPHSBFIELD ): ERRINT; far; external 'SBFILE30';
function  FileNumIndex( hfile: HSBFILE ; count: ULINT ; phindex: LPHSBINDEX ): ERRINT; far; external 'SBFILE30';
function  FileIndexField( hip: HSBINDEX ; phfield: LPHSBFIELD ): ERRINT; far; external 'SBFILE30';
function  FileFieldIndex( hfld: HSBFIELD ; phindex: LPHSBINDEX ): ERRINT; far; external 'SBFILE30';
function  FileNameField( hfld: HSBFIELD ; buffer: LPCHAR ; len: RAMINT ): ERRINT; far; external 'SBFILE30';
function  FileNameIndex( hip: HSBFIELD ; buffer: LPCHAR ; len: RAMINT ): ERRINT; far; external 'SBFILE30';
procedure FileInfoField( hfld: HSBFIELD ; fldinfo: LPFLDINFO ); far; external 'SBFILE30';
function  FileKeyValue( hfile: HSBFILE ; oprnd: LPOPRND ; keyval: LPKEYVAL ): ERRINT; far; external 'SBFILE30';
function  FileKeyValueExt( hfile: HSBFILE; optype: USINT; olong: SLINT; odubl: REAL; ostr: LPCHAR;
				pksize: LPRAMINT; pk: LPCHAR; ksize: RAMINT): ERRINT; far; external 'SBFILE30';
function  FileValue( hfield: HSBFIELD ; resp: USINT ; oprnd: LPOPRND ; strbuff: LPCHAR ;
				strlen: RAMINT ): ERRINT; far; external 'SBFILE30';
function  FileStringValue( hfield: HSBFIELD ; resp: USINT ; strbuff: LPCHAR ; strlen: RAMINT ): ERRINT;
				far; external 'SBFILE30';
function  FileAssign( hfield: HSBFIELD ; resp: USINT ; oprnd: LPOPRND ): ERRINT; far; external 'SBFILE30';
function  FileStringAssign( hfield: HSBFIELD ; resp: USINT ; xstring: LPCHAR ): ERRINT;
				far; external 'SBFILE30';
function  FileRead( hfile: HSBFILE ; hip: HSBINDEX ; keyval: LPKEYVAL ; flag: USINT ): ERRINT; far; external 'SBFILE30';
function  FileWrite( hfile: HSBFILE ; leavelock: USINT ): ERRINT; far; external 'SBFILE30';
function  FileNew( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileDelete( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileUnlock( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileLockAll( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileUnlockAll( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';
function  FileAddField( hfile: HSBFILE ; str1: LPCHAR ; str2: LPCHAR ; str3: LPCHAR ;
				str4: LPCHAR ; str5: LPCHAR ; phfield: LPHSBFIELD ): ERRINT; far; external 'SBFILE30';
function  FileAddIndex( hfield: HSBFIELD ; unique: UXINT ; phindex: LPHSBINDEX ): ERRINT; far; external 'SBFILE30';
function  FileRemoveIndex( hindex: HSBINDEX ): ERRINT; far; external 'SBFILE30';
function  FileSaveDef( hfile: HSBFILE ): ERRINT; far; external 'SBFILE30';

{
	Push/Pop Proc Bag
}

procedure PushProc(s	:	String);
var
	b	:	array [0..255] of Char;
begin
	StrPCopy(@b, s);
   SendMessage(FindWindow('TSBAPISPY',PChar(0)), SPY_PUSHPROC, 0, LongInt(@b));
end;

procedure PopProc;
begin
	SendMessage(FindWindow('TSBAPISPY',PChar(0)), SPY_POPPROC, 0, 0);
end;

{
/*********************************************************************/
/* TSBSession														 */
/*********************************************************************/
}

function TSBSession.InitSession: ERRINT;
var
	l_NetFilePath	:	array[0..255] of Char;
	l_UserInfo		:	array[0..255] of Char;
	l_Error			:	ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBSession.InitSession');
{$ENDIF}

	StrPCopy(l_NetFilePath, NetFilePath);
	StrPCopy(l_UserInfo, UserInfo);
	l_Error := FileInit( NumUsers, @l_NetFilePath, @l_UserInfo,
								wnd, NumBuffers, NumFiles, @hSBFileSys);
	OpenFiles := TList.Create;
	InitSession := l_Error;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBSession.TermSession: ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBSession.TermSession');
{$ENDIF}

	CloseAll;
	TermSession := FileTerm(hSBFileSys);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBSession.OpenFile(FileName: String; OpenMode: Word): Integer;
var
	l_SBFile	:	TSBFile;
	l_Error	:	ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBSession.OpenFile');
{$ENDIF}

	l_SBFile			:= TSBFile.Create;
	l_SBFile.Session	:= Self;
	l_SBFile.FileName	:= FileName;
	l_SBFile.OpenMode	:= OpenMode;
	l_Error :=	l_SBFile.Open;
	if l_Error = 0 then
		Openfile := OpenFiles.Add(l_SBFile)
	else
		OpenFile := -1;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBSession.CloseAll;
var
	i	:	Integer;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBSession.CloseAll');
{$ENDIF}

	for i	:=	OpenFiles.Count - 1 DownTo 0 do
			CloseFile(i);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBSession.CloseFile(index: Integer):ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBSession.CloseFile');
{$ENDIF}

	if OpenFiles.Items[index] <> nil then
		begin
		CloseFile := TSBFile(OpenFiles.Items[index]).Close;
		TSBFile(OpenFiles.Items[index]).Free;
		OpenFiles.Delete(index);
		end;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;


{
/*********************************************************************/
/* TSBFile															 */
/*********************************************************************/
}

function TSBFile.Open:ERRINT;
var
	l_szFileName	:	array[0..255] of Char;
	l_UserInfo		:	array[0..255] of Char;
	l_FileInfo		:	FILEINFO;
	l_Error			:	ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Open');
{$ENDIF}

	StrPCopy(l_szFileName, FileName);
	l_Error := FileOpenFile( Session.hSBFileSys , @l_szFileName,
			OpenMode , @hSBFile);
	if (l_Error = 0) then
		begin
		UpdateInfo;
		Fields := TList.Create;
		Indexes := TList.Create;
		LoadFields;
		LoadIndexes;
		SetIndex(TSBIndex(Indexes.Items[0]).IndexName);
   	end;

	Open := l_Error;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.Close	:	ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Close');
{$ENDIF}

	ClearFields;
	Close := FileCloseFile( hSBFile );
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.LoadFields;
var
	i			:	ULINT;
	l_SBField	:	TSBField;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.LoadFields');
{$ENDIF}

	for i := 0 to FieldCount-1 do
		begin
			l_SBField := TSBField.Create;
			l_SBField.SBFile 		:= Self;
			 l_SBField.FieldIndex := i;
			l_SBField.Load;
			Fields.Add(l_SBField)
		end;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.ClearFields;
var
	index	:	Integer;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.ClearFields');
{$ENDIF}

	for index	:=	Fields.Count - 1 Downto 0 do
		if Fields.Items[index] <> nil then
			begin
				TSBField(Fields.Items[index]).Clear;
				TSBField(Fields.Items[index]).Free;
				Fields.Delete(index);
				end;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.LoadIndexes;
var
	i			:	ULINT;
	l_SBIndex	:	TSBIndex;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.LoadIndexes');
{$ENDIF}

{
	l_SBIndex := TSBIndex.Create;
	l_SBIndex.SBFile := Self;
	l_SBIndex.Index := -1;
	l_SBIndex.IndexName	:= '( None )';
	l_SBIndex.hSBIndex	:= HSBINDEX(0);
	l_SBIndex.IndexType	:= 0;
	Indexes.Add(l_SBIndex);
}

	i	:=	0;
	while (i <= (IndexCount - 1)) do
		begin
		l_SBIndex := TSBIndex.Create;
		l_SBIndex.SBFile := Self;
		l_SBIndex.Index := i;
		l_SBIndex.Load;
		Indexes.Add(l_SBIndex);

		i := i + 1;
		end;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.ClearIndexes;
var
	index	:	Integer;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.ClearIndexes');
{$ENDIF}


	index	:=	IndexCount - 1;
	while (index >= 0) do
		begin
		if Indexes.Items[index] <> nil then
			begin
			TSBIndex(Indexes.Items[index]).Clear;
			TSBIndex(Indexes.Items[index]).Free;
			Indexes.Delete(index);
		   	end;

		index := index - 1;
		end ;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.UpdateInfo;
var
	l_FileInfo	:	FILEINFO;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.UpdateInfo');
{$ENDIF}

	FileInfoFile(hSBFile, @l_FileInfo);
	RecordCount	:= l_FileInfo.RecordCount;
	BlockCount	:= l_FileInfo.BlockCount;
	BlockSize	:= l_FileInfo.BlockSize;
	FileVersion	:= l_FileInfo.FileVersion;
	HugeFile	:= l_FileInfo.HugeFile;
	FieldCount	:= l_FileInfo.FieldCount;
	IndexCount	:= l_FileInfo.IndexCount;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.ReadRecord;
var
	i	: Integer;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.ReadRecord');
{$ENDIF}

	For i := 0 to Fields.Count-1 do
		TSBField(Fields.Items[i]).Read;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.SetIndex(value : String);
var
	i		:	Integer;
	l_Found	:	Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.SetIndex');
{$ENDIF}

	l_Found := False;

	i := 0;
	while (i <= (IndexCount - 1)) do
		begin
		if UpperCase(TSBIndex(Indexes.Items[i]).IndexName) = UpperCase(value) then
			begin
			SBIndex := TSBIndex(Indexes.Items[i]);
			l_Found := True;
			 end;

		i := i + 1;
		end;
	if not l_Found then
		ShowMessage(value + ' Index Not Found');
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.IsDirty : Boolean;
var
	i		:	Integer;
	l_Dirty	:	Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.IsDirty');
{$ENDIF}
	i := Fields.Count - 1;
	l_Dirty := False;
   while ( (i >= 0) and (not l_Dirty)) do
		begin
		l_Dirty := (l_Dirty or TSBField(Fields.Items[i]).Dirty);
		i := i -1;
       end;
   IsDirty := l_Dirty;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBFile.WriteRecord(p_Force: Boolean);
var
	i		:	Integer;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Write');
{$ENDIF}
	if (p_Force or IsDirty) then
		begin
		i := Fields.Count - 1;
		while (i > -1) do
			begin
			TSBField(Fields.Items[i]).Write(p_Force);
			i := i - 1;
	       end;
		FileWrite(hSBFile, GETNOLOCK);
       end;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.Blank: Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Blank');
{$ENDIF}
	Blank := (FileNew(hSBFile) = 0);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.Delete: Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Delete');
{$ENDIF}
	Delete := (FileDelete(hSBFile) = 0);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.Lock: Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Lock');
{$ENDIF}
	Lock := SBIndex.Lock;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBFile.UnLock: Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBFile.Lock');
{$ENDIF}
	UnLock := SBIndex.UnLock;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

{
/*********************************************************************/
/* TSBField															 */
/*********************************************************************/
}
procedure TSBField.Load;
var
	l_FldInfo		: FLDINFO;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBField.Load');
{$ENDIF}

	FileNumField( SBFile.hSBFile, FieldIndex, @hSBField);
	FileInfoField(hSBField, @l_FldInfo);
	FieldName	:= StrPas(@l_FldInfo.fname);
	FieldType	:= l_FldInfo.xType;
	Format		:= StrPas(@l_FldInfo.format);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBField.Clear;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBField.Clear');
{$ENDIF}

	{ Nothing to do No SBFILE30 FreeField type function}

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBField.Read;
var
	l_Buffer	:	array[0..255] of Char;
	l_Error		:	ERRINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBField.Read');
{$ENDIF}

	l_Error := FileStringValue(hSBField, USINT(0), @l_Buffer, RAMINT(255));
	if l_Error = 0 then
		begin
		Data := StrPas(@l_Buffer);
		Dirty := False;
		end
	else
		ShowMessage('FileStringValue() Error ' + IntToStr(l_Error));
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBField.Write(p_Force : Boolean);
var
	l_Error		:	ERRINT;
	l_Buffer	:	String;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBField.Write');
{$ENDIF}
	if (p_Force or Dirty) then
		begin
		l_Buffer := Data + #0;
		l_Error := FileStringAssign(hSBField, USINT(0),@l_Buffer[1]);
		Dirty := (l_Error = 0);
		end;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBField.Assign(p_Value : String);
begin
{$IFDEF DEBUGGING}
		PushProc('TSBField.Assign');
{$ENDIF}

   Dirty := (Dirty or (Data <> p_Value));
	Data := p_Value;

{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}

end;

{
/*********************************************************************/
/* TSBIndex															 */
/*********************************************************************/
}
procedure TSBIndex.Load;
var
	l_Buffer	:	array[0..30] of Char;
	l_FldInfo	:	FLDINFO;
	l_hSBField	:	HSBFIELD;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.Load');
{$ENDIF}

	FileNumIndex( SBFile.hSBFile, Index, @hSBIndex);
	FileNameIndex (hSBIndex, @l_Buffer, RAMINT(30));

	FileIndexField (hSBIndex, @l_hSBField);
	FileInfoField(l_hSBField, @l_FldInfo);

	IndexName	:= StrPas(@l_Buffer);
	IndexType	:= l_FldInfo.xType;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.Clear;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.Clear');
{$ENDIF}

	{ Nothing to do No SBFILE30 FreeIndex type function}
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBIndex.Select(p_Pos : USINT; p_Lock : Boolean): Boolean;
var
	l_Error		:	ERRINT;
	l_LockFlag	:	USINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.Select');
{$ENDIF}
	if p_Lock then
   	l_LockFlag := GETLOCK
	else
   	l_LockFlag := GETNOLOCK;

	Select := (FileRead(SBFile.hSbFile, hSBIndex, LPKEYVAL(0), p_Pos + l_LockFlag) = 0);
	SBFile.ReadRecord;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

function TSBIndex.Lock: Boolean;
begin
	Lock := Select(GETCURR, True);
end;

function TSBIndex.UnLock: Boolean;
begin
	UnLock := Select(GETCURR, False);
end;

procedure TSBIndex.SelectFirst;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectFirst');
{$ENDIF}

	Select(GETFIRST, False);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectPrevious;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectPrevious');
{$ENDIF}

	Select(GETPREV,False);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectNext;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectNext');
{$ENDIF}

	Select(GETNEXT,False);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectLast;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectLast');
{$ENDIF}

	Select(GETLAST,False);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectCurrent;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectCurrent');
{$ENDIF}

	Select(GETCURR,False);
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectKey(p_Value : String);
var
	l_KeyVal	:	KEYVAL;
	l_SearchVal	:	array[0..255] of Char;
	l_Error		:	ERRINT;
	l_Buffer	:	array[0..255] of Char;
	l_Temp		:	array[0..255] of Char;
	l_PasTemp	:	string;
	l_PChar		:	PChar;
	l_RamInt	:	RAMINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectKey');
{$ENDIF}

	StrPCopy(l_SearchVal, p_Value);

	l_KeyVal.Key := @l_Buffer;
	l_KeyVal.Size := 255;

	l_Error := FileKeyValueExt(SBFile.hSBFile, ASTRING, 0,0, @l_SearchVal,
					@l_RamInt, @l_Buffer, 255);

	if l_Error = 0 then
		l_Error := FileRead(SBFile.hSBFile, hSBIndex, @l_KeyVal, GETNOLOCK);

	SBFile.ReadRecord;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectKeyInt(p_Value : Integer);
var
	l_KeyVal	:	KEYVAL;
	l_SearchVal	:	array[0..255] of Char;
	l_Error		:	ERRINT;
	l_Buffer	:	array[0..255] of Char;
	l_Temp		:	array[0..255] of Char;
	l_PasTemp	:	string;
	l_PChar		:	PChar;
	l_RamInt	:	RAMINT;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectKeyInt');
{$ENDIF}

	l_KeyVal.Key := @l_Buffer;
	l_KeyVal.Size := 255;

	l_Error := FileKeyValueExt(SBFile.hSBFile, AWORD, p_Value,0, LPCHAR(0),
					@l_RamInt, @l_Buffer, 255);

	if l_Error = 0 then
		l_Error := FileRead(SBFile.hSBFile, hSBIndex, @l_KeyVal, GETNOLOCK);

	SBFile.ReadRecord;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

procedure TSBIndex.SelectKeyEx(p_Value : Pointer; p_PtrType : USINT);
type
	IntPtr		=	^Integer;
   StrPtr		=	^String;
	DateTimePtr	=	^TDateTime;
var
	l_KeyVal	:	KEYVAL;
	l_SearchVal	:	array[0..255] of Char;
	l_Error		:	ERRINT;
	l_Buffer	:	array[0..255] of Char;
	l_Temp		:	array[0..255] of Char;
	l_PasTemp	:	string;
	l_PChar		:	PChar;
	l_RamInt	:	RAMINT;
   l_ALong		:	LongInt;
	l_ADateTime	:	TDateTime;
	l_Valid		:	Boolean;
begin
{$IFDEF DEBUGGING}
		PushProc('TSBIndex.SelectKeyEx');
{$ENDIF}

	l_Valid := True;

	case IndexType of
	 	ASTRING:
			begin
			case p_PtrType of
           	ASTRING:
					l_PasTemp := StrPtr(p_Value)^;
				ADOUBLE:
					l_Valid := False;
				AWORD,ALONG:
               	l_PasTemp := IntToStr(IntPtr(p_Value)^);
				ADATE:
					l_Valid := False;
				ATIME:
					l_Valid := False;
				ANULL:
					l_Valid := False;
				end;
			if l_Valid then
   			begin
				StrPCopy(l_SearchVal, l_PasTemp);
				l_Error := FileKeyValueExt(SBFile.hSBFile, ASTRING, 0,0, @l_SearchVal,
							@l_RamInt, @l_Buffer, 255);
				end;
           end;
		ADOUBLE:
			l_Valid := False;
		AWORD,ALONG:
			begin
			case p_PtrType of
           	ASTRING:
					l_ALong := StrToInt(StrPtr(p_Value)^);
				ADOUBLE:
					l_Valid := False;
				AWORD,ALONG:
					l_ALong := IntPtr(p_Value)^;
				ADATE:
					l_Valid := False;
				ATIME:
					l_Valid := False;
				ANULL:
					l_Valid := False;
 				end;
			if l_Valid then
				l_Error := FileKeyValueExt(SBFile.hSBFile, ALONG, l_ALong,0, LPCHAR(0),
					@l_RamInt, @l_Buffer, 255);
			end;
		ADATE:
			begin
			case p_PtrType of
           	ASTRING:
					begin
					l_ADateTime := StrToDate(StrPtr(p_Value)^);
					l_ALong := Round(l_ADateTime);
					end;
				ADOUBLE:
					l_Valid := False;
				AWORD,ALONG:
					l_ALong := IntPtr(p_Value)^;
				ADATE:
					l_ALong := Round(DateTimePtr(p_Value)^);
				ATIME:
					l_Valid := False;
				ANULL:
					l_Valid := False;
 				end;
			if l_Valid then
				begin
				if (not((l_ALong > 639785) and (l_ALong < 639797))) then
					begin
					if l_ALong > 639785 then l_ALong := l_ALong - 11;
					l_Error := FileKeyValueExt(SBFile.hSBFile, ALONG, l_ALong,0, LPCHAR(0),
							@l_RamInt, @l_Buffer, 255);
               	end;
				end;
			end;
		ATIME:
			l_Valid := False;
		ANULL:
			l_Valid := False;
		end;

	l_KeyVal.Key := @l_Buffer;
	l_KeyVal.Size := 255;

	if (l_Error = 0) and l_Valid then
		l_Error := FileRead(SBFile.hSBFile, hSBIndex, @l_KeyVal, GETNOLOCK);

	SBFile.ReadRecord;
{$IFDEF DEBUGGING}
		PopProc;
{$ENDIF}
end;

end.