Program select;
{
* PROGRAM: Object oriented API samples.
* MODULE: 03.select.pas
* DESCRIPTION:
* A sample of running SELECT statement without parameters.
* Prints string fields in a table, coercing VARCHAR to CHAR.
* Learns how to coerce output data in prepared statement
* and execute it.
*
* Example for the following interfaces:
*
* IStatement - SQL statement execution
* IMessageMetadata - describe input and output data format
* IResultSet - fetch data returned by statement after execution
*
* Run something like this to build the program :
*
* fpc -Fu./common -Fu/opt/firebird/include/firebird -FUlib 03.select.pas
*
*
* The contents of this file are subject to the Initial
* Developer's Public License Version 1.0 (the "License");
* you may not use this file except in compliance with the
* License. You may obtain a copy of the License at
* https://www.ibphoenix.com/about/firebird/idpl.
*
* Software distributed under the License is distributed AS IS,
* WITHOUT WARRANTY OF ANY KIND, either express or implied.
* See the License for the specific language governing rights
* and limitations under the License.
*
* The Original Code was created by Paul Reeves
* for the Firebird Open Source RDBMS project.
* Most of the code for GetOutput was taken from Denis
* Simonov's UDR-Book project.
*
* Copyright (c) 2020 Paul Reeves <preeves@ibphoenix.com>
* and all contributors signed below.
*
* All Rights Reserved.
* Contributor(s): ______________________________________. }
{$mode Delphi}{$H+}
Uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads
, {$ENDIF} {$ENDIF}
SysUtils
, Firebird
, strutils
, FbCharsets
;
// Record to store received metadata
Type
TField = Record
fieldname: String;
fieldtype: Cardinal;
fieldlength: Integer;
offset: Integer;
sqlnullind: Wordbool;
charset: TFBCharSet;
charLength: Integer;
fieldvalue: String;
End;
Var
// master and status are required for all access to the API.
// This is main interface of firebird, and the only one
// for getting which there is special function in our API
master: IMaster;
// Status is used to return error descriptions to user
status: IStatus;
// Provides some miscellaneous utilities.
util: IUtil;
// Provider is needed to start to work with database (or service)
prov: IProvider;
// Attachment and Transaction contain methods to work with
// database attachment and transaction
att: IAttachment;
tra: ITransaction;
tpb: IXpbBuilder;
// to prepare an sql statement
stmt: IStatement;
// We geain access to the result set with a cursor
curs: IResultSet;
// Retrieve info about metadata of a statement
meta: IMessageMetadata;
builder: IMetadataBuilder;
// Store the meta data of each field in the result set
fields: Array Of TField;
// Store the titles of each field in the result set
title: String = '';
// msg is a pointer to each row in the result set.
msg: Pointer;
msgLen: Cardinal;
counter: Integer;
Const
// Firebird types
SQL_VARYING = 448; // VARCHAR
SQL_TEXT = 452; // CHAR
Procedure PrintError(AMaster: IMaster; AStatus: IStatus);
Var
maxMessage: Integer;
outMessage: PAnsiChar;
Begin
maxMessage := 256;
outMessage := StrAlloc(maxMessage);
AMaster.getUtilInterface.formatStatus(outMessage, maxMessage, AStatus);
writeln(outMessage);
StrDispose(outMessage);
End;
Function GetOutput(AStatus: IStatus; ABuffer: PByte; AMeta: IMessageMetadata; AUtil: IUtil;
AFieldsArray: Array Of TField): UnicodeString;
Var
i: Integer;
NullFlag: Wordbool;
pData: PByte;
CharBuffer: TBytes;
StringValue: UnicodeString;
current_field: TField;
Begin
Result := '';
For i := 0 To length(AFieldsArray) - 1 Do Begin
current_field := AfieldsArray[i];
With current_field Do Begin
NullFlag := PWordBool(ABuffer + AMeta.getNullOffset(AStatus, i))^;
If NullFlag Then Begin
StringValue := 'NULL';
continue;
End;
// get a pointer to the field data
pData := ABuffer + AMeta.getOffset(AStatus, i);
pData := ABuffer + offset;
Case fieldType Of
SQL_VARYING:
Begin
SetLength(CharBuffer, fieldLength);
// For VARCHAR, the first 2 bytes are the length
charLength := PSmallint(pData)^;
// For VARCHAR, the first 2 bytes are the length in bytes
// so we copy it to the buffer starting at 3 bytes
Move((pData + 2)^, CharBuffer[0], fieldLength);
StringValue := charset.GetString(CharBuffer, 0, charLength);
End;
Else
StringValue := ' Fieldtype not handled.';
End; // case fieldType of
If Result = '' Then
Result := Result + UnicodeString(PadRight(UTF8Encode(StringValue), fieldLength))
Else
Result := Result + ' ' + UnicodeString(PadRight(UTF8Encode(StringValue), fieldLength));
End; // end with current_field
End; // for i := 0 to length(AFieldsArray) - 1 do begin
End; // function GetOutput
Begin
master := fb_get_master_interface;
status := master.getStatus;
// Here we get access to the helper utility interfaces
// no errors can occur - this function will always succeed
util := master.getUtilInterface;
// the main dispatcher is returned by a call to IMaster
// no errors can occur - this function will always succeed
prov := master.getDispatcher;
Try
Try
// attach to employee db
// We assume that ISC_USER and ISC_PASSWORD env vars are set. Otherwise,
// see code in 01.create for an example of setting the un/pw via the dpb.
att := prov.attachDatabase(status, 'employee', 0, nil);
writeln('Attached to database employee.fdb');
// start read only transaction
tpb := util.getXpbBuilder(status, IXpbBuilder.TPB, nil, 0);
tpb.insertTag(status, isc_tpb_read_committed);
tpb.insertTag(status, isc_tpb_no_rec_version);
tpb.insertTag(status, isc_tpb_wait);
tpb.insertTag(status, isc_tpb_read);
// start transaction
tra := att.startTransaction(status, tpb.getBufferLength( status ), tpb.getBuffer( status ));
// prepare statement
stmt := att.prepare(status, tra, 0, 'Select last_name, first_name, phone_ext from phone_list ' +
'where location = ''Monterey'' order by last_name, first_name', 3,
IStatement.PREPARE_PREFETCH_METADATA);
// get list of columns
meta := stmt.getOutputMetadata(status);
builder := meta.getBuilder(status);
SetLength(fields, meta.getCount(status));
// parse columns list & coerce datatype(s)
For counter := 0 To length(fields) - 1 Do Begin
If ((meta.getType(status, counter) = (SQL_VARYING Or SQL_TEXT))) Then
builder.setType(status, counter, SQL_TEXT);
fields[counter].fieldname := meta.getField(status, counter);
End;
// release automatically created metadata
// metadata is not database object, therefore no specific call to close it
meta.Release;
// get metadata with coerced datatypes
meta := builder.getMetadata(status);
// builder is no longer needed
builder.Release;
builder := nil;
// now get field info
For counter := 0 To length(fields) - 1 Do Begin
If fields[counter].fieldname <> '' Then Begin
fields[counter].fieldlength := meta.getLength(status, counter);
fields[counter].offset := meta.getOffset(status, counter);
fields[counter].fieldType := meta.getType(status, counter) And Not 1;
Case fields[counter].fieldType Of
SQL_TEXT, SQL_VARYING:
fields[counter].charset := TFBCharSet(meta.getCharSet(status, counter));
Else
;
End;
// Set the title line for later use.
If title = '' Then
title := title + fields[counter].fieldname.PadRight(fields[counter].fieldlength)
Else
title := title + ' ' + fields[counter].fieldname.PadRight(fields[counter].fieldlength);
End;
End;
// open cursor
curs := stmt.openCursor(status, tra, nil, nil, meta, 0);
// allocate output buffer
msgLen := meta.getMessageLength(status);
msg := AllocMem(msgLen);
counter := 0;
While curs.fetchNext(status, msg) = IStatus.RESULT_OK Do Begin
If ((counter Mod 10) = 0) Then Begin
writeln('');
writeln(title);
End;
Inc(counter);
WriteLn(GetOutput(status, msg, meta, util, fields));
End;
// What is correct way to close and release?
// close interfaces
curs.Close(status);
stmt.Free(status);
meta.Release();
tra.commit(status);
att.detach(status);
Except
on e: FbException Do
PrintError(master, e.getStatus);
End;
Finally
If assigned(meta) Then
meta.Release;
If assigned(builder) Then
builder.Release;
If assigned(curs) Then
curs.Release;
If assigned(stmt) Then
stmt.Release;
If assigned(tra) Then
tra.Release;
If assigned(att) Then
att.Release;
If assigned(tpb) Then
tpb.dispose;
prov.Release;
status.dispose;
End;
End.