From e2842a1afd034c3865e68dd5905fe5f50b0cefbf Mon Sep 17 00:00:00 2001 From: Paul Reeves Date: Tue, 18 Aug 2020 18:57:02 +0200 Subject: [PATCH] Add some object pascal examples of the OO API --- examples/object_pascal/01.create.pas | 143 ++++++++ examples/object_pascal/02.update.pas | 224 +++++++++++++ examples/object_pascal/03.select.pas | 324 +++++++++++++++++++ examples/object_pascal/Readme.md | 48 +++ examples/object_pascal/common/FbCharsets.pas | 257 +++++++++++++++ examples/object_pascal/makefile | 66 ++++ 6 files changed, 1062 insertions(+) create mode 100644 examples/object_pascal/01.create.pas create mode 100644 examples/object_pascal/02.update.pas create mode 100644 examples/object_pascal/03.select.pas create mode 100644 examples/object_pascal/Readme.md create mode 100644 examples/object_pascal/common/FbCharsets.pas create mode 100644 examples/object_pascal/makefile diff --git a/examples/object_pascal/01.create.pas b/examples/object_pascal/01.create.pas new file mode 100644 index 0000000000..f1e30fd1ba --- /dev/null +++ b/examples/object_pascal/01.create.pas @@ -0,0 +1,143 @@ +{ + * PROGRAM: Object oriented API samples. + * MODULE: 01.create.pas + * DESCRIPTION: A sample of creating new database and new table in it. + * Run second time (when database already exists) to see + * how FbException is caught and handled by this code. + * + * Example for the following interfaces: + * IMaster - main inteface to access all the rest + * Status - returns the status of executed command + * Provider - main interface to access DB / service + * Attachment - database attachment interface + * Transaction - transaction interface + * Util - helper calls here and there + * XpbBuilder - build various parameters blocks + * + * Run something like this to build: fpc -Fu -Mdelphi 01.create.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 + * http://www.ibphoenix.com/main.nfs?a=ibphoenix&page=ibp_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 Alexander Peshkoff + * for the Firebird Open Source RDBMS project. + * + * Copyright (c) 2015 Alexander Peshkoff + * and all contributors signed below. + * + * All Rights Reserved. + * Contributor(s): ______________________________________. } + +Program create; + +uses Sysutils, Firebird; + +var + // Declare pointers to required interfaces + + // Status is used to return wide error description to user + st : IStatus; + + // This is main interface of firebird, and the only one + // for getting which there is special function in our API + master : IMaster; + util : IUtil; + + // XpbBuilder helps to create various parameter blocks for API calls + dpb : IXpbBuilder; + + // 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; + + procedure PrintError(s : IStatus); + var + maxMessage : Integer; + outMessage : PAnsiChar; + begin + maxMessage := 256; + outMessage := StrAlloc(maxMessage); + util.formatStatus(outMessage, maxMessage, s); + writeln(outMessage); + StrDispose(outMessage); + end; + +begin + // Here we get access to master interface and helper utility interface + // no error return may happen - these functions always succeed + master := fb_get_master_interface; + util := master.getUtilInterface; + + // status vector and main dispatcher are returned by calls to IMaster functions + // no error return may happen - these functions always succeed + st := master.getStatus; + prov := master.getDispatcher; + + try + // create DPB + dpb := util.getXpbBuilder(st, IXpbBuilder.DPB, nil, 0); + dpb.insertInt(st, isc_dpb_page_size, 4 * 1024); + dpb.insertString(st, isc_dpb_user_name, 'sysdba'); + dpb.insertString(st, isc_dpb_password, 'masterkey'); + + // create empty database + att := prov.createDatabase(st, 'fbtests.fdb', dpb.getBufferLength(st), dpb.getBuffer(st)); + writeln ('Database fbtests.fdb created'); + + // detach from database + att.detach(st); + att := nil; + + // remove unneeded any more tag from DPB + if dpb.findFirst(st, isc_dpb_page_size) + then dpb.removeCurrent(st); + + // attach it once again + att := prov.attachDatabase(st, 'fbtests.fdb', dpb.getBufferLength(st), dpb.getBuffer(st)); + writeln ('Re-attached database fbtests.fdb'); + + // start transaction + tra := att.startTransaction(st, 0, nil); + + // create table + att.execute(st, tra, 0, 'create table dates_table (d1 date)', 3, + nil, nil, nil, nil); // Input parameters and output data not used + + // commit transaction retaining + tra.commitRetaining(st); + writeln ('Table dates_table created'); + + // insert a record into dates_table + att.execute(st, tra, 0, 'insert into dates_table values (CURRENT_DATE)', 3, + nil, nil, nil, nil); // Input parameters and output data not used + + // commit transaction (will close interface) + tra.commit(st); + tra := nil; + + writeln ('Record inserted into dates_table'); + + // detach from database (will close interface) + att.detach(st); + att := nil; + + dpb.dispose; + dpb := nil; + except + on e: FbException do PrintError(e.getStatus); + end; + + prov.release; +end. diff --git a/examples/object_pascal/02.update.pas b/examples/object_pascal/02.update.pas new file mode 100644 index 0000000000..13cb6622f3 --- /dev/null +++ b/examples/object_pascal/02.update.pas @@ -0,0 +1,224 @@ +Program update; + +{* + * PROGRAM: Object oriented API samples. + * MODULE: 02.update.cpp + * DESCRIPTION: Run once prepared statement with parameters + * a few times, committing transaction after each run. + * Learns how to prepare statement, manually define parameters + * for it, execute that statement with different parameters + * and perform non-default error processing. + * + * Example for the following interfaces: + * IAttachment - database attachment + * ITransaction - transaction + * IStatement - SQL statement execution + * IMessageMetadata - describe input and output data format + * IMetadataBuilder - tool to modify/create metadata + * IStatus - return state holder + * + * Note that all updates are rolled back in this version. (see *** later) + * + * Run something like this to build the program : + * + * fpc -Fu./common -Fu/opt/firebird/include/firebird -FUlib -oupdate 02.update.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. + * + * All Rights Reserved. + * Contributor(s): ______________________________________. + * + *} + +{$mode Delphi}{$H+} + +Uses + SysUtils, + Firebird; + +Type + + Buffer = String [255]; + + +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 description to user + status: IStatus; + + // Provider is needed to start to work with database (or service) + prov: IProvider; + + // declare pointers to required interfaces + att: IAttachment; + tra: ITransaction; + + // Interface executes prepared SQL statement + stmt: IStatement; + + // Interfaces provides access to format of data in messages + meta: IMessageMetadata; + + // Interface makes it possible to change format of data or define it yourself + builder: IMetadataBuilder; + + Dept_Data: Array[0..4] Of String = ( '622', '100', '116', '900', '0' ); + Percent_data: Array[0..4] Of Double = ( 0.05, 1.00, 0.075, 0.10, 0 ); + + i: Integer; + InputBuffer: Buffer; + len: Integer; + + PPercent_inc: PChar; + PDept_no: PChar; + + +Const + UpdateString = 'UPDATE department SET budget = ? * budget + budget WHERE dept_no = ?'; + + SQL_DIALECT_V6 = 3; + SQL_DIALECT_CURRENT = SQL_DIALECT_V6; + SQL_TEXT = 452; // CHAR + SQL_DOUBLE = 480; // DOUBLE PRECISION + + + 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; + + + // Get the department and percent parameters for an example to run. + + +Begin + + master := fb_get_master_interface; + status := master.getStatus; + Try + + // the main dispatcher is returned by a call to IMaster + // no errors can occur - this function will always succeed + prov := master.getDispatcher; + + // 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 transaction + tra := att.startTransaction( status, 0, nil ); + + // prepare statement + stmt := att.prepare( status, tra, 0, UpdateString, SQL_DIALECT_CURRENT, 0 ); + + // build metadata + // IMaster creates empty new metadata in builder + builder := master.getMetadataBuilder( status, 2 ); + // set required info on fields + builder.setType( status, 0, SQL_DOUBLE + 1 ); + builder.setType( status, 1, SQL_TEXT + 1 ); + builder.setLength( status, 1, 3 ); + // IMetadata should be ready + meta := builder.getMetadata( status ); + // no need for builder any more + builder.Release( ); + builder := nil; + + len := meta.getMessageLength( status ); + If ( len > sizeof( InputBuffer ) ) Then + Raise Exception.Create( 'Input message length too big - cannot continue' ) + Else + FillChar( InputBuffer, SizeOf( InputBuffer ), 0 ); + + i := meta.getNullOffset( status, 0 ); + InputBuffer[i] := Char( 0 ); + i := meta.getNullOffset( status, 1 ); + InputBuffer[i] := Char( 0 ); + + Try + // locations of parameters in input message + PPercent_inc := PChar( @InputBuffer [meta.getOffset( status, 0 )] ); + PDept_no := PChar( @InputBuffer [meta.getOffset( status, 1 )] ); + For i := 0 To length( Dept_Data ) - 1 Do Begin + If ( Dept_Data [i] = '0' ) Or ( Percent_data [i] = 0 ) Then + break; + StrPCopy( PPercent_inc, Percent_data [i].ToString ); + StrPCopy( PDept_no, Dept_Data [i] ); + WriteLn( 'Increasing budget for department: ' + PDept_no + ' by ' + PPercent_inc + ' percent.' ); + Try + stmt.Execute( status, tra, meta, @InputBuffer, nil, nil ); + + // Save/Cancel each department's update independently. + // *** Change to commitRetaining() to see changes + // *** tra.commitRetaining(status); + tra.rollbackRetaining( status ); + Except + on E: FBException Do Begin + PrintError( master, status ); + tra.rollbackRetaining( status ); + End; + End; + End; + + stmt.Free( status ); + stmt := nil; + + meta.Release; + meta := nil; + + tra.commit( status ); + tra := nil; + + att.detach( status ); + att := nil; + Except + on E: FBException Do Begin + PrintError( master, status ); + tra.rollbackRetaining( status ); + End; + on E: Exception Do + WriteLn( E.Message ); + End; + + Finally + If assigned( meta ) Then + meta.Release; + If assigned( builder ) Then + builder.Release; + If assigned( stmt ) Then + stmt.Release; + If assigned( tra ) Then + tra.Release; + If assigned( att ) Then + att.Release; + + prov.Release; + status.dispose; + End; +End. diff --git a/examples/object_pascal/03.select.pas b/examples/object_pascal/03.select.pas new file mode 100644 index 0000000000..007b7462bb --- /dev/null +++ b/examples/object_pascal/03.select.pas @@ -0,0 +1,324 @@ +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 + * 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, 0, nil); + + // 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. + + diff --git a/examples/object_pascal/Readme.md b/examples/object_pascal/Readme.md new file mode 100644 index 0000000000..6c30083d98 --- /dev/null +++ b/examples/object_pascal/Readme.md @@ -0,0 +1,48 @@ +Object Pascal Examples for Firebird +=================================== + + +The aim of these examples is to copy as closely as possible the equivalent +C++ examples. The primary intention is to demonstrate how to make calls to +the new Firebird OO API. For this reason they should not be considered +examples of best practice. + +Project files for Delphi and Lazarus are not supplied. Project files take +up a lot of space and hide the simplicity of the sample programs. + +Each sample file can easily be converted into a project and the way to do +this is explained below. + + +Requirements +------------ + +The examples have been tested with the Free Pascal compiler on linux. +The code should work with Delphi but has not been tested. + + +Building and running the examples +--------------------------------- + +Just type make at the command line. +If you do not have a standard firebird installation be sure to change +the variables at the top of the make file. + + +Opening the code in Lazarus or Delphi +------------------------------------- + +Each example is a stand-alone program. To open and run it in your favourite +Object Pascal IDE you just have to convert the example to a project. In Lazarus +you would do the following to create a project from 03.select.pas: + + - Copy 03.select.pas and rename it select.lpr + - Open select.lpr as a project + - When prompted choose 'Simple Program' as the project template + - Go into Project options and add the following paths: + /opt/firebird/include/Firebird + common + +You can then compile and run the example through the debugger. + + diff --git a/examples/object_pascal/common/FbCharsets.pas b/examples/object_pascal/common/FbCharsets.pas new file mode 100644 index 0000000000..9cebc3f4b5 --- /dev/null +++ b/examples/object_pascal/common/FbCharsets.pas @@ -0,0 +1,257 @@ +{ + * PROGRAM: UDR samples. + * MODULE: FbCharsets.pas + * DESCRIPTION: Charset helpers. + * + * 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 Simonov Denis + * for the book Writing UDR Firebird in Pascal. + * + * Copyright (c) 2018 Simonov Denis + * and all contributors signed below. + * + * All Rights Reserved. + * Contributor(s): ______________________________________. } + +unit FbCharsets; + +{$IFDEF MSWINDOWS} +{$DEFINE WINDOWS} +{$ENDIF} +{$IFDEF FPC} +{$mode delphi} +{$ENDIF} + + +interface + +uses + Classes, SysUtils {$IFDEF WINDOWS}, windows {$ENDIF}; + +type + +// Firebird character sets +TFBCharSet = ( + CS_NONE = 0, // No Character Set + CS_BINARY = 1, // BINARY BYTES + CS_ASCII = 2, // ASCII + CS_UNICODE_FSS = 3, // UNICODE in FSS format + CS_UTF8 = 4, // UTF-8 + CS_SJIS = 5, // SJIS + CS_EUCJ = 6, // EUC-J + + CS_JIS_0208 = 7 , // JIS 0208; 1990 + CS_UNICODE_UCS2 = 8 , // UNICODE v 1.10 + + CS_DOS_737 = 9, + CS_DOS_437 = 10 , // DOS CP 437 + CS_DOS_850 = 11 , // DOS CP 850 + CS_DOS_865 = 12 , // DOS CP 865 + CS_DOS_860 = 13 , // DOS CP 860 + CS_DOS_863 = 14 , // DOS CP 863 + + CS_DOS_775 = 15, + CS_DOS_858 = 16, + CS_DOS_862 = 17, + CS_DOS_864 = 18, + + CS_NEXT = 19, // NeXTSTEP OS native charset + + CS_ISO8859_1 = 21, // ISO-8859.1 + CS_ISO8859_2 = 22, // ISO-8859.2 + CS_ISO8859_3 = 23, // ISO-8859.3 + CS_ISO8859_4 = 34, // ISO-8859.4 + CS_ISO8859_5 = 35, // ISO-8859.5 + CS_ISO8859_6 = 36, // ISO-8859.6 + CS_ISO8859_7 = 37, // ISO-8859.7 + CS_ISO8859_8 = 38, // ISO-8859.8 + CS_ISO8859_9 = 39, // ISO-8859.9 + CS_ISO8859_13 = 40, // ISO-8859.13 + + CS_KSC5601 = 44, // KOREAN STANDARD 5601 + + CS_DOS_852 = 45 , // DOS CP 852 + CS_DOS_857 = 46 , // DOS CP 857 + CS_DOS_861 = 47 , // DOS CP 861 + + CS_DOS_866 = 48, + CS_DOS_869 = 49, + + CS_CYRL = 50 , + CS_WIN1250 = 51, // Windows cp 1250 + CS_WIN1251 = 52, // Windows cp 1251 + CS_WIN1252 = 53, // Windows cp 1252 + CS_WIN1253 = 54, // Windows cp 1253 + CS_WIN1254 = 55, // Windows cp 1254 + + CS_BIG5 = 56, // Big Five unicode cs + CS_GB2312 = 57, // GB 2312-80 cs + + CS_WIN1255 = 58, // Windows cp 1255 + CS_WIN1256 = 59, // Windows cp 1256 + CS_WIN1257 = 60, // Windows cp 1257 + + CS_UTF16 = 61, // UTF-16 + CS_UTF32 = 62, // UTF-32 + + CS_KOI8R = 63, // Russian KOI8R + CS_KOI8U = 64, // Ukrainian KOI8U + + CS_WIN1258 = 65, // Windows cp 1258 + + CS_TIS620 = 66 , // TIS620 + CS_GBK = 67, // GBK + CS_CP943C = 68, // CP943C + + CS_GB18030 = 69 // GB18030 +); + +// Firebird character set mappig to code pages +TCharsetMap = record + CharsetID: Integer; + CharSetName: AnsiString; + CharSetWidth: Word; + CodePage: Integer; +end; + +{ TFbCharsetHelper } + +TFbCharsetHelper = record helper for TFBCharSet + function GetCharset : TCharsetMap; + function GetCodePage: Integer; + function GetCharWidth: Word; + function GetCharSetName: string; + function GetEncoding : TEncoding; + function GetString(const Bytes: TBytes; ByteIndex, ByteCount: Integer): UnicodeString; +end; + + +implementation + +const + CharSetMap: array [0 .. 69] of TCharsetMap = ( + (CharsetID: 0; CharSetName: 'NONE'; CharSetWidth: 1; CodePage: CP_ACP), + (CharsetID: 1; CharSetName: 'OCTETS'; CharSetWidth: 1; CodePage: CP_NONE), + (CharsetID: 2; CharSetName: 'ASCII'; CharSetWidth: 1; CodePage: {CP_ASCII} CP_ACP), + (CharsetID: 3; CharSetName: 'UNICODE_FSS'; CharSetWidth: 3; CodePage: CP_UTF8), + (CharsetID: 4; CharSetName: 'UTF8'; CharSetWidth: 4; CodePage: CP_UTF8), + (CharsetID: 5; CharSetName: 'SJIS_0208'; CharSetWidth: 2; CodePage: 20932), + (CharsetID: 6; CharSetName: 'EUCJ_0208'; CharSetWidth: 2; CodePage: 20932), + (CharsetID: 7; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 8; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 9; CharSetName: 'DOS737'; CharSetWidth: 1; CodePage: 737), + (CharsetID: 10; CharSetName: 'DOS437'; CharSetWidth: 1; CodePage: 437), + (CharsetID: 11; CharSetName: 'DOS850'; CharSetWidth: 1; CodePage: 850), + (CharsetID: 12; CharSetName: 'DOS865'; CharSetWidth: 1; CodePage: 865), + (CharsetID: 13; CharSetName: 'DOS860'; CharSetWidth: 1; CodePage: 860), + (CharsetID: 14; CharSetName: 'DOS863'; CharSetWidth: 1; CodePage: 863), + (CharsetID: 15; CharSetName: 'DOS775'; CharSetWidth: 1; CodePage: 775), + (CharsetID: 16; CharSetName: 'DOS858'; CharSetWidth: 1; CodePage: 858), + (CharsetID: 17; CharSetName: 'DOS862'; CharSetWidth: 1; CodePage: 862), + (CharsetID: 18; CharSetName: 'DOS864'; CharSetWidth: 1; CodePage: 864), + (CharsetID: 19; CharSetName: 'NEXT'; CharSetWidth: 1; CodePage: CP_NONE), + (CharsetID: 20; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 21; CharSetName: 'ISO8859_1'; CharSetWidth: 1; CodePage: 28591), + (CharsetID: 22; CharSetName: 'ISO8859_2'; CharSetWidth: 1; CodePage: 28592), + (CharsetID: 23; CharSetName: 'ISO8859_3'; CharSetWidth: 1; CodePage: 28593), + (CharsetID: 24; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 25; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 26; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 27; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 28; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 29; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 30; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 31; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 32; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 33; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 34; CharSetName: 'ISO8859_4'; CharSetWidth: 1; CodePage: 28594), + (CharsetID: 35; CharSetName: 'ISO8859_5'; CharSetWidth: 1; CodePage: 28595), + (CharsetID: 36; CharSetName: 'ISO8859_6'; CharSetWidth: 1; CodePage: 28596), + (CharsetID: 37; CharSetName: 'ISO8859_7'; CharSetWidth: 1; CodePage: 28597), + (CharsetID: 38; CharSetName: 'ISO8859_8'; CharSetWidth: 1; CodePage: 28598), + (CharsetID: 39; CharSetName: 'ISO8859_9'; CharSetWidth: 1; CodePage: 28599), + (CharsetID: 40; CharSetName: 'ISO8859_13'; CharSetWidth: 1; CodePage: 28603), + (CharsetID: 41; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 42; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 43; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 44; CharSetName: 'KSC_5601'; CharSetWidth: 2; CodePage: 949), + (CharsetID: 45; CharSetName: 'DOS852'; CharSetWidth: 1; CodePage: 852), + (CharsetID: 46; CharSetName: 'DOS857'; CharSetWidth: 1; CodePage: 857), + (CharsetID: 47; CharSetName: 'DOS861'; CharSetWidth: 1; CodePage: 861), + (CharsetID: 48; CharSetName: 'DOS866'; CharSetWidth: 1; CodePage: 866), + (CharsetID: 49; CharSetName: 'DOS869'; CharSetWidth: 1; CodePage: 869), + (CharsetID: 50; CharSetName: 'CYRL'; CharSetWidth: 1; CodePage: 1251), + (CharsetID: 51; CharSetName: 'WIN1250'; CharSetWidth: 1; CodePage: 1250), + (CharsetID: 52; CharSetName: 'WIN1251'; CharSetWidth: 1; CodePage: 1251), + (CharsetID: 53; CharSetName: 'WIN1252'; CharSetWidth: 1; CodePage: 1252), + (CharsetID: 54; CharSetName: 'WIN1253'; CharSetWidth: 1; CodePage: 1253), + (CharsetID: 55; CharSetName: 'WIN1254'; CharSetWidth: 1; CodePage: 1254), + (CharsetID: 56; CharSetName: 'BIG_5'; CharSetWidth: 2; CodePage: 950), + (CharsetID: 57; CharSetName: 'GB_2312'; CharSetWidth: 2; CodePage: 936), + (CharsetID: 58; CharSetName: 'WIN1255'; CharSetWidth: 1; CodePage: 1255), + (CharsetID: 59; CharSetName: 'WIN1256'; CharSetWidth: 1; CodePage: 1256), + (CharsetID: 60; CharSetName: 'WIN1257'; CharSetWidth: 1; CodePage: 1257), + (CharsetID: 61; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 62; CharSetName: 'Unknown'; CharSetWidth: 0; CodePage: CP_NONE), + (CharsetID: 63; CharSetName: 'KOI8R'; CharSetWidth: 1; CodePage: 20866), + (CharsetID: 64; CharSetName: 'KOI8U'; CharSetWidth: 1; CodePage: 21866), + (CharsetID: 65; CharSetName: 'WIN1258'; CharSetWidth: 1; CodePage: 1258), + (CharsetID: 66; CharSetName: 'TIS620'; CharSetWidth: 1; CodePage: 874), + (CharsetID: 67; CharSetName: 'GBK'; CharSetWidth: 2; CodePage: 936), + (CharsetID: 68; CharSetName: 'CP943C'; CharSetWidth: 2; CodePage: 943), + (CharsetID: 69; CharSetName: 'GB18030'; CharSetWidth: 4; CodePage: 54936)); + +{ TFbCharset } + +function TFbCharsetHelper.GetCharset(): TCharsetMap; +begin + Result := CharSetMap[Integer(Self)]; +end; + +function TFbCharsetHelper.GetCodePage(): Integer; +begin + Result := CharSetMap[Integer(Self)].CodePage; +end; + +function TFbCharsetHelper.GetCharWidth(): Word; +begin + Result := CharSetMap[Integer(Self)].CharSetWidth; +end; + +function TFbCharsetHelper.GetCharSetName(): string; +begin + Result := CharSetMap[Integer(Self)].CharSetName; +end; + +function TFbCharsetHelper.GetEncoding (): TEncoding; +begin + Result := TEncoding.GetEncoding(CharSetMap[Integer(Self)].CodePage); +end; + +function TFbCharsetHelper.GetString( + const Bytes: TBytes; ByteIndex, ByteCount: Integer): UnicodeString; +var + xEncoding: TEncoding; +begin + xEncoding := GetEncoding(); + try + Result := xEncoding.GetString(Bytes, ByteIndex, ByteCount); + finally + xEncoding.Free; + end; +end; + + +end. + + diff --git a/examples/object_pascal/makefile b/examples/object_pascal/makefile new file mode 100644 index 0000000000..71cafb78b0 --- /dev/null +++ b/examples/object_pascal/makefile @@ -0,0 +1,66 @@ +# +# 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 IBPhoenix +# and the Firebird Open Source RDBMS project. +# +# Copyright (c) 2020 Paul Reeves and all contributors signed below. +# +# All Rights Reserved. +# Contributor(s): ______________________________________. +# + +# ----------------------------------------------------------------------- +# Firebird Installation Directory +# +# Change this definition to point to your Firebird installation directory +# ----------------------------------------------------------------------- +FIREBIRD = /opt/firebird + +INCLUDE_FB = $(FIREBIRD)/include/firebird +FBCLIENT = $(FIREBIRD)/lib/libfbclient.so + +# Directory to store compiled unit files +UNITBINDIR = lib + +# --------------------------------------------------------------------- +# General Compiler and linker Defines for Free Pascal +# --------------------------------------------------------------------- +FPC = fpc +FPCFLAGS = -g -Fucommon -Fu$(INCLUDE_FB) -FU$(UNITBINDIR) -Mdelphi -FE. +RM = rm -f + +OBJECTS = $(UNITBINDIR)/* +OUTBIN = 01.create 02.update 03.select + +# To Do... +# 04.print_table 05.user_metadata.cpp 06.fb_message 07.blob 08.events 09.service 10.backup 11.batch 12.batch_isc 13.null_pk + + +.PHONY: clean all + +.SUFFIXES: .pas + +.pas: + -mkdir $(UNITBINDIR) + $(FPC) $(FPCFLAGS) $< + +all: $(OUTBIN) + +01.create: 01.create.pas +02.update: 02.update.pas +03.select: 03.select.pas + +# clean up +clean: + $(RM) $(OBJECTS) $(OUTBIN) fbtests.fdb + -rm -d $(UNITBINDIR)