Here this is a small unit that has procedures to initialize, dispose, save and load clients and bookrefs keep in mind that I have compiled once to make sure that there are no type errors but that is as far as my tests wend so although you have the the borders explained there you need to test it and weed out any details that need weeding.
unit uClients;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TBookRef = record
BookID :Int64;
CheckOutDate :TDateTime;
end;
TAddress = record
StreetName :string[100];
StreetNo :string[10];
Zip :string[10];
City,
Country :string[80];
end;
TBookRefArray = array of TBookRef;
PBookRefArray = ^TBookRefArray;
TBookOut = record
Case integer of
1 : (BooksOut:PBookRefArray);
2 : (Count:PtrInt);
end;
TClient = Record
ID :String[5];
Name :String[50];
Surname :String[50];
Address :TAddress;
case byte of
1 :(BookCount:Int64; StartIndex:Int64);
2 :(BooksOut:PBookRefArray);
End;
TClientArray = array of TClient;
TClientFile = file of TClient;
TBookRefFile = file of TBookRef;
procedure InitAddress(var aAddress:TAddress);
procedure InitClient(var aClient:TClient);
function NewClient:TClient;
procedure AddNewBook(var aClient:TClient; const aBookRef:TBookRef);
procedure DeleteBookRef(var aClient:TClient; const aBookRef:TBookRef);
procedure DisposeClient(var aClient:TClient);
function BookRefCompare(const BookRef1, BookRef2:TBookRef):Integer;
function SaveClient(const aClient:TClient; var aFile:TClientFile; var aRefFile:TBookRefFile):Integer;
function SaveClients(const aClients:TClientArray; var aFile:TClientFile; var aRefFile:TBookRefFile):Integer;
function SaveBookRefs(const aBookRefArray :TBookRefArray; var aFile:TBookRefFile):Integer;
function LoadBookRefs(const aBookRefArray :TBookRefArray; var aFile:TBookreFile; const aRefCount:Int64):Integer;
function LoadClient(var aClient :TClient; var aClientFile:TClientFile; var aRefFile:TBookRefFile):Integer;
function LoadClients(var aClients :TClientArray; var aClientFile:TClientFile; var aRefFile:TBookRefFile):Integer;
implementation
function BookRefCompare(const BookRef1, BookRef2:TBookRef):Integer;
begin
if BookRef1.BookID = BookRef2.BookID then Result := 0 else
If BookRef1.BookID > BookRef2.BookID then Result := 1 else
Result := -1;
end;
procedure InitAddress(var aAddress:TAddress);
begin
aAddress.City :='';
aAddress.Country :='';
aAddress.StreetName :='';
aAddress.Zip :='';
aAddress.StreetNo :='';
end;
procedure InitClient(var aClient:TClient);
begin
aClient.ID :='';
aClient.Name :='';
aClient.Surname :='';
InitAddress(aClient.Address);
aClient.BooksOut:=nil;
end;
procedure DisposeClient(var aClient:TClient);
begin
SetLength(aClient.BooksOut^, 0);
Dispose(aClient.BooksOut);
InitClient(aClient);
end;
Function NewClient:TClient;
begin
InitClient(Result);
New(Result.BooksOut);
SetLength(Result.BooksOut^,0);
end;
procedure AddNewBook(var aClient:TClient; const aBookRef:TBookRef);
begin
Setlength(aClient.BooksOut^, Length(aClient.BooksOut^)+1);
aClient.BooksOut^[High(aClient.BooksOut^)] := aBookRef;
end;
Procedure DeleteBookRef(var aClient:TClient; const aBookRef:TBookRef);
procedure MoveOnePosLeft(const StartPos:integer);
var
vCntr : integer;
begin
For vCntr := StartPos+1 to High(aClient.BooksOut^) do begin
aClient.BooksOut^[vCntr-1] := aClient.BooksOut^[vCntr];
end;
end;
var
Cntr:integer;
begin
For Cntr := Low(aClient.BooksOut^) to High(aClient.BooksOut^) do begin
if BookRefCompare(aClient.BooksOut^[Cntr], aBookRef) = 0 then begin
MoveOnePosLeft(Cntr+1);
Break;
end;
end;
end;
function SaveClient(const aClient:TClient; var aFile:TClientFile; var aRefFile:TBookRefFile):Integer;
var
vPos, vCount : Int64;
vClient : TClient;
begin
try
vClient := aClient;
vClient.StartIndex := FilePos(aRefFile);
vClient.BookCount := Length(aClient.BooksOut^);
SaveBookRefs(aClient.BooksOut^, aRefFile);
Write(aFile, aClient);
except
on E:EDivByZero do exit(-2);
on E:ERangeError do exit(-3);
on E:Exception do exit(-1); //This one catches all exceptions known exceptions must be handled before this line. //unknown error.
end;
Result := 0;//no error
end;
function SaveClients(const aClients :TClientArray; var aFile :TClientFile; var aRefFile :TBookRefFile) :Integer;
var
vCntr :Integer;
begin
Result := 0; //assume everything is OK.
for vCntr := Low(aClients) to High(aClients) do begin
Result := SaveClient(aClients[vCntr], aFile, aRefFile);
if Result <> 0 then Break;
end;
end;
function SaveBookRefs(const aBookRefArray :TBookRefArray; var aFile :TBookRefFile) :Integer;
var
vCntr:Integer;
begin
try
for vCntr := low(aBookRefArray) to High(aBookRefArray) do
Write(aFile, aBookRefArray[vCntr]);
except
on E:EDivByZero do exit(-2);
on E:ERangeError do exit(-3);
on E:Exception do exit(-1); //This one catches all exceptions known exceptions must be handled before this line. //unknown error.
end;
Result := 0;//all's well
end;
function LoadBookRefs(const aBookRefArray :TBookRefArray; var aFile:TBookreFile; const aRefCount:Int64):Integer;
var
vCntr : Integer =0;
begin
Result := 0;
try
SetLength(aBookRefArray,RefCount);
repeat
Read(aFile, aBookRefArray[vCntr]);
inc(vCntr);
until vCntr >= RefCount;
except
on E:EDivByZero do exit(-2);
on E:ERangeError do exit(-3);
on E:Exception do exit(-1); //This one catches all exceptions known exceptions must be handled before this line. //unknown error.
end;
end;
function LoadClient(var aClient :TClient; var aClientFile:TClientFile; var aRefFile:TBookRefFile):Integer;
var
vClient : TClient;
begin
Result := 0;
try
Read(aClientFile,vClient);
FileSeek(aRefFile, vClient.StartIndex);
LoadBookRefs(aClient.BooksOut^, aRefFile, vClient.BookCount);
aClient.ID := vClient.ID;
aClient.Name := vClient.Name;
aClient.Surname := vClient.Surname;
aClient.Address := vClient.Address;
except
on E:EDivByZero do exit(-2);
on E:ERangeError do exit(-3);
on E:Exception do exit(-1); //This one catches all exceptions known exceptions must be handled before this line. //unknown error.
end;
end;
function LoadClients(var aClients :TClientArray; var aClientFile:TClientFile; var aRefFile:TBookRefFile):Integer;
begin
repeat
SetLength(aClients,Length(aClients)+1);
Result := LoadClient(aClients[high(aClients)], aClientFile, aRefFile);
if Result <> 0 then Exit;
until EOF(aClientFile);
end;
end.