program onerror (output);
DATABASE PERS = FILENAME 'PERSONNEL';
var
RDB$_LOCK_CONFLICT : [value,external] integer;
i : integer;
error : boolean;
procedure handle_error;
begin
if RDB$STATUS = RDB$_LOCK_CONFLICT
then
writeln ('database unavailable right now')
else
begin
writeln ('Unexpected Error, Application Terminating');
RDML$SIGNAL_ERROR(RDB$MESSAGE_VECTOR)
end;
end;
begin
for i := 1 to 100 do
begin
error := FALSE;
READY PERS;
START_TRANSACTION READ_WRITE NOWAIT
RESERVING EMPLOYEES FOR EXCLUSIVE WRITE
ON ERROR
handle_error;
error := TRUE;
END_ERROR;
if not error then
begin
{perform some read_write operation on the EMPLOYEES relation}
writeln ('Accessing EMPLOYEES...');
COMMIT;
FINISH;
end;
end;
end.