Leonardo's blog

Using Lazarus as a GDB frontend

2011-06-07T10:54:00.000-07:00

Did you know that you can use Lazarus to debug applications compiled with other languages than Pascal?. If not, I can tell you that yes, you can!.

Some times, I need to connect Delphi/FPC applications to C or C++ shared libraries compiled with gcc or g++, but its a pain to debug using command line gdb.

Lazarus to the rescue

One very interesting way to debug C++ code I use is to open one or more C++ source files in Lazarus, set breakpoints, then configure the host application and run. Magically the execution stops in the breakpoints I defined, and I can step and inspect symbols as I do usually on my Lazarus applications.

An example

I have a Delphi application that relies on a C++ Dll compiled with g++ (using the -g parameter to include debug information). Using Delphi, I can debug until the point an external function is called, but nothing further than that.

To be able to debug the dll source code, you can just follow this steps in Lazarus:

1) Project -> New -> Application.
2) File -> Open -> your_cpp_file
3) Define as many breakpoints (F5) as you need.
4) Run -> Run parameters -> Host application: c:\myapp\myapp.exe
5) Run -> Run parameters -> Working directory: c:\myapp

That's all, now just click on run (F9). This will open the host application, and when it calls the dll, the breakpoints you configured will be reached.

Technical analysis with FreePascal and TA-lib

2011-03-16T11:28:00.000-07:00

As the home page explains, TA-Lib is a C++ library widely used by trading software developers requiring to perform technical analysis of financial market data. It Includes 200 indicators such as ADX, MACD, RSI, Stochastic, Bollinger Bands, and Candlestick pattern recognition.

The library was written in C++, but its developers made a very intelligent decision by creating a C wrapper, to allow other languages interact with it. Here I'll show an example of how you can calculate Bollinger Bands using this library and FreePascal.

Let's download and uncompress the library.

cd ~/
wget http://prdownloads.sourceforge.net/ta-lib/ta-lib-0.4.0-src.tar.gz
tar xvfz ta-lib-0.4.0-src.tar.gz

This will create a ta-lib directory in our home. For example in /home/leonardo/ta-lib.

Now, we need to create a shared library from its sources.

cd ~/ta-lib
./configure
make

That's all, the files "src/libta_lib.la" and "src/.libs/libta_lib.so" were created.

Now, let's create a new directory for our FreePascal program.

mkdir ~/fpc-talib
cd ~/fpc-talib

...and copy libta_lib.so to that new directory.

cp ~/ta-lib/src/.libs/libta_lib.so ~/fpc-talib
cd ~/fpc-talib

Before creating our first FPC/ta_lib program, I recommend reading the TA-Lib API Documentation, and also taking a look at the functions from the "src/ta_func" directory.

Now, let's take a look at the function TA_BBANDS. It allows us to calculate the Bollinger Bands for a serie of closing prices.


TA_RetCode TA_BBANDS( int    startIdx,
                      int    endIdx,
                      const double inReal[],
                      int           optInTimePeriod,
                      double        optInNbDevUp, 
                      double        optInNbDevDn, 
                      TA_MAType     optInMAType,
                      int          *outBegIdx,
                      int          *outNBElement,
                      double        outRealUpperBand[],
                      double        outRealMiddleBand[],
                      double        outRealLowerBand[] )

The function's input is an array of double, containing for example the closing prices of XYZ stock for the last year. And its outputs are three arrays of double, of the same length as the input, containing the points that define the upper, middle and lower Bollinger bands.

To be able to work with this function, we must create a Pascal version of its interface:


  TTA_BBANDS = function(
      startIdx, endIdx: Integer;
      const inReal: Array of Double;
      optInTimePeriod: Integer;
      optInNbDevUp, optInNbDevDn: Double;
      optInMAType: TTA_MAType;
      out outBegIdx: Integer;
      out outNBElement: Integer;
      outRealUpperBand: Array of Double;
      outRealMiddleBand: Array of Double;
      outRealLowerBand: Array of Double
    ): Integer; cdecl;

Well, I must admit it took me a whole afternoon to figure out that the function needed those "out" params, but after that, everything was pretty smooth.

Show me a complete example!


unit formulas;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  DynLibs;

type
  TTA_MAType = (TA_MAType_SMA, TA_MAType_EMA, TA_MAType_WMA, TA_MAType_DEMA,
     TA_MAType_TEMA, TA_MAType_TRIMA, TA_MAType_KAMA, TA_MAType_MAMA, TA_MAType_T3);

  TTA_BBANDS = function(
      startIdx, endIdx: Integer;
      const inReal: Array of Double;
      optInTimePeriod: Integer;
      optInNbDevUp, optInNbDevDn: Double;
      optInMAType: TTA_MAType;
      out outBegIdx: Integer;
      out outNBElement: Integer;
      outRealUpperBand: Array of Double;
      outRealMiddleBand: Array of Double;
      outRealLowerBand: Array of Double
    ): Integer; cdecl;


implementation

var
  lHandle: TLibHandle;
  lBBands: TTA_BBANDS;
  lInReal: Array of double;
  lOutBegIdx: Integer;
  lOutNBElement: Integer;
  lOutRealUpper: Array of double;
  lOutRealMiddle: Array of double;
  lOutRealLower: Array of double;
  lRes: Integer;
  I: Integer;
  lLowerVol: Double;
  lSqueeze: Integer;

begin
  lHandle := LoadLibrary('/home/leonardo/fpc-talib/libta_lib.so');
  if lHandle <> 0 then
  begin
    Pointer(lBBands) := GetProcAddress(lHandle, 'TA_BBANDS');
    if @lBBands <> nil then
    begin
      (* lInReal is the array of Closing prices containing 
         the last 100 days for XYZ stock *)
      SetLength(lInReal, 100);
      lInReal[0] := 10.50;
      lInReal[1] := 10.75;
      lInReal[2] := 11.25;
      //..
      //.. and so on to the 99nth element.
      //..
      lInReal[99] := 8.35;

      SetLength(lOutRealUpper, Length(lInReal)); // the same length as lInReal
      SetLength(lOutRealMiddle, Length(lInReal));// the same length as lInReal
      SetLength(lOutRealLower, Length(lInReal));// the same length as lInReal

      lRes := lBBands(
        0, AQuotes.Count - 1, lInReal, APeriods, 2, 2, TA_MAType_SMA,
        lOutBegIdx, lOutNBElement, lOutRealUpper, lOutRealMiddle, lOutRealLower);

      lLowerVol := 0;
      for I := 0 to Length(lInReal) - 1 do
      begin
        writeln(
          Format('Close %f - Upper BBand %f - Middle BBand %f - Lower BBand %f', 
          [lInReal[I], lOutRealUpper[I], lOutRealMiddle[I], lOutRealLower[I]])
        );
     end;
    end;
    UnloadLibrary(lHandle);
  end;
end;

end.

And that's it.

Following the same approach, I created a home-made trading system based on Bollinger Bands and Option Straddles that is performing pretty well!. I'm very seriously thinking of creating an investment fund, what about "The FreePascal Investment Fund" ? :). See you in my next post.

Working with C++ dll's from ObjectPascal

2011-02-16T06:15:00.000-08:00

It's a well known fact that there are many excelent libraries written in C++, and we, as Object Pascal programmers can take advantage of them.

Many times, I have found in forums or mailing lists, questions such as "How can I translate XYZ library to ObjectPascal?", or "How can I use a C++ from Object Pascal?". Well, it's not necessary to translate a library from C++, we can use it just by creating a C wrapper around it.

Why I need to wrap the C++ library to C?

Because of name mangling, if you look inside the library (using TDump included in Delphi, or by using "nm" on linux), you'll get something like this:


000DB314  794 0319 _ZN12DcmAgeStringC1ERKS_
000DB274  795 031A _ZN12DcmAgeStringC2ERK6DcmTagm
000DB2F0  796 031B _ZN12DcmAgeStringC2ERKS_
000DB398  797 031C _ZN12DcmAgeStringD0Ev
000DB368  798 031D _ZN12DcmAgeStringD1Ev
000DB338  799 031E _ZN12DcmAgeStringD2Ev
000DB3C8  800 031F _ZN12DcmAgeStringaSERKS_

In the snippet from above, you can see names like _ZN12DcmAgeStringaSERKS. Those names may reffer to functions, methods, constants or variables we can call from Object Pascal by using GetProcAddress. The name in the example, is the "mangled" version of DcmAgeStringa.

If the C++ doesn't expose classes, but functions, you can call the functions just by passing the mangled name to GetProcAddress, but what about working with classes?.

There's no way to directly use a C++ class from Object Pascal, before using it is mandatory to create a "C" wrapper around it.

Let's start by defining a simple C++ class with only one method:


#include 
using namespace std;

class Test
{
  public:
    Test();
    void getHello(char * &AString); 
};

Test::Test()
{
}

void Test::getHello(char * &AString)
{
  const char * str = "Hello World from C++";
  strcpy(AString, str);
}

The class above, can be used with something like this:


int main(){
  Test * t  = new Test();
  char * str;
  t->getHello(str);
  cout << str;
}

It just gets change the value of the string "str" and print its contents.

As I mentioned earlier, there's no way to create an instance of a C++ class from Object Pascal, but there's a workaround, to create a "C" wrapper around it, and export it from the library.

Creating our first "C" wrapper around a C++ class

The idea is to create plain C functions in charge of creating an instance of the Test class, then return a pointer to that instance, then create another function that receive the pointer as param, and use its getHello function.

Here's the code:


#include 
#include 
using namespace std;

class Test
{
  public:
    Test();
    void getHello(char * &AString); 
};

Test::Test()
{
}

void Test::getHello(char * &AString)
{
  const char * str = "Hello World from C++";
  strcpy(AString, str);
}

extern "C"{
  void createTestInstance(void * &instance)
  {
    instance = new Test();
  }

  void doHello(void * instance, char * &AString)
  {
    Test * lInstance = (Test *) instance;
    lInstance->getHello(AString);
  }
  
  void deleteTestInstance(void  * instance)
  {
    delete (Test *)instance;
    instance = NULL;
  }
}

If you look at the snippet above, you can see I added code inside an extern "C" block, there will reside the exported functions. I added three functions to create an instance of our class, to use the method getHello, and one to delete the instance.

To create a dll from this code, just do this (I'm using Linux here, but you can use MinGW from Windows using the same command):


g++ -fPIC -shared test.cpp -o test.so

That command compiles our code and creates a shared object file, in Windows you must replace "-o test.so" with "-o test.dll".

Now you can check the contents of the library by using nm or tdump. The result should be something like this:


...
0000000000000c08 T _fini
00000000000008b0 T _init
0000000000000990 t call_gmon_start
0000000000201068 b completed.7424
0000000000000ac5 T createTestInstance
0000000000000b4e T deleteTestInstance
0000000000000b21 T doHello
0000000000201070 b dtor_idx.7426
0000000000000a30 t frame_dummy
                 U strcpy@@GLIBC_2.2.5
                 U strlen@@GLIBC_2.2.5
...

You can see, that createTestInstance, deleteTestInstance and doHello now aren't mangled as in the plain C++ library.

Now the fun part!

The last step of this journey, is to create an Object Pascal program that loads and use the shared library. The program should do this:

1) Load the library and store a reference to its handler.
2) Execute the method createTestInstance and store a reference to the pointer it returns.
3) Execute the method doHello by passing the pointer stored in point 2 as parameter.
4) Delete the instance by executing deleteTestInstance and passing the same pointer.

Here's the code:


program Test;

{$mode objfpc}{$H+}

uses
  dynlibs;

type
  TCreateInstance = procedure (var AInstance: Pointer); cdecl;
  TdoHello = procedure (AInstance: Pointer; var AString: PAnsiChar); cdecl;
  TDeleteInstance = procedure (AInstance: Pointer); cdecl;

var
  lCreateInstance: TCreateInstance;
  ldoHello: TdoHello;
  lDeleteInstance: TDeleteInstance; 
  lHandle: TLibHandle;
  lInstance: Pointer;
  lStr: PAnsiChar;

begin
  lHandle := LoadLibrary('./test.so');
  if lHandle <> NILHandle then
  begin
    writeln('Library loaded successfully!.');
    lInstance := nil;
    // First, create the instance
    Pointer(lCreateInstance) := GetProcAddress(lHandle, 'createTestInstance');
    if @lCreateInstance <> nil then
      lCreateInstance(lInstance);
    // Second, use the instance
    Pointer(ldoHello) := GetProcAddress(lHandle, 'doHello');
    if @ldoHello <> nil then
    begin
      GetMem(lStr, 255);
      ldoHello(lInstance, lStr);
      writeln(lStr);
      FreeMem(lStr);
    end;
    // Third, delete the instance and unload the library
    Pointer(lDeleteInstance) := GetProcAddress(lHandle, 'deleteTestInstance');
    if @lDeleteInstance <> nil then
    begin
      lDeleteInstance(lInstance);
      UnloadLibrary(lHandle);
    end;
    writeln('Done.');
  end
  else
    writeln('Cannot load library.');
end.

That's all. Now you can use all your loved C++ libraries from Object Pascal!.

Web 2.0 programming with Object Pascal (Part 3)

2010-10-21T11:57:00.000-07:00

Debugging CGI applications

If you build web applications, surely often you'll face the need of a way to debug them. Remember that CGI or FastCGI applications run inside the Web Server, and you can't debug them by placing breakpoints in your Lazarus code.

The easiest way I found to debug web applications is by using the "dbugintf" unit, provided by FreePascal. This unit, according to the FCL documentation can be used "..to add debug messages to your application. The messages are not sent to standard output, but are sent to a debug server process which collects messages from various clients and displays them somehow on screen", both, FreePascal and Lazarus include example debug servers to cath messages generated in apps.

How to use dbugintf unit

This is easy, just add dbugintf to the "uses" of the units you want to debug, then use SendDebug to send messages to the debug server.

Example:

Using Lazarus, go to Project -> New Project -> CGI Application to create a new CGI application, then go to the FPWebModule1 automatically created by Lazarus, and then to the Object Inspector, select Events and double click on the "OnRequest" event handler to create the skeleton for this handler, then adapt it to look like this:


unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  dbugintf,
  Classes, SysUtils, FileUtil, HTTPDefs, websession, fpHTTP, fpWeb; 

type

  { TFPWebModule1 }

  TFPWebModule1 = class(TFPWebModule)
    procedure DataModuleRequest(Sender: TObject; ARequest: TRequest;
      AResponse: TResponse; var Handled: Boolean);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  FPWebModule1: TFPWebModule1; 

implementation

{$R *.lfm}

{ TFPWebModule1 }

procedure TFPWebModule1.DataModuleRequest(Sender: TObject; ARequest: TRequest;
  AResponse: TResponse; var Handled: Boolean);
begin
  AResponse.Content := 'Hello!';
  SendDebug('--->Debug this!<---');
  Handled := True;
end;

initialization
  RegisterHTTPModule('TFPWebModule1', TFPWebModule1); 
end.

Then compile the program, and copy it to your web server's cgi-bin directory and test using your web browser. If everything is ok, you'll note just a web page containing the text "Hello!".

Introducing debugserver

As I explained at the beginning of this article, to catch the debugging messages you need to use a debug server. In the sources of Lazarus you can find a tool called "debugserver" placed in lazarus-sources/tools/debugserver, open it with Lazarus and compile, then Run.

In Unix/Linux, After running the debugserver, you'll note it creates the file /tmp/debugserver. In my case, that file is created with 600 permissions, that is, read only. To let the cgi program write to that file, just do this:

sudo chmod 666 /tmp/debugserver

Now you can try again your program using the web browser, and look at the debugserver screen, it should add the message "--->Debug this!<---" to the messages list.

That's all, hopefully you find this interesting.

FreePascal 64bits Port for FreeBSD 8.x

2010-08-19T04:56:00.000-07:00

Since a couple of days, the users of FreeBSD 8.x can enjoy developing with FPC 2.4.0 64bits!.

Just update the ports tree and compile FPC.

portsnap fetch update
cd /usr/ports/lang/fpc
make install clean

If you want to compile the bleeding edge 2.5.1, you can start with this compiler and follow the same instructions as my last post.

Thats all.

Installing FreePascal 2.5.1 on FreeBsd 8.x-i386

2010-07-18T15:43:00.000-07:00

The other day my Ubuntu 9.10 home server broke my /boot partition and Grub2 wasn't able to boot, I don't know why this happened, I tried to reinstall Grub2 using SystemRescueCD and lost one complete day trying, but it didn't work, so I thaught it whould be the time to try FreeBSD 8.1-RC2.

This server's purpouse is mainly to act as a file server, it also has MySql and Firebird installed for my Delphi/FPC applications, Apache for testing my customer's web sites before deploying, and SVN.

After installing the basics (Apache, database servers, SVN, SSH, VIM, etc.) I allways install FPC to compile my CGI apps inside the server. I'm sure I'm not the only one who needs to compile FPC from scratch, therefore, here is my step by step guide.

The server is and AMD64, but as I didn't find an FPC 2.4.0 executable for FreeBSD x86_64 I had to settle on the i386 version for now :(.

This guide assumes you are in /home/USER/dev, where USER is YOU!, in my case, USER=leonardo, so let's position in that place:

cd /home/leonardo/dev

Before you can compile the compiler code, you'll need an executable FPC for your platform, this process is called bootstrapping, in my case I needed a 2.4.1 compiler for FreeBsd i386, so I downloaded it from sourceforge using this command:

wget http://downloads.sourceforge.net/project/freepascal/Bootstrap/2.4.0/ppc386-freebsd-7.bz2

After donwloading it, I had to uncompress (it's bzipped), change its name to ppc386 and changed it mode to executable:

bzip2 -d ppc386-freebsd-7.bz2
mv ppc386-freebsd-7 ppc386
chmod +x ppc386

If you don't have subversion installed you'll have to install it with this command:

sudo pkg_add -r subversion

Now get the source code of FPC, in this case, the trunk version (2.5.1) in the "fpc" directory.

svn checkout http://svn.freepascal.org/svn/fpc/trunk fpc

One difference between FreeBSD and Linux version of FPC is that you have to use "gmake" instead of "make" to build the compiler, that's because FreeBSD's make isn't GNU Make as in Linux. Ok, just use gmake and you'll be ok:

gmake all PP=/home/leonardo/dev/ppc386
sudo gmake install PP=/home/leonardo/dev/ppc386

After gmake install, the compiler files are in /usr/local/lib/fpc/2.5.1, then you have to move to that directory to create an fpc.cfg:

cd /usr/local/lib/fpc/2.5.1/
sudo ./samplecfg /usr/local/lib/fpc/2.5.1 /usr/local/etc

That's it, now you can create modern Object Pascal programs on FreeBSD!.

P.S.: From Jul 24 up to Aug 13 I'll be in Europe!, in France, Italy and Spain. If you want to meet me to chat about Delphi/FPC, please drop me an email to arrange the meeting.

Web 2.0 programming with Object Pascal (Part 2)

2010-03-21T13:04:00.000-07:00

As I promised in my last article, here I'll show you how to add CRUD (Create, Read, Update and Delete) operations to the sample application.

The first step is to add a toolbar to the Grid, with three buttons, btnAdd, btnEdit and btnDelete in charge of Inserting, Updating and Deleting data. Also I'll create a new popup form where the user will work with that data.

The new Grid

Instead of overwriting the files used in the last example, I recommend to create a new directory called samples2, containing all the files showed in this article.

NOTE: the file grid2.html, has the same contents of grid1.html, so just copy it from the last example and paste in the new directory, and don't forget to rename to grid2.html. After that, you'll have to rename the div id "grid1" by "grid2".

This is the code for grid2.js:


Ext.onReady(function(){

  var dataStore = new Ext.data.JsonStore({
      //url: '/samples/customerslist.json',
      url: '/cgi-bin/customerslist',
      root: 'rows',
      method: 'GET',
      fields: [
        {name: 'id', type: 'int'},
        {name: 'firstname', type: 'string'},
        {name: 'lastname', type: 'string'},
        {name: 'age', type: 'int'},
        {name: 'phone', type: 'string'}
      ]
    });

  var btnAdd = new Ext.Toolbar.Button({
    text: 'Add',
    handler: function(){
      var win = new MyPeopleWindow();
      // to refresh the grid after Insert
      win.afterPost = function(){
        dataStore.load();
      };
     win.show();
    }
  });

  var btnEdit = new Ext.Toolbar.Button({
    text: 'Edit',
    handler: function(){
      var win = new MyPeopleWindow(selRecordStore.id);
      // to refresh the grid after Update
      win.afterPost = function(){
        dataStore.load();
      };
      win.show();
    }
  });

  var btnDelete = new Ext.Toolbar.Button({
    text: 'Delete',
    handler: function(){
      Ext.Msg.confirm(
        'Delete customer?', 
        'Are you sure to delete this customer?',
        function(btn){
          if(btn == 'yes'){
            var conn = new Ext.data.Connection();
            conn.request({
                url: '/cgi-bin/customerslist',
                method: 'POST',
                params: {"delete_person": selRecordStore.id},
                success: function(response, options) {
                    // refresh the grid after Delete
                    JSonData = Ext.util.JSON.decode(response.responseText);
                    if(JSonData.success)
                      dataStore.load();
                    else
                      Ext.Msg.alert('Status', JSonData.failure);
                },
                failure: function(response, options) {
                    Ext.Msg.alert('Status', 'An error ocurred while trying to delete this customer.');
                }
            });
          }
        }
      );
    }
  });

  var myGrid1 = new Ext.grid.GridPanel({
    id: 'customerslist',
    store: dataStore,
    columns: [
      {header: "First Name", width: 100, dataIndex: "firstname", sortable: true},
      {header: "Last Name", width: 100, dataIndex: "lastname", sortable: true},
      {header: "Age", width: 100, dataIndex: "age", sortable: true},
      {header: "Phone", width: 100, dataIndex: "phone", sortable: true}
    ],
    sm: new Ext.grid.RowSelectionModel({
      singleSelect: true,
      listeners: {
        rowselect: function(smObj, rowIndex, record){
          selRecordStore = record;
        }
      }
    }),
    tbar: [
      btnAdd,
      btnEdit,
      btnDelete
    ],
    autoLoad: false,
    stripeRows: true,
    height: 200,
    width: 500
  });

  dataStore.load();

  myGrid1.render('grid2');
});

Now, the editor form:


MyPeopleForm = Ext.extend(Ext.FormPanel, {
    initComponent: function(){
      Ext.apply(this, {
        border:false,
        labelWidth: 80,
        defaults: {
          xtype:'textfield',
          width: 150
        },
        items:[
          {xtype:'numberfield',fieldLabel:'Id',name:'id'},
          {fieldLabel:'First Name',name:'firstname'},
          {fieldLabel:'Last Name',name:'lastname'},
          {xtype:'numberfield',fieldLabel:'Age',name:'age'},
          {fieldLabel:'Phone',name:'phone'}
        ]
      });
      MyPeopleForm.superclass.initComponent.call(this, arguments);
    },
    setId: function(idPerson) {
      this.load(
        {
          method: 'POST', 
          url: '/cgi-bin/customerslist', 
          params: {'idperson': idPerson}
        }
      );
    }
  });

  MyPeopleWindow = Ext.extend(Ext.Window, {
    constructor: function(idPerson){
      MyPeopleWindow.superclass.constructor.call(this, this.config);
      // if idPerson is not null, then edit record
      // otherwise it's a new record
      if(idPerson != null)
        this.form.setId(idPerson);
    },
    afterPost: function(){
      this.fireEvent('afterPost', this);
    },
    initComponent: function(){
      Ext.apply(this, {
        title: 'Loading data into a form',
        bodyStyle: 'padding:10px;background-color:#fff;',
        width:300,
        height:270,
        closeAction: 'close',
        items: [ this.form = new MyPeopleForm() ],
        buttons: [
          {
            text:'Save',
            scope: this,
            handler: function(){
              this.form.getForm().submit({
                scope: this,
                url: '/cgi-bin/customerslist',
                method: 'POST',
                // here I add the param save_person
                // to let the cgi program decide
                // a course of action (save person data in this case).
                params: {'save_person':'true'},
                success: function(form, action){
                  // on success I just close the form 
                  this.afterPost();
                  this.close();
                },
                failure: function(form, action){
                  Ext.Msg.alert("Error","There was an error processing your request\n" + action.result.message);
                }
              });
            }
          },
          {
            text:'Cancel',
            handler: function(){this.close();},
            // important!, without "scope: this" 
            // calling this.close() will try to close the Button!,
            // and we need to close the Window, NOT the button.
            scope: this           
          }
        ]
      });
      MyPeopleWindow.superclass.initComponent.call(this, arguments);
    }
  });

That's all for the UI part. Now let's create our new customerslist.pp file, containing all the data required for the CGI application.


program cgiproject1;

{$mode objfpc}{$H+}

uses
  Classes,SysUtils,
  httpDefs,custcgi, // needed for creating CGI applications
  fpjson, // needed for dealing with JSon data
  Db, SqlDb, ibconnection; // needed for connecting to Firebird/Interbase;

Type
  TCGIApp = Class(TCustomCGIApplication)
  Private
    FConn: TSqlConnection;
    FQuery: TSqlQuery;
    FTransaction: TSqlTransaction;
    procedure ConnectToDataBase;
    function GetCustomersList: string;
    function GetCustomer(AIdPerson: string): string;
    procedure FillJSONObject(AJson: TJsonObject);
    function SavePerson(ARequest: TRequest): string;
    function DeletePerson(ARequest: TRequest): string;
  Public
    Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
  end;

procedure TCGIApp.ConnectToDataBase;
begin
  FConn := TIBConnection.Create(nil);
  FQuery := TSqlQuery.Create(nil);
  FTransaction := TSqlTransaction.Create(nil);
  with FConn do
  begin
    DatabaseName := 'TARJETA';
    UserName := 'SYSDBA';
    Password := 'masterkey';
    HostName := '192.168.1.254';
    Connected := True;
    Transaction := FTransaction;
    FQuery.Database := FConn;
  end;
end;

procedure TCGIApp.FillJSONObject(AJson: TJsonObject);
begin
  AJson.Add('id', TJsonIntegerNumber.Create(FQuery.FieldByName('IdCliente').AsInteger));
  AJson.Add('firstname', TJsonString.Create(FQuery.FieldByName('Apellido').AsString));
  AJson.Add('lastname', TJsonString.Create(FQuery.FieldByName('Nombres').AsString));
  AJson.Add('age', TJSONIntegerNumber.Create(FQuery.FieldByName('IdCliente').AsInteger));
  AJson.Add('phone', TJsonString.Create(FQuery.FieldByName('TelFijo').AsString));
end;

function TCGIApp.GetCustomersList: string;
var
  lPerson: TJSONObject;
  lJson: TJSONObject;
  lJsonArray: TJSONArray;

begin
  (* Query the database *)
  FQuery.Close;
  FQuery.Sql.Text := 'select * from clientes';
  FQuery.Open;
  FQuery.First;

  lJsonArray := TJSONArray.Create;
  lJson := TJSONObject.Create;
  try
    while not FQuery.Eof do
    begin
      lPerson := TJSONObject.Create;
      fillJsonObject(lPerson);
      FQuery.Next;
      (* Fill the array *)
      lJsonArray.Add(lPerson);
    end;
    (* Add the array to rows property *)
    lJson.Add('rows', lJsonArray);
    Result := lJson.AsJSON;
  finally
    lJson.Free;
  end;
end;

function TCGIApp.GetCustomer(AIdPerson: string): string;
var
  lPerson: TJSONObject;
  lJson: TJSONObject;

begin
  (* Query the database *)
  FQuery.Close;
  FQuery.Sql.Text := 'select * from clientes where IdCliente=' + AIdPerson;
  FQuery.Open;
  FQuery.First;

  lJson := TJSONObject.Create;
  try
    lPerson := TJSONObject.Create;
    fillJsonObject(lPerson);
   (* Add the array to rows property *)
    lJson.Add('success', 'true');
    lJson.Add('data', lPerson);
    Result := lJson.AsJSON;
  finally
    lJson.Free;
  end;
end;

function TCGIApp.SavePerson(ARequest: TRequest): string;
var
  lId: string;
  lFirstName: string;
  lLastName: string; 
  lPhone: string;
  lSql: string;
begin
  lId := ARequest.ContentFields.Values['id'];
  lFirstName := ARequest.ContentFields.Values['firstname'];
  lLastName := ARequest.ContentFields.Values['lastname'];
  lPhone := ARequest.ContentFields.Values['phone'];
  if lId <> '' then
    lSql := 'update clientes set ' + 
      'nombres = ''' + lLastName  + ''', ' + 
      'apellido = ''' + lFirstName + ''', ' + 
      'telfijo = ''' + lPhone + ''' where idcliente=' + lId
  else
  begin
    
    lSql := 'insert into clientes(IdCliente, Nombres, Apellido, TelFijo) ' + 
      'values(Gen_Id(SeqClientes, 1),''' + lFirstName + ''', ''' + lLastName + ''', ''' + lPhone + ''')';
  end;

  try
    FQuery.Sql.Text := lSql;
    FConn.Transaction.StartTransaction;
    FQuery.ExecSql;
    FConn.Transaction.Commit;
    Result := '{''success'': ''true''}';
  except
  on E: Exception do
    Result := '{''message'': "' + E.message + '"}';
  end;
end;

function TCGIApp.DeletePerson(ARequest: TRequest): string;
var
  lId: string;
begin
  lId := ARequest.ContentFields.Values['delete_person'];
  try
    FQuery.Sql.Text := 'delete from clientes where idcliente=' + lId;
    FConn.Transaction.StartTransaction;
    FQuery.ExecSql;
    FConn.Transaction.Commit;
    Result := '{''success'': ''true''}';
  except
  on E: Exception do
    Result := '{''failure'': ''Error deleting person.''}';
  end;
end;

Procedure TCGIApp.HandleRequest(ARequest : TRequest; AResponse : TResponse);
var
  lIdPerson: string;
begin
  if ARequest.ContentFields.Values['delete_person'] <> '' then
  begin
    AResponse.Content := DeletePerson(ARequest);
  end
  else
  if ARequest.ContentFields.Values['save_person'] <> '' then
  begin
    AResponse.Content := SavePerson(ARequest);
  end
  else
  begin
    lIdPerson := ARequest.ContentFields.Values['idperson']; 
    if lIdPerson <> '' then
      AResponse.Content := GetCustomer(lIdPerson)
    else
      AResponse.Content := GetCustomersList;
  end;
end;

begin
  With TCGIApp.Create(Nil) do
    try
      Initialize;
      ConnectToDatabase;
      Run;
    finally
      Free;
    end;
end.

To compile this file, I use a simple Bash script, that copies the compiled program to /var/www/cgi-bin directory, where my Apache2 is configured to host executable CGI programs.


#!/bin/bash
fpc -XX -Xs -b -v ./customerslist.pp
cp ./customerslist /var/www/cgi-bin

In this article, I showed how to create an HTML page containing a grid, with a toolbar that allow CRUD operations.

After I published my last article, some of you told me that this was too much work for showing just a simple grid on a web page, and I agree, but when you start adding complexity to the application, the effort needed to add features is marginal, and the separation of concerns used here allows to use better ways to speed up the code creation. I mean, instead of using a simple text editor to create the ExtJs code as I did (well, VIM is not a simple editor), you could try the new ExtJs Designer, and for the Object Pascal part, it is very easy to replace it with higher level frameworks, like WebBroker or DataSnap.

Some of you asked why I didn't use ExtPascal in this article. I didn't use it because I wanted to show all the parts involved in an ExtJs application (HTML, JS, CGI App), and ExtPascal creates the JavaScript code automatically hiding those internals to the programmer, I think it is very powerfull for programmers who already know how to work with plain ExtJs, and after this article, you already know how it works, so now I can write about ExtPascal!.

Here are the files for this article.

What's next?

Before writing about ExtPascal, I'll show you how to replace the CGI part by a DataSnap Server application. See you in my next post!.

Web 2.0 programming with Object Pascal (Part 1)

2010-02-21T13:18:00.000-08:00

I'm sure you experience the same feeling as me, when
a "web developer" looks at your computer screen
saying "wow! you program in Delphi, I used to use it
before programming web applications". When I hear that,
I want to start telling them that Delphi (Object Pascal)
can help you get better results than any other Web programming
language.

I hope this series of articles let you know what can
be done in the web scene with Delphi and FreePascal,
and, if you are a PHP-Python-Ruby-ASP-[place your language here] programmer,
just take a look at what can be done with modern Object Pascal languages.

Part 1 - CGI + ExtJs

Before continuing, please read what is CGI, and also take a look at ExtJs.

From now on, I'll create a CGI program capable of creating
JSON responses to an ExtJs frontend.

This example, will be compiled with FreePascal 2.5.1. The CGI
framework I'll use will be fcl-web, but you can choose
PowTils and EzCGI as well. If you
choose Delphi to create the CGI program, you can use WebBroker,
an excelent web development framework.

All the examples of this series will be hosted on an Apache 2
server, but of course, you can
use any CGI capable server like IIS, LightHttpd (impressive!) and others.

To test this example, I'll use Ubuntu 9.10 64bits and
FreePascal 2.5.1 trunk version, and ExtJs 3.1.1.

The client

As a starting point for this example, I'll create
a simple ExtJs GridPanel placed on a static HTML page. The
data shown on the grid, will be loaded from a JSon file,
so no interaction with our CGI app here.

Now lets create a simple HTML page containing an
ExtJs grid, copy and paste the code below and name it
grid1.html, and save it in /var/www/samples directory:


<html>
    <head>
      <meta equiv="Content-Type" content="text/html; charset=utf-8">
      <title>Grid Example 1</title>
      <link rel="stylesheet" type="text/css" href="/extjs/resources/css/ext-all.css">
      <script type="text/javascript" src="/extjs/adapter/ext/ext-base.js"></script>
      <script type="text/javascript" src="/extjs/ext-all.js"></script>
    </head>
    <body>
      <script type="text/javascript" src="grid1.js"></script>
      <h1>Grid Example 1</h1>
      <div id="grid1"></div>
    </body>
  </html>

Looking at the HTML code above, you'll note in many places there are
references to "/extjs", that means I have uncompressed the ExtJs
files into /var/www directory. My Apache2's document root directory
is /var/www, and my ExtJs files are under /var/www/extjs, also
in the line just below the tag, there is a reference to
"grid1.js", that reference points to that file placed in the same
directory as "grid.html".

This is the content of grid1.js (also saved in /samples directory):


Ext.onReady(function(){

var dataStore = new Ext.data.JsonStore({
    url: '/samples/customerslist.json',
    root: 'rows',
    method: 'GET',
    fields: [
      {name: 'firstname', type: 'string'},
      {name: 'lastname', type: 'string'},
      {name: 'age', type: 'int'},
      {name: 'phone', type: 'string'}
    ]
  });

var myGrid1 = new Ext.grid.GridPanel({
  id: 'customerslist',
  store: dataStore,
  columns: [
    {id: "firstname", header: "First Name", width: 100, dataIndex: "firstname", sortable: true},
    {header: "Last Name", width: 100, dataIndex: "lastname", sortable: true},
    {header: "Age", width: 100, dataIndex: "age", sortable: true},
    {header: "Phone", width: 100, dataIndex: "phone", sortable: true}
  ],
  autoLoad: false,
  stripeRows: true,
  autoHeight: true,
  width: 400
});

dataStore.load();

myGrid1.render('grid1');
});

This file creates an instance of Ext.data.JsonStore, the object
in charge of loading data from an external JSon source, in this
case the file "/samples/customerslist.json". Also, an
instance of Ext.grid.GridPanel called myGrid1 is created, that
is the Grid who'll contain the data loaded from the JsonStore,
the last line of this file, tells where should render the grid,
in this case on a Div with an ID named "grid1" (look at grid1.html).

Please, play with this example by adding more data to the Json file,
and change the properties of the grid before continuing.

The result:

Dynamic JSon data

The next step, is to create a CGI application in charge of
responding requests from the JSonStore. This is a simple
task for our CGI program, just create a string containing
the same data as "customerslist.json" file and send to the client.

The first FPC CGI application:


program cgiproject1;

{$mode objfpc}{$H+}

uses
Classes,SysUtils,httpDefs,custcgi;

Type
TCGIApp = Class(TCustomCGIApplication)
Public
  Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
end;

Procedure TCGIApp.HandleRequest(ARequest : Trequest; AResponse : TResponse);
begin
AResponse.Content := 'Hello!';
end;

begin
With TCGIApp.Create(Nil) do
  try
    Initialize;
    Run;
  finally
    Free;
  end;
end.

Save it as "customerslist.pp" then compile with "fpc customerslist.pp".
Then, copy it to /var/www/cgi-bin and open a web browser, then point it to
"http://localhost/cgi-bin/customerslist". It should show "Hello!". That's it.

Now, to let this program respond with the needed JSon, just replace
the line that AResponse.Content := 'Hello!'; with this:


AResponse.Content :=
'{' +
'  "rows": [ ' +
'    {"firstname": "Leonardo", "lastname": "Ramé", "age": 35, "phone": "1234556"}, ' +
'    {"firstname": "John", "lastname": "Williams", "age": 15, "phone": "435233"}, ' +
'    {"firstname": "Cecilia", "lastname": "Strada", "age": 28, "phone": "423234"}, ' +
'    {"firstname": "Gary", "lastname": "Thomson", "age": 43, "phone": "123"} ' +
'  ] ' +
'}';

Compile, copy to /var/www/cgi-bin directoy and test.

To call it from the JsonStore, go back to the grid1.js file,
and replace the property url of the JsonStore by "/var/www/cgi-bin/customerslist".

Note: if you are working on Windows, the file "customerslist" will be created
as "customerslist.exe", so you must replace it in every reference to
"/var/www/cgi-bin/customerslist".

If you don't like to create JSON responses as simple strings,
you can use the framework fcl-json, to create them using
an object-oriented method.

To adapt the example for usin fcl-json, you must add the
unit fpjson to the uses clause, and replace
the TCGIApp.HandleRequest by this:


procedure TCGIApp.HandleRequest(ARequest : Trequest; AResponse : TResponse);
var
lPerson1: TJSONObject;
lPerson2: TJSONObject;
lPerson3: TJSONObject;
lPerson4: TJSONObject;
lJson: TJSONObject;
lJsonArray: TJSONArray;

begin
lPerson1 := TJSONObject.Create;
lPerson2 := TJSONObject.Create;
lPerson3 := TJSONObject.Create;
lPerson4 := TJSONObject.Create;

lJsonArray := TJSONArray.Create;
lJson := TJSONObject.Create;
try
  (* populate lPerson1 *)
  lPerson1.Add('firstname', TJsonString.Create('Leonardo'));
  lPerson1.Add('lastname', TJsonString.Create('Ramé'));
  lPerson1.Add('age', TJSONIntegerNumber.Create(35));
  lPerson1.Add('phone', TJsonString.Create('1234567'));
  (* populate lPerson2 *)
  lPerson2.Add('firstname', TJsonString.Create('John'));
  lPerson2.Add('lastname', TJsonString.Create('Williams'));
  lPerson2.Add('age', TJSONIntegerNumber.Create(15));
  lPerson2.Add('phone', TJsonString.Create('14567'));
  (* populate lPerson3 *)
  lPerson3.Add('firstname', TJsonString.Create('Cecilia'));
  lPerson3.Add('lastname', TJsonString.Create('Strada'));
  lPerson3.Add('age', TJSONIntegerNumber.Create(29));
  lPerson3.Add('phone', TJsonString.Create('34567'));
  (* populate lPerson4 *)
  lPerson4.Add('firstname', TJsonString.Create('Gary'));
  lPerson4.Add('lastname', TJsonString.Create('Thomson'));
  lPerson4.Add('age', TJSONIntegerNumber.Create(43));
  lPerson4.Add('phone', TJsonString.Create('344567'));

  (* Fill the array *)
  lJsonArray.Add(lPerson1);
  lJsonArray.Add(lPerson2);
  lJsonArray.Add(lPerson3);
  lJsonArray.Add(lPerson4);

  (* Add the array to rows property *)
  lJson.Add('rows', lJsonArray);

  AResponse.Content := lJson.AsJSON;
finally
  lJson.Free;
end;
end;

This looks like too much to type when comparing to the other method,
but it's more readable, and easier to deal with complex JSon data.

Showing data from a database

Now, I'll replace the static JSon data with a dynamic one,
resulting from a database query.

In this example, I'll connect to a Firebird 2.1 database server,
running on the same machine I'm creating the example. To connect
to the database, I'll use fcl-db framework and its TIBConnection class.

This is the final project of this part, a dynamic-driven
web page containing an ExtJs Grid populated with data
coming from a databse.


program cgiproject1;

{$mode objfpc}{$H+}

uses
Classes,SysUtils,
httpDefs,custcgi, // needed for creating CGI applications
fpjson, // needed for dealing with JSon data
Db, SqlDb, ibconnection; // needed for connecting to Firebird/Interbase;

Type
TCGIApp = Class(TCustomCGIApplication)
Private
  FConn: TSqlConnection;
  FQuery: TSqlQuery;
  FTransaction: TSqlTransaction;
  procedure ConnectToDataBase;
Public
  Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
end;

procedure TCGIApp.ConnectToDataBase;
begin
FConn := TIBConnection.Create(nil);
FQuery := TSqlQuery.Create(nil);
FTransaction := TSqlTransaction.Create(nil);
with FConn do
begin
  DatabaseName := 'TEST-DATABASE';
  UserName := 'SYSDBA';
  Password := 'masterkey';
  HostName := 'localhost';
  Connected := True;
  Transaction := FTransaction;
  FQuery.Database := FConn;
end;
end;

Procedure TCGIApp.HandleRequest(ARequest : Trequest; AResponse : TResponse);
var
lPerson: TJSONObject;
lJson: TJSONObject;
lJsonArray: TJSONArray;

begin
(* Query the database *)
FQuery.Sql.Text := 'select * from people';
FQuery.Open;
FQuery.First;

lJsonArray := TJSONArray.Create;
lJson := TJSONObject.Create;
try
  while not FQuery.Eof do
  begin
    lPerson := TJSONObject.Create;
    lPerson.Add('firstname', TJsonString.Create(FQuery.FieldByName('FirstName').AsString));
    lPerson.Add('lastname', TJsonString.Create(FQuery.FieldByName('LastName').AsString));
    lPerson.Add('age', TJSONIntegerNumber.Create(FQuery.FieldByName('Age').AsInteger));
    lPerson.Add('phone', TJsonString.Create(FQuery.FieldByName('Phone').AsString));
    FQuery.Next;
    (* Fill the array *)
    lJsonArray.Add(lPerson);
  end;
  (* Add the array to rows property *)
  lJson.Add('rows', lJsonArray);
  AResponse.Content := lJson.AsJSON;
finally
  lJson.Free;
end;
end;

begin
With TCGIApp.Create(Nil) do
  try
    Initialize;
    ConnectToDatabase;
    Run;
  finally
    Free;
  end;
end.

The second part of this series, will focus on
adding some CRUD (create, read, update and delete) functions
to the application.

Click here to download the source files

I hope you enjoy this article as much as I did writing it.

Synapse Based SSH Client

2010-01-29T09:56:00.000-08:00

Many times, I needed a way to let my Delphi/FPC applications to connect to an SSH server, execute some commands, and get its results. Now I'm publishing a simple class based on Synapse's TTelnetSend class to do exactly what I needed.

Required ingredients

First of all, you'll need to grab a copy of the latest version of Synapse, now, to connect to an SSH server, the connection must be established by using the SSL protocol, and Synapse allows that kind of connections with plugins that allow filtering the data through OpenSSL, CryptLib and StreamSecII. Here, I'll use CryptLib, so you'll have to get this compiled version of cl32.dll for Windows, if you need the library compiled for Linux search for it in your repository (or use Google).

Now, configure the search paths of your compiler to find both, Synapse source and cryptlib.pas, the wrapper for cl32.dll.

Introducing TSSHClient class

This is a simple class to let you connect to an SSH server in an Object Oriented way, its internal parts where found in the Synapse's newsgroups, tested and arranged in a class.


unit sshclient;

interface

uses
  tlntsend, ssl_openssl, ssl_openssl_lib, ssl_cryptlib;

type
  TSSHClient = class
  private
    FTelnetSend: TTelnetSend;
  public
    constructor Create(AHost, APort, AUser, APass: string);
    destructor Destroy; override;
    procedure SendCommand(ACommand: string);
    procedure LogOut;
    function ReceiveData: string;
    function LogIn: Boolean;
  end;

implementation

{ TSSHClient }

constructor TSSHClient.Create(AHost, APort, AUser, APass: string);
begin
  FTelnetSend := TTelnetSend.Create;
  FTelnetSend.TargetHost := AHost;
  FTelnetSend.TargetPort := APort;
  FTelnetSend.UserName := AUser;
  FTelnetSend.Password := APass;
end;

destructor TSSHClient.Destroy;
begin
  FTelnetSend.Free;
  inherited;
end;

function TSSHClient.LogIn: Boolean;
begin
  Result := FTelnetSend.SSHLogin;
end;

procedure TSSHClient.LogOut;
begin
  FTelnetSend.Logout;
end;

function TSSHClient.ReceiveData: string;
var
  lPos: Integer;
begin
  Result := '';
  lPos := 1;
  while FTelnetSend.Sock.CanRead(1000) or (FTelnetSend.Sock.WaitingData>0) do
  begin
    FTelnetSend.Sock.RecvPacket(1000);
    Result := Result + Copy(FTelnetSend.SessionLog, lPos, Length(FTelnetSend.SessionLog));
    lPos := Length(FTelnetSend.SessionLog)+1;
  end;
end;

procedure TSSHClient.SendCommand(ACommand: string);
begin
  FTelnetSend.Send(ACommand + #13);
end;

end.

A sample application

This is an example of how to execute an "df -h" command in an external SSH server, inspirated by a question in StackOverflow.

The example just connects to a server, execute the command and capture its output, just that.


program TestSSHClient;

{$APPTYPE CONSOLE}

uses
  sshclient;

var
  lSSh: TSSHClient;
begin
  lSSh := TSSHClient.Create('[TARGET_HOST_OR_IP_ADDRESS]', '[PORT]', '[USER]', '[PASSWORD]');
  if lSSh.LogIn then
  begin
    Writeln('Connected!.');
    (* Get welcome message *)
    Writeln(lSSh.ReceiveData);
    (* Send command *)
    lSSh.SendCommand('df -h');
    (* Receive results *)
    Writeln(lSSh.ReceiveData);
    lSSh.LogOut;
    Writeln('Logged out.');
  end
  else
    Writeln('Can''t connect.');
  lSSh.Free;
end.

Replace the words between '[' and ']' by the real ones and test it.

See you on my next post.

Apache 2.2 modules - FPC 64bits + Ubuntu 9.10

2009-12-03T11:05:00.001-08:00

Yesterday I've received a inquiry from Harel Haruda about my example of Apache 2.2 modules for linux, he was having some trouble trying to let Apache load its modules.

My former example was compiled using FPC 2.2.2 on an i386 PC with Debian Linux, now I'm using Ubuntu 9.10 for x86-64 with FPC 2.2.3.

One very important change es in FPC 2.2.3, variables and functions have to be marked to be exportable, with the keyword "export". In previous versions, all functions and variables where exported automatically. I'd read this in the FPC Wiki.

The new code:


{*******************************************

*  Test library of the Apache Pascal Headers

********************************************}

library mod_helloworld;



{$mode objfpc}{$H+}



uses SysUtils, httpd {$ifndef Apache1_3}, apr{$endif};



var

 test_module: module;  export;

 default_module_ptr: Pmodule;



const

  MODULE_NAME = 'mod_helloworld.so';

  HANDLER = 'helloworld-handler';



exports test_module;

 

{****************************************************

*  Handles apache requests

*****************************************************}

function DefaultHandler(r: Prequest_rec): Integer; cdecl;

var

  RequestedHandler: string;

begin

  RequestedHandler := r^.handler;



  ap_log_error(MODULE_NAME, 54, APLOG_NOERRNO or APLOG_NOTICE,

   0, r^.server, 'mod_hello: %s', [PChar('Before content is output')]);



  if not SameText(RequestedHandler, 'helloworld-handler') then

  begin

    Result := DECLINED;

    Exit;

  end;



   ap_set_content_type(r, 'text/html');

 

  { If the request is for a header only, and not a request for

   the whole content, then return OK now. We don't have to do

   anything else. }

  if (r^.header_only <> 0) then

  begin

    Result := OK;

    Exit;

  end;



  { Now we just print the contents of the document using the

   ap_rputs and ap_rprintf functions. More information about

   the use of these can be found in http_protocol.inc }

  ap_rputs('' + LineEnding, r);

  ap_rputs('' + LineEnding, r);

  ap_rputs('Hello There' + LineEnding, r);

  ap_rputs('' + LineEnding, r);

  ap_rputs('' + LineEnding ,r);

  ap_rputs('Hello world' + LineEnding, r);

  ap_rputs('This is the first Apache Module working with the new binding from Free Pascal' + LineEnding, r);

  ap_rputs('' + LineEnding, r);



  { We can either return OK or DECLINED at this point. If we return

         * OK, then no other modules will attempt to process this request }

  Result := OK;

end;



{***************************************************

*  Registers the hooks

****************************************************}

procedure RegisterHooks(p: Papr_pool_t); cdecl;

begin

  ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE);

end;



{***************************************************

*  Library initialization code

****************************************************}

begin

  default_module_ptr := @test_module;

  FillChar(default_module_ptr^, SizeOf(default_module_ptr^), 0);



   STANDARD20_MODULE_STUFF(test_module);



    with test_module do

    begin

      name := MODULE_NAME;

      register_hooks := @RegisterHooks;

    end;

end.

To compile this, I used this (long) command line:


fpc -fPIC -B -WR -Xs -XX -Fu/usr/share/fpcsrc/2.2.4/packages/httpd22/src -Fu/usr/share/fpcsrc/2.2.4/packages/httpd22/src/apr -Fu/usr/share/fpcsrc/2.2.4/packages/httpd22/src/aprutil -Fu/usr/share/fpcsrc/2.2.4/src/apriconv mod_helloworld.pas

This will create a "libmod_helloworld.so" library.

Then, I had to copy it to /usr/lib64/apache2/modules directory changing its name to mod_helloworld.so:


cp libmod_helloworld.so /usr/lib64/apache2/modules/mod_helloworld.so

The next step, as usual, is to let Apache know from where to load the new module:

File /etc/apache2/mods-available/helloworld.load


LoadModule test_module /usr/lib64/apache2/modules/mod_helloworld.so

File /etc/apache2/mods-available/helloworld.conf


<Location /hello>

  SetHandler helloworld-handler

</Location>

Now, I created a symlink to those files, from the directory /etc/apache2/mods-enabled:


ln -s /etc/apache2/mods-available/helloworld.conf /etc/apache2/mods-enabled/helloworld.conf

ln -s /etc/apache2/mods-available/helloworld.load /etc/apache2/mods-enabled/helloworld.load

The last step is to restart Apache and test the module:


sudo apache2ctl start

To test the module go to http://localhost/hello

Response to comments in "Inducing the Great Divide"

2009-11-19T05:45:00.000-08:00

I've read the -nice- article Inducing the great divide by Cobus Cruger, and was tempted to answer many comments about his approach to set object properties to visual controls.

Many comments where related to the lack of scalability of this approach, specially when a form has many model objects pointed to views not contemplated in the framework Cobus created.

I also am thinking about this problem since a long time, and started with my own framweork using the same approach of Cobus, and faced the same problems he is facing after the reader's comments.

My conclussion was that it's not possible to create a simple, generic way to fill any control with data from any object, thus, I created a framework where the programmer has to configure the objects by using "associations", where a property of an object points to a TEdit, TComboBox, TListView and so on.

For example, if the program needs to fill a listview with a TCollection of customers, in my framework, I have to configure this:


mvFramework.AddAssociation(TListViewAssociation.Create(
  ListView1, // the list view associated
  Customers, // Customers TCollection
  ['FirstName','LastName'] // Properties pointed to the First and Second column of ListView1
));

On Each TForm of the application, the programmer has to configure each control the way I explained in the previous paragraph, then the framework provides two methods, the first one to copy the data from the model and the second does the reverse.

To copy data from model to view:

mvFramework.SetDataToView;

To copy data from view back to model:

mvFramework.SetViewToData;

What if I have a component not included in the framework?
It's simple to create a custom association, like the example, that uses TListViewAssociation, one can create a TQuantumGridAssociation, for example.

Sample code:

I uploaded not so trivial example to Code Central, enjoy!.

Apache 2.2.x modules with FreePascal (Linux)

2009-07-29T10:40:00.000-07:00

Finally I have a couple of minutes free to write about Apache 2.2.x Modules in Linux using FreePascal. The methodology is pretty much the same as my previous article about Win32 modules.

The code

Open your favorite editor and type this code, then save it as "mod_helloworld.pp":


{*******************************************
*  Test library of the Apache Pascal Headers
********************************************}
library mod_helloworld;

{*******************************************
* The mode must be objfpc on this unit because 
* the unix code uses some extensions 
* introduced on Free Pascal
********************************************}
{$ifdef fpc}
  {$mode objfpc}{$H+}
{$endif}

{$IFDEF WIN32}
  {$DEFINE WINDOWS}
{$ENDIF}

{$define Apache2_0}

uses SysUtils, httpd {$ifndef Apache1_3}, apr{$endif};

var
 test_module: module; {$ifdef Unix} public name 'test_module'; {$endif}
 default_module_ptr: Pmodule;

const
  MODULE_NAME = 'mod_helloworld.so';
  HANDLER = 'helloworld-handler';
 
{****************************************************
*  Free Pascal only supports exporting 
*  variables on Windows
*****************************************************}
{$ifdef WINDOWS}
exports
 test_module name 'test_module';
{$endif}

{****************************************************
*  Handles apache requests
*****************************************************}
function DefaultHandler(r: Prequest_rec): Integer; cdecl;
var
  RequestedHandler: string;
begin
  RequestedHandler := r^.handler;

  { We decline to handle a request if hello-handler is not the value of r->handler }
  if not SameText(RequestedHandler, 'testapache-handler') then
  begin
    Result := DECLINED;
    Exit;
  end;

  { The following line just prints a message to the errorlog }
  ap_log_error(MODULE_NAME, 54, APLOG_NOERRNO or APLOG_NOTICE,
   {$ifndef Apache1_3}0,{$endif} r^.server,
   'mod_hello: %s', [PChar('Before content is output')]);

  { We set the content type before doing anything else }
  {$ifdef Apache1_3}
    r^.content_type := 'text/html';
//    ap_send_http_header(r);
  {$else}
    ap_set_content_type(r, 'text/html');
  {$endif}
 
  { If the request is for a header only, and not a request for
   the whole content, then return OK now. We don't have to do
   anything else. }
  if (r^.header_only <> 0) then
  begin
    Result := OK;
    Exit;
  end;

  { Now we just print the contents of the document using the
   ap_rputs and ap_rprintf functions. More information about
   the use of these can be found in http_protocol.inc }
  ap_rputs('<html>' + LineEnding, r);
  ap_rputs('<head>' + LineEnding, r);
  ap_rputs('<title>Hello There</title>' + LineEnding, r);
  ap_rputs('</head>' + LineEnding, r);
  ap_rputs('<body bgcolor="#FFFFFF">' + LineEnding ,r);
  ap_rputs('<h1>Hello world</h1>' + LineEnding, r);
  ap_rputs('This is the first Apache Module working with the new binding from Free Pascal' + LineEnding, r);
//  ap_rprintf(r, '<br />A sample line generated by ap_rprintf<br />' + LineEnding, []);
  ap_rputs('</body></html>' + LineEnding, r);

  { We can either return OK or DECLINED at this point. If we return
         * OK, then no other modules will attempt to process this request }
  Result := OK;
end;

{***************************************************
*  Registers the hooks
****************************************************}
{$ifdef apache1_3}

procedure hw_init(s: PServer_rec; p: PPool); cdecl;
begin
end;

var
  hw_handlers: array[0..0] of handler_rec =
  (
    (content_type: 'hw_app'; handler: @DefaultHandler)
  );

{$else}

procedure RegisterHooks(p: Papr_pool_t); cdecl;
begin
  ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE);
end;

{$endif}

{***************************************************
*  Library initialization code
****************************************************}
begin
  default_module_ptr := @test_module;
  FillChar(default_module_ptr^, SizeOf(default_module_ptr^), 0);

  {$ifdef apache1_3}
    STANDARD_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      init := @hw_init;
      handlers := hw_handlers;
    end;
  {$else}
    STANDARD20_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      register_hooks := @RegisterHooks;
    end;
  {$endif}
end.

Then stop Apache 2 service.

To compile the module I had to use this on my Debian 5 machine using FPC 2.2.4:


fpc -WR -Xs -XX -Fu/usr/lib/fpc/2.2.4/units/i386-linux/httpd22 mod_helloworld.pp

Pay attention I'm explicitly using the httpd22 path for loading the http.pp related stuff. Without this, the compiler could load the http unit for another version of Apache.

Note: The -WR parameter tells the compiler to add relocatable code to the dll. Without this, you cannot load two dlls compiled with FPC with the same executable.

After compiling the program you will get the file libmod_helloworld, now you have to rename the file to mod_helloworld.so and copy to your Apache/modules directory, usually in /usr/lib/apache2/modules/mod_helloworld.so.

In my Debian 5, Apache2 config files are in /etc/apache2/mods-available. I created the files helloworld.load and helloworld.conf files containing this:

helloworld.load


LoadModule test_module /usr/lib/apache2/modules/mod_helloworld.so

helloworld.conf


<Location /hello>
  SetHandler helloworld-handler
</Location>

After this, do an "sudo apache2ctl restart" and go to http://<yourhost>/hello. It should open a page saying "Hello World".

The last article of this series will be the same module for FreeBSD. I'd try to create one, bug got stuck in an issue...at the moment FPC can't create FreeBSD shared libraries, so I'll try to use a workaround to at least, test a basic module.

Apache 2.2.x modules with FreePascal (Win32)

2009-07-03T06:16:00.000-07:00

Continuing with this series of articles, I will start with the FreePascal version using plain command line FreePascal 2.2.4 for Win32, and later I'll try to create a module for Apache 2.2.x on Linux.

Before copying-pasting this example, I recommend you to read this Wiki to get a detailed knowledge of the problem.

The code

Open your favorite editor and type this code, then save it as "mod_helloworld.pp":


{*******************************************
*  Test library of the Apache Pascal Headers
********************************************}
library mod_helloworld;

{*******************************************
* The mode must be objfpc on this unit because 
* the unix code uses some extensions 
* introduced on Free Pascal
********************************************}
{$ifdef fpc}
  {$mode objfpc}{$H+}
{$endif}

{$IFDEF WIN32}
  {$DEFINE WINDOWS}
{$ENDIF}

{$define Apache2_0}

uses SysUtils, httpd {$ifndef Apache1_3}, apr{$endif};

var
 test_module: module; {$ifdef Unix} public name 'test_module'; {$endif}
 default_module_ptr: Pmodule;

const
  MODULE_NAME = 'mod_helloworld.so';
  HANDLER = 'helloworld-handler';
 
{****************************************************
*  Free Pascal only supports exporting 
*  variables on Windows
*****************************************************}
{$ifdef WINDOWS}
exports
 test_module name 'test_module';
{$endif}

{****************************************************
*  Handles apache requests
*****************************************************}
function DefaultHandler(r: Prequest_rec): Integer; cdecl;
var
  RequestedHandler: string;
begin
  RequestedHandler := r^.handler;

  { We decline to handle a request if hello-handler is not the value of r->handler }
  if not SameText(RequestedHandler, 'testapache-handler') then
  begin
    Result := DECLINED;
    Exit;
  end;

  { The following line just prints a message to the errorlog }
  ap_log_error(MODULE_NAME, 54, APLOG_NOERRNO or APLOG_NOTICE,
   {$ifndef Apache1_3}0,{$endif} r^.server,
   'mod_hello: %s', [PChar('Before content is output')]);

  { We set the content type before doing anything else }
  {$ifdef Apache1_3}
    r^.content_type := 'text/html';
//    ap_send_http_header(r);
  {$else}
    ap_set_content_type(r, 'text/html');
  {$endif}
 
  { If the request is for a header only, and not a request for
   the whole content, then return OK now. We don't have to do
   anything else. }
  if (r^.header_only <> 0) then
  begin
    Result := OK;
    Exit;
  end;

  { Now we just print the contents of the document using the
   ap_rputs and ap_rprintf functions. More information about
   the use of these can be found in http_protocol.inc }
  ap_rputs('<html>' + LineEnding, r);
  ap_rputs('<head>' + LineEnding, r);
  ap_rputs('<title>Hello There</title>' + LineEnding, r);
  ap_rputs('</head>' + LineEnding, r);
  ap_rputs('<body bgcolor="#FFFFFF">' + LineEnding ,r);
  ap_rputs('<h1>Hello world</h1>' + LineEnding, r);
  ap_rputs('This is the first Apache Module working with the new binding from Free Pascal' + LineEnding, r);
//  ap_rprintf(r, '<br />A sample line generated by ap_rprintf<br />' + LineEnding, []);
  ap_rputs('</body></html>' + LineEnding, r);

  { We can either return OK or DECLINED at this point. If we return
         * OK, then no other modules will attempt to process this request }
  Result := OK;
end;

{***************************************************
*  Registers the hooks
****************************************************}
{$ifdef apache1_3}

procedure hw_init(s: PServer_rec; p: PPool); cdecl;
begin
end;

var
  hw_handlers: array[0..0] of handler_rec =
  (
    (content_type: 'hw_app'; handler: @DefaultHandler)
  );

{$else}

procedure RegisterHooks(p: Papr_pool_t); cdecl;
begin
  ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE);
end;

{$endif}

{***************************************************
*  Library initialization code
****************************************************}
begin
  default_module_ptr := @test_module;
  FillChar(default_module_ptr^, SizeOf(default_module_ptr^), 0);

  {$ifdef apache1_3}
    STANDARD_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      init := @hw_init;
      handlers := hw_handlers;
    end;
  {$else}
    STANDARD20_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      register_hooks := @RegisterHooks;
    end;
  {$endif}
end.

Then stop Apache 2 service, and compile the file with this command:


fpc -WR -XX -Xs  mod_helloworld.pp

Note: The -WR parameter tells the compiler to add relocatable code to the dll. Without this, you cannot load two dlls compiled with FPC with the same executable.

After compiling the program you will get the file mod_helloworld.dll, now you have to rename the file to mod_helloworld.so and copy to your Apache/modules directory, usually in C:\Program files\Apache Software Foundation\Apache2.2\modules.

Now add this to your httpd.conf file in C:\Program files\Apache Software Foundation\Apache2.2\conf:


LoadModule test_module modules/mod_helloworld.so
<Location /hello>
SetHandler helloworld-handler
</Location>

I don't have a Linux box here to test this (shhh, I'm at work), I'll try to compile it this weekend at home in Linux and FreeBSD.

Apache 2.2.x modules with Delphi II

2009-07-01T10:56:00.000-07:00

After my "Apache 2.2.x modules with Delphi" article, I received many requests for an example, and here it is.

Creating the directory structure

Create a directory where your Delphi project will reside, for example C:\myModule, then copy the files HTTPD2.pas, ApacheTwoApp.pas and ApacheTwoHTTP.pas from your Delphi/Source directory to the newly created directory.

Patching HTTPD2.pas

Open the file c:\myModule\HTTPD2.pas and replace/fix the lines as shown in my previous post.

The code

This is a very small HelloWorld WebBroker example, it is composed of only three files, mod_helloworld.dpr, main.pas and main.dfm

mod_helloworld.dpr


library mod_helloworld;

uses
HTTPD2 in 'HTTPD2.pas',
ApacheTwoApp,
WebBroker,
main in 'main.pas' {WebModule1: TWebModule};

{$E so}

{$R *.res}

exports
apache_module name 'helloworld_module';

begin
Application.Initialize;
Application.CreateForm(TWebModule1, WebModule1);
Application.Run;
end.

main.pas


unit main;

interface

uses
SysUtils, Classes, HTTPApp,
HTTPProd;

type
TWebModule1 = class(TWebModule)
procedure WebModule1WebActionItem1Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
public
{ Public declarations }
end;

var
WebModule1: TWebModule1;

implementation

{$R *.dfm}

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.Content := 'Hello from Apache Module!';
end;

end.

main.dfm


object WebModule1: TWebModule1
OldCreateOrder = False
Actions = < default =" True" name =" 'WebActionItem1'" pathinfo =" '/test'" onaction =" WebModule1WebActionItem1Action">
Left = 679
Top = 385
Height = 150
Width = 215
end

Compilling the module

Save the three files in c:\myModule and open the .dpr with Delphi, then compile to your Apache2 modules directory, usually in C:\Program files\Apache Software Foundation\Apache2.2\modules.

Configuring Apache2

If the Apache 2.2 service it's running, please stop it, then open your C:\Program files\Apache Software Foundation\Apache2.2\conf\httpd.conf file and look for the "LoadModule" entries, add this after the last entry:


LoadModule helloworld_module modules/mod_helloworld.so

And below this line add this:


<Location /test>
SetHandler mod_helloworld-handler
</Location>

Testing the module

Restart your Apache 2.2 service and open a web browser, then type http://localhost:8080/test, it should show a page with the text "Hello from Apache Module!".

That's it.

FindFirst...FindClose in Linux

2009-05-20T08:11:00.000-07:00

Last week a customer asked for one application we sell for sending a work list from a Radiology Information System to different equipment called Modalities in medical terminology, they are CT, CR, MR and so on.

The application is called Modality WorkList Server, and works as a Windows Service. It's function is reading XML files from a shared directory, convert to Dicom format and place in a specific directory. Also it opens a socket port for listening incoming requests from modalities, matches the Dicom files with the request and send the files to the origin. The final product of this process is a list containing patient data a radiology technician can see in the modality screen.

All went well, until our customer told us they use Linux!. Fortunately, the application was written taking care it should compile with FPC in the future, so, after a couple of IfDefs it compiled and started running on Linux.

The sad news, were, after ten minutes it stopped working.

What went wrong?

The first think I did was to add logs everywhere trying to catch the focus of the problem. And found it was stopping in a procedure similar to this:


  if FindFirst(Edit1.Text, FileAttrs, sr) = 0 then
  begin
    repeat
     ...
     ...
    until FindNext(sr) <> 0;
  FindClose(sr);
  end;

If you look at the FindFirst function in Delphi help, it has an example very similar to this, if FindFirst finds files that matches what I'm seeking, then a loop traverses the file list, and at the end, a FindClose must be issued, but only if FindFirst returned 0.

In Linux, on the other hand, FindClose must be called every time a FindFile is executed, it doesn't matter if it found anything or not. This is the code:


  if FindFirst(Edit1.Text, FileAttrs, sr) = 0 then
  begin
    repeat
     ...
     ...
    until FindNext(sr) <> 0;
  end;
  (* In Linux, FindClose must be called always after FindFirst *)
  FindClose(sr);

Internals

To those who want to know why the FreePascal Linux version is different than Delphi/FPC windows counterpart, I'll try to explain here.

To interact with the Linux file system, FreePascal used to use an unit named OldLinux, which contains the function Glob(), in charge of finding files. This function returns a pointer to a glob structure (the file list buffer), it doesn't matter if there are found files or not, this pointer is always allocated. After calling Glob, always must be called GlobFree, to free the result of Glob call.

The Glob function of FPC, is a wrapper to the Glob function of GLibC's Glob function, that's why it is implemented this way, and it's correct.

In Linux, if you want to search for files, you use the "find" command, again, a wrapper to the GlibC Glob function. To implement FindFirst/FindNext/FindClose in FPC's RTL, the developers created them as wrappers to Glob, and again, this was a wise decision, at least to me. The only problem, is that it's usage is different in Linux than Windows, so, if you have to use this functions in a program that must run in both environments, just take care to write the call to FindClose in the right place for each operating system.

Apache 2.2.x modules with Delphi

2009-04-19T07:32:00.000-07:00

If you want to create Apache modules with Delphi, you can start reading DrBob's Delphi 2006 and Apache Web Apps and this articles, they explain step by step how to create Apache modules with Dephi.

Apache 2.2.x

DrBob articles covers up to Apache 2.0.63, but the current version of the http server is 2.2.x, if you try to run them in this version, they won't work.

Don't worry, to make it work with the new version, you have to change and add a couple of lines to the same HTTPD2.pas file as follows:

Before start changing anything, copy the files HTTPD2.pas, ApacheTwoApp.pas and ApacheTwoHTTP.pas from the Delphi /source/win32/internet directory to the directory of your project, in this example c:\projects\apachemodule.

Changes

Find the text in the left column and replace by the one in the right.

Old HTTPD2.pas	New HTTPD2.pas
LibAPR = 'libapr.dll'; {do not localize}	LibAPR = 'libapr-1.dll'; {do not localize}
MODULE_MAGIC_COOKIE = $041503230; (* "AP20" ) {$EXTERNALSYM MODULE_MAGIC_COOKIE} MODULE_MAGIC_NUMBER_MAJOR = 20020903; { Apache 2.0.42 } {$EXTERNALSYM MODULE_MAGIC_NUMBER_MAJOR} MODULE_MAGIC_NUMBER_MINOR = 0; ( 0...n *)	MODULE_MAGIC_COOKIE = $041503232; (* "AP22" ) {$EXTERNALSYM MODULE_MAGIC_COOKIE} MODULE_MAGIC_NUMBER_MAJOR = 20051115; { Apache 2.2.x } {$EXTERNALSYM MODULE_MAGIC_NUMBER_MAJOR} MODULE_MAGIC_NUMBER_MINOR = 0; ( 0...n *)
{$EXTERNALSYM apr_bucket_alloc_t}	{$EXTERNALSYM apr_bucket_alloc_t} ap_conn_keepalive_e = (AP_CONN_UNKNOWN, AP_CONN_CLOSE, AP_CONN_KEEPALIVE);
(** Are we going to keep the connection alive for another request? * @see ap_conn_keepalive_e *) {keepalive: ap_conn_keepalive_e;}	(** Are we going to keep the connection alive for another request? * @see ap_conn_keepalive_e *) keepalive: ap_conn_keepalive_e;
(** The bucket allocator to use for all bucket/brigade creations *) bucket_alloc: Papr_bucket_alloc_t; end;	(** The bucket allocator to use for all bucket/brigade creations ) bucket_alloc: Papr_bucket_alloc_t; // New for Apache 2.2 (* The current state of this connection ) cs: Pointer; (* Is there data pending in the input filters? *) data_in_input_filters: Integer; end;

Delphi 2009

To create an Apache module with Delphi 2009, go to File->New->Other->Delphi Projects->WebBroker->WebServer Application and Select CGI Stand-Alone executable, then click OK. This will create a new project, then go to the "uses" clause of this project and replace CGIApp by ApacheTwoApp. That's it.

Update: I added an example to this article, please, read it here.

Paginating TListView - Part 3 of 3

2009-04-18T17:08:00.000-07:00

To finish this series of paginating TListViews, I'll show a simple method of automatic assignment of data from a database query to properties of an object.

Introducing RTTI

Delphi and FreePascal provides the ability to get and set the values of object's properties at run-time, this is called Run Time Type Information, RTTI for short. This allows a great deal of flexibility at the moment of reducing code size and automating repetitive tasks.

In the last example, the function GetCurrentPage executes a database query, then iterates trough it's dataset assigning each property of each item the FCustomers collection. One problem here, is that this function only works for TCustomers, so if we want to use another collection, we need to create a GetCurrentPage_for_our_new_tcollection and so on.

Automating GetCurrentPage

To generalize our GetCurrentPage method, we need to RTTI-enable the TCustomer class by replacing the "public" keyword by "published". This change tells the compiler that it's properties will be available to the RTTI functions like SetPropValue.

The second step is to include the TypInfo unit in the "uses" clause. This unit contains all the RTTI functions. I recommend further reading about it.

Now, the last step. Just replacing the lines 20 to 25 of GetCurrentPage function with this:


lCustomer := FCustomers.Add;
for I := 0 to IbQuery.Fields.Count - 1 do
  SetPropValue(lCustomer, 
    IbQuery.Fields[I].FieldName, 
    IbQuery.Fields[I].Value);

Warning: This code works because the properties of TCustomer class have the same name as the fields returned by the query I used in the example.

Now, I'll remove the references to FCustomers in the function:


procedure TForm1.GetCurrentPage(ACurrentPage: Integer; 
  ACollection: TCollection);
var
  lFrom: Integer;
  lTo: Integer;
  I: Integer;
  lItem: TCollectionItem;

begin
  (* Do the query *)
  lFrom := ((ACurrentPage * cPageSize) - cPageSize) + 1;
  lTo := (ACurrentPage * cPageSize) + 1;
  IbQuery1.Close;
  IbQuery1.SQL.Text :=
   'select CustId, FirstName, LastName from customers ' +
   'rows ' + IntToStr(lFrom) + ' to ' + IntToStr(lTo);
  IbQuery1.Open;
  (* Fill the collection *)
  ACollection.Clear;
  while not IbQuery1.Eof do
  begin
    lItem := ACollection.Add;
    for I := 0 to IbQuery1.Fields.Count - 1 do
      SetPropValue(lItem, 
        IbQuery1.Fields[I].FieldName, 
        IbQuery1.Fields[I].Value);
    IbQuery1.Next;
  end;
  IbQuery1.Close;
end;

You can improve this by adding a new parameter for the Query to be executed inside the function. Also you have to adapt the ListView1Data event by this:


procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
 lCurrPage: Integer;
 lPos: Integer;
begin
 (* Get current page index *)
 lCurrPage := Item.Index div cPageSize;
 (* Get the position in the current page *)
 lPos := Item.Index - (lCurrPage * cPageSize);

 (* Page changed? refresh the data *)
 if FCurrentPage - 1 <> lCurrPage then
 begin
   FCurrentPage := lCurrPage + 1;
   GetCurrentPage(FCurrentPage, FCustomers);
 end;

 (* Paint the ListView's item with our TCollection's items *)
 Item.Caption := FCustomers[lPos].LastName;
 Item.SubItems.Add(FCustomers[lPos].FirstName);
end;

This is the end of the series. This example could be improved even more, one way that comes to my mind is the creating a TListView descendant component.

Binding TCollections to paginating ListViews

2009-04-06T17:31:00.000-07:00

In my previous article, I wrote about a method to paginate data shown in a ListView.
Now, I want to extend its reach by replacing TDataSets by TCollections.

What is a TCollection?

A TCollection is a container, where objects of only one type can be stored in it.
The difference with other containers like TList and TObjectList is they can
contain any kind of pointer, in the case of TList, and heterogenous objects in
a TObjectList, on the other hand, in a TCollection,
only objects of a specific class can be used.

A collection of Customers

To create a collection of Customers, we have to derive a class from TCollectionItem,
for example TCustomer, and another class from TCollection, for example
TCustomers, as follows:


TCustomer = class(TCollectionItem)
private
 FCustId: Integer;
 FLastName: string;
 FFirstName: string;
public
 property CustId: Integer read FCustId write FCustId;
 property FirstName: string read FFirstName write FFirstName;
 property LastName: string read FLastName write FLastName;
end;

TCustomers = class(TCollection)
private
 function GetItem(AIndex: Integer): TCustomer;
public
 function Add: TCustomer;
 property Items[AIndex: Integer]: TCustomer read GetItem; default;
end;

Now lets define the methods Add and GetItem:


function TCustomers.GetItem(AIndex: Integer): TCustomer;
begin
  result := TCustomer(inherited GetItem(AIndex));
end;

function TCustomers.Add: TCustomer;
begin
  result := TCustomer(inherited Add);
end;

Save the above code in a unit called customers.pas, then create a new application,
and add the newly created unit to the "uses" clause of the main form, then add
the attribute FCustomers: TCustomers; to the private section of the form:


type
  TForm1 = class(TForm)
  private
    FCustomers: TCustomers;
  public
    { Public declarations }
  end;

Now, override the OnCreate and OnDestroy methods of the main form to
instantiate and free the collection:


procedure TForm1.FormCreate(Sender: TObject);
begin
  FCustomers := TCustomers.Create(TCustomer);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FCustomers.Free;
end;

From database to collection

Ok, the next step is to fill the collection with data. As I explained in my last
article, place the database connectivity components in a DataModule or just
in the main form (this is just an example) and name the TQuery as IbQuery1.

Good, the next step is to adapt the FormCreate method of the last article
to this:


procedure TForm1.FormCreate(Sender: TObject);
begin
  (* Create an instance of the customers collection *)
  FCustomers := TCustomers.Create(TCustomer);
  (* Get the total amount of customers *)
  IbQuery1.Close;
  IbQuery1.SQL.Text := 'select count(*) from customers';
  IbQuery1.Open;
  ListView1.Items.Count := IbQuery1.Fields[0].Value;
  // query for the first page
  FCurrentPage := 1;
  GetCurrentPage(FCurrentPage);
end;

Now, to fill our TCollection with data from the database, just modify
our GetCurrentPage method as this:


procedure TForm1.GetCurrentPage(ACurrentPage: Integer);
var
  lFrom: Integer;
  lTo: Integer;
  I: Integer;

begin
  (* Do the query *)
  lFrom := ((ACurrentPage * cPageSize) - cPageSize) + 1;
  lTo := (ACurrentPage * cPageSize) + 1;
  IbQuery1.Close;
  IbQuery1.SQL.Text :=
   'select CustId, FirstName, LastName from customers ' +
   'rows ' + IntToStr(lFrom) + ' to ' + IntToStr(lTo);
  IbQuery1.Open;
  (* Fill the collection *)
  FCustomers.Clear;
  while not IbQuery1.Eof do
  begin
    with FCustomers.Add do
    begin
      CustId := IbQuery1.FieldByName('CustId').AsInteger;
      FirstName := IbQuery1.FieldByName('FirstName').AsString;
      LastName := IbQuery1.FieldByName('LastName').AsString;
    end;
    IbQuery1.Next;
  end;
  IbQuery1.Close;
end;

Let me tell you that assigning data by querying with FieldByName is very slow,
but simple enough for the purpouse of this article, in a future post, I'll
show an improved version.

The last step, is to place the TListView in the form, set its properties as
shown in my last article and create the new OnData method,
adapted to our TCollection:


procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
 lCurrPage: Integer;
 lPos: Integer;
begin
 (* Get current page index *)
 lCurrPage := Item.Index div cPageSize;
 (* Get the position in the current page *)
 lPos := Item.Index - (lCurrPage * cPageSize);

 (* Page changed? refresh the data *)
 if FCurrentPage - 1 <> lCurrPage then
 begin
   FCurrentPage := lCurrPage + 1;
   GetCurrentPage(FCurrentPage);
 end;

 (* Paint the ListView's item with our TCollection's items *)
 Item.Caption := FCustomers[lPos].LastName;
 Item.SubItems.Add(FCustomers[lPos].FirstName);
end;

That's it.

My next article, will be focused on creating an automated object binding method
using RTTI, to avoid repetitive assignments by hand.

ListView and Pagination

2009-04-05T12:27:00.000-07:00

This is one of those things I needed for ages, but didn't bothered to implement
because I thought it could require an unnecessary amount of work, and allways
opted for a less perfectionist method.

I'm talking about a method to retrieve data in Pages, then browse it in a ListView
transparently for the user.

I know TDbGrid allows a similar behavior when connected to *some* database connectors,
such as ADO, but what about a general method of browsing paged data independently
of the database engine?.

Let's start by creating an application and a data module, containing a database
connection, a dataset and a transaction. I'll assume you know how to create
connections to databases, datasets and how to do queries.

Now, supposse the TDataSet is a TIbQuery component that allows to query an Interbase
or Firebird database, and we have a table called Customers, with one million records.
The table has three fields, CustId, FirstName and LastName.

ListView in Virtual Mode

Place a TListView in the main form, then set this properties:

ViewStyle = vsReport
Columns = (3 columns Id, FirstName, LastName)
OwnerData = True

The OwnerData property setted to True, means the ListView will not be a data repository
by itself, it won't contain any data. To show it on screen,
it will rely on its OnData method, who will be in charge of getting data from
the dataset and paint the rows of the ListView.

First attempt

Let's do a first essay by getting All the data from the database. TListView
in Virtual Mode, must know in advance how much data it will show, so
first of all, override the Form's OnCreate method with this:


procedure TForm1.FormCreate(Sender: TObject);
begin
 IbQuery1.Close;
 IbQuery1.SQL.Text := 'select count(*) from customers';
 IbQuery1.Open;
 ListView1.Items.Count := IbQuery1.Fields[0].Value;
 // Re-Set the query
 IbQuery1.Close;
 IbQuery1.SQL.Text := 'select CustId, FirstName, LastName from customers';
 IbQuery1.Open;
end;

The second step is to override the OnData method of the TListView with
this code:


procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
 (* Move the DataSet's pointer to Item.Index, and paint the ListView's item *)
 IbQuery1.RecNo := Item.Index + 1;
 Item.Caption := IbQuery1.Fields[0].Value;
 Item.SubItems.Add(IbQuery1.fields[1].Value);
end;

In small datasets, this code will perform really god, but as the dataset
becomes huge, it will start getting slower, and slower.

Pagination

What I want to accomplish, is to divide the data in pages of say 100 records,
then show each page at a time. Querying only 100 records each time, is
practically instantaneous, so let's show the first page, then, when the user
tries to browse after the 100 nt record, re-query the database for the
101 to 200 and so on.

Almost every database engine has a method to query just a slice of the data,
MySql has "limit nn to mm", Firebird has "Rows nn to mm", MsSql has "Top", etc.
So, I'll add a new method to my program, to let query only a given page:


procedure TForm1.GetCurrentPage(ACurrentPage: Integer);
var
 lFrom: Integer;
 lTo: Integer;

begin
 lFrom := ((ACurrentPage * cPageSize) - cPageSize) + 1;
 lTo := (ACurrentPage * cPageSize) + 1;
 IbQuery1.Close;
 IbQuery1.SQL.Text :=
  'select CustId, FirstName, LastName from customers ' +
  'rows ' + IntToStr(lFrom) + ' to ' + IntToStr(lTo);
 IbQuery1.Open;
end;

Add the constant "const cPageSize = 100;" just after the "implementation" section
of the unit, or simply replace cPageSize by 100. Also add a the internal attribute
FCurrentPage: Integer; in the private section of the form.

Now, go back to the OnCreate method, and change it by this:


procedure TForm1.FormCreate(Sender: TObject);
begin
 IbQuery1.Close;
 IbQuery1.SQL.Text := 'select count(*) from customers';
 IbQuery1.Open;
 ListView1.Items.Count := IbQuery1.Fields[0].Value;
 // query for the first page
 FCurrentPage := 1;
 GetCurrentPage(FCurrentPage);
end;

The last step is to slightly modify the OnData method with this:


procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
 lCurrPage: Integer;
 lPos: Integer;
begin
 (* Get current page index *)
 lCurrPage := Item.Index div cPageSize;
 (* Get the position in the current page *)
 lPos := Item.Index - (lCurrPage * cPageSize);

 (* Page changed? refresh the data *)
 if FCurrentPage - 1 <> lCurrPage then
 begin
   FCurrentPage := lCurrPage + 1;
   GetDataPage(FCurrentPage);
 end;

 (* Paint the ListView's item *)
 IbQuery1.RecNo := lPos + 1;
 Item.Caption := IbQuery1.Fields[0].Value;
 Item.SubItems.Add(IbQuery1.fields[1].Value);
end;

I hope you enyoyed this as much as I did when I wrote it. When I'll find
time, I'll post a modified version using TCollections instead of
TDataSets, just as I do in my projects.

Transferring objects over the network (Part II)

2009-03-19T07:50:00.000-07:00

Here is the sample code and executables for Transferring Objects Over the Network.

Click here to download.

Edit: If the above url doesn't work due to Geocities limitations. Please, download the file from this link.

Transferring objects over the network (Part I)

2009-03-18T07:49:00.000-07:00

Introduction

A couple of weeks ago, I was talking with a friend about a software he uses to book bus trips, he told me his company needs something similar, also he thinks I could adapt one of my applications to work like this program. The software is installed on more than one hundred sites, and it's connected to a central server over the Internet.

What resulted interesting to my friend was its speed, it works like if it was connected to a database in a local network (LAN), but it isn't. Also he added the server's Internet access is a cheap cable connection with ~300kb/s upload speed, and the clients connects using standard DSL or Cable connections. I asked what database and programming language the developers used. It's connected to a Firebird database and was programmed in C#, he replied. Then, I decided to try to replicate the scenario with a simple Delphi program.

My first attempt was a Delphi client connected to a Firebird 2.1 database using IBX controls. In my LAN, the app screams, but when I connect it over Internet it is as slow as a turtle. It seems to be that Firebird sends too much information over the network and it slows down the connection.

In my second attempt, I changed my app to use RemObject's SDK, I created an application server connected to the same database, it improved a lot...but if I'd choose the RO approach, I'd must rewrite the whole application.

Persistence

My application is based on classes derived from TPersistent, and uses TCollection/TCollection Item to store data, it doesn't uses any DbAware component and to persist it's data, it dynamically loads a Dll containing what I call a Database Access Driver who knows, thanks to RTTI and a (not so) complex mechanism, how to talk to the database. The Driver it's using currently, contains the IBX controls to talk to Interbase/Firebird, and I thought it could be great if I can create a similar Driver to use RemObjects SDK, but it turned out to be a real pain (and I hadn't time to investigate RO SDK in detail).

The application server

After the failed attemt to use RemObjects, I decided to create a simple Application Server, based on Indy's TCP Server control. The server should receive a request from the client asking for an object, or collection of objects, and the params to filter the result, then the server dynamically creates an instance of the requested class, fill its data, then converts it to XML and sends the result to the client, who must un-serialize the XML to reconstruct the instance.

I created the server side of the application, and found that the XML serialization part was too slow, resulting in more than 5 seconds for a collection of 500 items, maybe the serializer I used isn't optimized, and I didn't have time to improve by myself, so I decided to find a new serialization method...Thanks god and Roland Beenhakker I found this article on how to write and read the content of a TPersistent descendant to/from a stream. The first time I tested the trick Roland exposed in his article, I was shocked, it serialized my collection instantaneously, the de-serialization was also super fast.

How the server store the objects in the database?, it uses the same Data Access Driver the older Client Application used to connect to the database.

The client's Data Access Driver

Knowing the Serialization/Deserialization method I'll use for the application, I focused on writing a new Data Access Driver for connecting to the Application Server. The task was pretty easy, just serialize objects, then use the WriteStream and ReadStream method of Indy to send and receive the streamed objects to/from the server.

The real test

When I finished writing the new Data Access Driver, I decided to try it in a real environment, connecting the client from a remote machine to my local PC by using my home Internet connection. The results where amazing, the whole round trip only took 1.5 seconds!, impressive.

A little improvement

Knowing that the serialization/deserialization process is instantaneous, and the only possible bottleneck is the network. I decided to compress the streams sent over the network, and used InflateStream and DeflateStream from the great TurboPower Abbrevia library. The reduced stream size improved even more the results.

Side effects

As the data sent over the network is binary, it is also very (if not impossible) difficult to be intercepted and used by a unauthorized people. And if you are very concerned about security, after compressing the stream you can encrypt it.

One negative side effect of this approach, is that it only works with clients and servers written in Delphi and C++ Builder. To me, this is not a problem, because I maintain both, the server and the client, but if the server must be accessed by some other language, you could improve the protocol to let the server determine in which format the data should be transferred.

In the next post, I'll show a minimalistic version of the program.

Auto Update application

2009-01-13T08:37:00.000-08:00

A very common problem for desktop application programmers is the method of upgrading/installing new versions of our applications, when you have, say 10 customers with 5 PC's running your apps and you add a new feature, you have to upgrade 50 computers!, a real pain.

Last week, I was thinking of a method to solve that problem, and taught the way should be to move my applications to the web with IntraWeb or something similar, but after a couple of tests I came to the conclusion that my applications (specially the Medical applications) can't run on a web browser, as they use many technologies very tied to the underlying operating system (multimedia recording cames to my mind). Then I dreamed about creating something like a browser for desktop applications, who connects to a server via Http then the server responds to events requested by the client to draw the dialogs and forms, that way, the client is allways up to date, just like the web pages we look every day. I made a couple of examples, but it turned out to be a very complicated task.

After my failed attempt, I started to look for someone's else's work and found a couple of similar projects for Object Pascal, they are MseIfi (from the author of MseIde/MseGui) and RTC WAC (from RealThinClient), very promising, but both are in its early alpha stages of development.

Then, I went for XUL (Mozilla's rendering engine) and Adobe AIR, but I didn't like them because they are very complicated to program (lots of hand made XML/JavaScript) and too slow to compile/run, at least tha't was my impression compared to native Delphi programs.

Well, let's see...My desktop apps run very well, and my customers love them. Why should I start using a different technology just because I found a stone in my way?. The solution was ages simplier than re-programming the whole thing, just include an Auto Update mechanism!.

TAutoUpdate was born

The AutoUpdate mechanism needed was easy to create, I made a class I called TAutoUpdate, now implemented it in my currently running systems, and It works really neat!. Because of that, I wanted to share with anyone interested and created a new Google Code project for that matter.

If you like it, or have any suggestion, please don't hesitate to share with me and the community around TAutoUpdate.

Again, the link is this: http://code.google.com/p/tautoupdate/

Launch application as a service

2008-12-09T04:38:00.000-08:00

Sometimes you need an application to start before the user logs in to Windows, just as Services do. If you have the source code, this is not a problem, but what if you don't have access to it?.

With this small Delphi program you can launch a list of applications as windows services very easily.

How to use it?

After creating the service with the code below, you'll have to create the file AppAsService.conf containing the list of applications you want to start using this structure: [program];[parameters].

Sample AppAsService.conf file:

c:\program files\filesharer\filesharer.exe;autostart
c:\myprograms\utils\clock.exe

This is the code:

program AppAsService;

uses
SvcMgr,
main in 'main.pas' {Service1: TService};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TService1, Service1);
Application.Run;
end.


unit main;

interface

uses
Windows, Messages, SysUtils, Classes, SvcMgr, ShellApi, TlHelp32;

type
TService1 = class(TService)
  procedure ServiceStart(Sender: TService; var Started: Boolean);
  procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
  FAppList: TStringList;
  function pKill(ExeFileName: string): Boolean;
  public
  function GetServiceController: TServiceController; override;
  end;

var
Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
  (*
AppAsService.conf example: ;
c:\program files\Mozilla Firefox\firefox.exe;http:\\www.google.com
*)
var
lPath: string;
lName: string;
I: Integer;
lApp: PChar;
lParams: PChar;
begin
lPath := ExtractFilePath(ParamStr(0));

lName := ExtractFileName(ParamStr(0));

lName := Copy(lName, 0, Pos('.', lName) - 1);

FAppList := TStringList.Create;

FAppList.LoadFromFile(lPath + lName +'.conf');

for I := FAppList.Count - 1 downto 0 do

begin

 lApp := PChar(Copy(FAppList[I], 0, Pos(';', FAppList[I]) - 1));

if not FileExists(lApp) then

   FAppList.Delete(I)

else

begin

(* ShellExecute the app *)

lParams := PChar(Copy(FAppList[I], Pos(';', FAppList[I]) + 1,

Length(FAppList[I])));

   ShellExecute(0, 'open', lApp, lParams, PChar(ExtractFilePath(lApp)), SW_NORMAL);

(* Replace FApplist[I] by the AppName *)

   FAppList[I] := ExtractFileName(lApp);

end;

end;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
var

I: Integer;

lProcess: Cardinal;

lProcHandle: Cardinal;

lExitCode: Cardinal;
begin

for I := 0 to FAppList.Count - 1 do

 pKill(FAppList[I]);

FAppList.Free;
end;


function TService1.pKill(ExeFileName: string): Boolean;
const

PROCESS_TERMINATE=$0001;
var

ContinueLoop: BOOL;FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;
begin

result := False;

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);

while integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then

Result := TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),

   FProcessEntry32.th32ProcessID), 0);

 ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);
end;

end.

Delphi plugin by example

2008-10-16T08:31:00.000-07:00

One of the top asked questions in Delphi newsgroups is how to place a form contained in a Dll into our application forms. This method allows to create pluggable applications, easier to maintain and customize.

To accomplish our task, first of all we'll create a Dll using File -> New -> Other -> Dll Wizard. Delete the comment aboud memory managment then Save the Dll as "dllform.dpr".

Now create a form inside the Dll with File -> New -> Form. Go to the Object Inspector and change the name of the new form to MyDllForm then add some controls like buttons, labels and everything you want, then remove the "var Form1: TForm1;" reference, you don't need it. Save the form as "myform".

Go back to the Dll source by going to Project -> View Source, and look at the uses clause, a reference to the recently created form unit must be there. Try to compile by hitting Ctrl + F9, if anything fails, re-check the previous paragraphs.

Adding exportable code

As you can't export a Form directly, you must create an exportable function who can export your form class.

Go to your form's source and add just above the "implementation" section, this code:

  // To get a reference of your form's class
  TMyFormClass = class of TMyDllForm;
  // To be able to export the form class.
  function MyFormClass: TFormClass; stdcall; export;

Then create the body of MyFormClass function, go below the "implementation" section and write this:

function MyFormClass: TFormClass; stdcall;
begin
Result := TMyDllForm;
end;

Now, you must tell your library what functions to export. This is easy, just go to Project -> View Source and add this before the "end.":

exports
MyFormClass;

Before compiling be sure to activate "Build with Runtime Packages" in Project -> Options -> Packages. When you click the checkbox, a ton of packages separated by a comma appears just below, leave only the "vcl" package.

The main form

Create a new application by going to File -> New -> VCL Forms Application. This creates a new application with a main form called Form1. Go to the form and add a TButton and a TPanel.

Why a TPanel?, whell, the TPanel will contain the form we'll load from the Dll. You can use a TPageControl with a TTabSheet instead, or any other container.

Now we'll add a couple of private fields in the TForm1 class:


private
FLoadedForm: TForm;
FLibHandle: Cardinal;

Now we'll implement a method to dynamically load the Dll. Go to the Form1, then to the Object Inspector -> Events and double click on "OnCreate" and "OnDestroy" to create these two events, then write this code inside them:


procedure TForm5.FormCreate(Sender: TObject);
begin
FLibHandle := LoadLibrary('dllform.dll');
end;

procedure TForm5.FormDestroy(Sender: TObject);

begin
FLoadedForm.Free;
FreeLibrary(FLibHandle);
end;

After that, double click on the TButton to add the code needed to call the exported function in the Dll and create an instance of TMyForm:

procedure TForm1.Button1Click(Sender: TObject);
type
TMyFormClass = function: TFormClass; stdcall;

var
lMyFormClass: TMyFormClass;
begin
if not Assigned(FLoadedForm) then
begin
lMyFormClass := GetProcAddress(FLibHandle, 'MyFormClass');
if @lMyFormClass <> nil then
begin
  // Create a TMyForm instance (not visible)
      FLoadedForm := lMyFormClass.Create(nil);
  // Place the Panel from TMyForm in Panel1
      FLoadedForm.Controls[0].Parent := Panel1;
end;
end;
end;

Again, before compiling remember to enable "Build with Runtime Packages", as you did when compiling the Dll. If you don't do this, an "Cannot assign a TFont to a TFont" error will be raised when you click Button1.

You can download a sample project from here.

FileSharer on GoogleCode

2008-06-25T05:18:00.000-07:00

After receiving a long list of emails from FileSharer users asking for the source code, I decided to Open Source a Lite version of it.

If you want to add/improve something, please contact me by mail.

The code is here (currently only SVN access): http://filesharer.googlecode.com

Ajax from ObjectPascal!

2008-06-15T12:19:00.000-07:00

If you dreamed of creating Ajax/Web 2.0 applications using your favorite ObjectPascal compiler, and thought it's a difficult task because of JavaScript/CSS/DOM, and the lack of wrappers similar to those found in another languages. Now your dream come true thanks to ExtPascal, an Object Pascal wrapper to ExtJs.

ExtPascal allows to build Ajax applications pretty much the same way you program GUI based applications using Delphi, Lazarus or MseIde/MseGUI...not visually, but coding (trust me, it's very easy).

Some examples

To begin internalizing this concept, you can see some examples from the ExtPascal site, or going to ExtJs's samples site. So, if you liked what you saw, then start by reading this Getting Started tutorial and have fun!

New version of FileSharer!

2008-04-01T07:58:00.000-07:00

Hi, I improved FileSharer by adding two new exciting features:

Connections tab to be informed on who's connected/uploading/downloading.
Simple authentication plugin. To add security to your published files/folders.

What are you waiting for? download it now!

A couple of screenshots:

Vonage calling from ObjectPascal

2008-03-20T13:15:00.000-07:00

Last week, a customer asked if he could call using his Vonage phone to call from an application I developed some time ago. After searching for a way to do this, I stumbled upon this tutorial, then adapted the examples to ObjectPascal.

The results

The first problem I found was how to connect to an HTTPS site. Of course the answer was Synapse with the help of OpenSSL libraries.

I created couple of small functions that first log in to a Vonage account, then place the call. The functions are contained in this unit:

unit vonagecall;

interface

(* Calls to Vonage phone *)
function CallToVonage(AUserName, APassword, AFromNumber, AToNumber: string): string;

implementation

uses
  Classes,
  ssl_openssl,
  httpsend;

function GetVonageNumbers(AUserName, APassword: string): string;
(* This function must be allways called from CallToVonage *)
var
  lHttp: THTTPSend;
  lParams: string;
  lResponse: TStringStream;
begin
  Result := '';
  lHttp := THTTPSend.Create;
  lResponse := TStringStream.Create('');
  try
    lParams := 'username=' + AUserName;
    lParams := lParams + '&password=' + APassword;
    (* Get Phone numbers *)
    lHttp.HTTPMethod('GET', 'https://secure.click2callu.com/tpcc/getnumbers?' + lParams);
    lHttp.Document.SaveToStream(lResponse);
    Result := lResponse.DataString;
    if Pos(':', Result) > 0 then
      Result := 'Failed to retrieve Vonage phone numbers. Check your username and password.';
  finally
    lResponse.Free;
    lHttp.Free;
  end;
end;

function CallToVonage(AUserName, APassword, AFromNumber, AToNumber: string): string;
(* This makes the real call *)
var
  lHttp: THTTPSend;
  lParams: string;
  lResponse: TStringStream;
begin
  Result := '';
  lHttp := THTTPSend.Create;
  lResponse := TStringStream.Create('');
  try
    lParams := 'username=' + AUserName;
    lParams := lParams + '&password=' + APassword;
    lParams := lParams + '&fromnumber=' + AFromNumber;
    lParams := lParams + '&tonumber=' + AToNumber;
    GetVonageNumbers(AUserName, APassword);
    lHttp.HTTPMethod('GET', 'https://secure.click2callu.com/tpcc/makecall?' + lParams);
    lHttp.Document.SaveToStream(lResponse);
    Result := lResponse.DataString;
  finally
    lResponse.Free;
    lHttp.Free;
  end;
end;
end.

The unit requires you to deploy libeay32.dll and ssleay32.dll, you can download these files from OpenSSL.org project. There are Windows and Linux versions.

To use it, just include the vonagecall unit in the uses of your program and call the function CallToVonage passing UserName, Password, FromNumber and ToNumber parameters.

In this zip file, I packaged everything you need to test the function.

Hasta la próxima!

Powerful CGI applications

2007-12-02T16:36:00.000-08:00

In the article Myths About CGI Scalability published some time ago by Lars from z505, one of the authors of Powerful Web Utilities, he exposes a problem every CGI programmer faces with database applications. As you can see in that document, every time a CGI is called by a web browser, the operating system execute it and wait until its end showing the results to the client's browser. This operation is cached by the operating system after the first execution of the CGI, resulting in a faster execution of following calls.

If a web application uses a database, it's very common to create a CGI that connects to the database, perform a query then format the results and return them to the client. Using this approach, every time a user try to execute the CGI program a new connection to the database is created, resulting in slow and inefficient response times.

To resolve this problem, I created a simple CGI that sends socket commands to a program (I'll call it AppServer) wich takes care of database connections and heavy processes and returns its results to the CGI to be shown in the client's browser, using only one database connection to handle every CGI request. If the CGI finds the AppServer isn't running, it starts an instance and send the commands.

One interesting part of this approach is it runs in cheap hosting accounts, using Apache, IIS or any CGI capable web server. Also it can be compiled using FreePascal or Delphi.

The example uses PWU and Synapse for the AppServer, but you can use WebBroker or any other CGI technology.

You can download the CGI client and server to give it a try.

The CGI side is this:

uses
  classes,
  PwuMain,
  HttpSend,
  Windows;

function GetHtml: Boolean;
var
  lHttp: THTTPSend;
  lHtml:  TStringList;

begin
  Result := False;
  lHtml := TStringList.Create;
  lHttp := THTTPSend.Create;

  with lHttp do
  begin
    HTTPMethod('GET', 'localhost:85/');
    lHtml.LoadFromStream(Document);
    Result := lHtml.Text <> '';
    out(lHtml.Text);
  end;
  lHttp.Free;
  lHtml.Free;
end;
  
var
  lHandle: longint;
  
begin
  if not GetHtml then
  begin
    (* If not connected, start the process *)
    {$IFDEF WIN32}
    lHandle := ShellExecute(0 , 'open', '.\httpserver.exe',
      nil, nil, SW_HIDE);
    {$ELSE}
    lHandle := Shell('./httpserver');
    {$ENDIF}
    while True do
    begin
      if GetHtml then
        Break;
    end;
  end
end.

Using Sqlite3 with Fcl-Db

2007-11-12T11:55:00.000-08:00

In this tutorial, I'll try to explain how to access Sqlite3 databases using
FreePascal and Fcl-Db. Fcl-Db is the standard way of accessing databases using FreePascal, but you can find some other methods to connect to them, such as LibSql and Zeos.

The first step is to install Sqlite versión 3.x.x and its development library (in Ubuntu is libsqlite3-dev), please go to www.sqlite.org to download a stable version and install in your computer. I'll don't explain how to install it, you are a programmer, you should know how to install a program.

Creating the "tutorial" database

Creating a database using the command line SQLite Client is as easy as:

>sqlite3 tutorial.db

With that command, you created a file named "tutorial.db" and started the command line SQLite Client. Note I'm using sqlite3, not sqlite, the older is a client for 2.8.xx version.

Now, create the customers table using this command:

sqlite> create table customers(id integer not null primary key,
...> firstname varchar(100),
...> lastname varchar(100),
...> borndate date);

After creating the table, return to the shell:

sqlite> .quit

You can do a 'ls' in Linux to check if the file tutorial.db exists.

Sample program

The following sample program assumes you have created the tutorial.db database in the same directory as the compiled program, just type it in any text editor, then save as sqlitetest.pp and call FreePascal compiler from the command line using this command:

fpc -Sd -B -CX -Xs sqlitetest.pp

The program


program SqliteTest;

uses
 db, sqlite3ds, SysUtils;

{$mode objfpc}

var
 dsTutorial: TSQLite3Dataset;
 mSql: string;
  (* TFields declarations
    You can use Field[n].AsString but its slower *)
 mId: TIntegerField;
 mFirstName: TStringField;
 mLastName: TStringField;
 mBornDate: TDateTimeField;

begin
 dsTutorial := TSqlite3Dataset.Create(nil);

  try
 with dsTutorial do
 begin
   FileName := 'tutorial.db';
   TableName := 'customers';
   PrimaryKey := 'Id';

   (* Define the Insert skleton -uptate and delete works the same way-*)
   mSql := 'insert into customers(firstname, lastname, borndate) ' +
     'values(''%s'', ''%s'', %f)';

   (* Non transactional method *)
   (* Insert first customer *)
   Sql := Format(mSql, ['Leonardo', 'Ramé', Now]);
   ExecSql;

   (* Insert second customer *)
   Sql := Format(mSql, ['Michael', 'Stratten', Now]);
   ExecSql;

   (* Transactional method *)
   (* I don't really know why I must populate the TFields using a Select,
       if you know an elegant way to accomplish this, please tell me. *)
   Sql := 'select Id, FirstName, LastName, BornDate from customers limit 1';
   Open;

   (* Assign TFields *)
   mId := TIntegerField(Fields[0]);
   mFirstName := TStringField(Fields[1]);
   mLastName := TStringField(Fields[2]);
   mBornDate := TDateTimeField(Fields[3]);

   (* Append, Edit or Insert for the first field *);
   Append;
   mFirstName.Value := 'Juan';
   mLastName.Value := 'Pérez';
   mBornDate.Value := Now;
   Post;

   (* Append, Edit or Insert for the second field *);
   Insert;
   mFirstName.Value := 'Johan';
   mLastName.Value := 'Arndth';
   mBornDate.Value := Now;
   Post;

    (* This commits the data to the db. *)
   ApplyUpdates;

   (* Now, select all fields *)
   Close;
   Sql := 'select Id, FirstName, LastName, BornDate from customers';
   Open;

   (* To go to the first record of the DataSet, use First.
       This isn't usefull here since Open points to the first record,
       but you'll need in your projects so I keep it in the example. *)
   First;
   while not Eof do
   begin
     mId := TIntegerField(Fields[0]);
     mFirstName := TStringField(Fields[1]);
     mLastName := TStringField(Fields[2]);
     mBornDate := TDateTimeField(Fields[3]);

     writeln (IntToStr(mId.Value) + ' - ' + mFirstName.Value + ', ' +
       mLastName.Value + ' - ' + DateToStr(mBornDate.Value));
     (* Move to the next record *)
     Next;
   end;
 end;
 finally
   dsTutorial.Free;
  end;

end.

Session class for SQLite

2007-10-03T10:57:00.000-07:00

I needed Session management for a web project I made using Delphi with WebBroker, and found a unit called MISessionClass in newsgroups created by Tony Caduto. The problem with that unit was it worked with Interbase and my web hosting provider doesn't inlcude Interbase/Firebird in the package I purchased.

SQLite to the rescue

My hosting provider doesn't allow me to use Interbase/Firebird, but I can use SQLite to store my session data. To access SQLite databases, I use the exelent TLiteDb connector by Renè for DuBaron.com and adapted the unit mentioned in the previous paragraph to this database.

This is the result:

unit SqliteSessionClass;

{**********************************************************************
Open Source WebBroker Session Management Class For SQLite

All database management is done by TLiteDb object by Rene from dubaron.com

Modified version of Tony Caduto's MISessionClass.
Programmed by Leonardo M. Ramé (martinrame at yahoo dot com)
Sep 22th, 2007

Some Code based loosely on the MDweb Components by Mark Brittingham
Programming by Tony Caduto (tcad...@amsoftwaredesign.com)
May 24th, 2001
This class uses a IBexpress database,transaction and query which are created in the
constructor.
To use you must create a table on some interbase server (it could be on the
same pc as the webserver or on a remote server) called SESSIONS which
contains three fields:

SESSIONID      (integer)
SESSTIMESTAMP  (Timestamp)
SESSDATA       (blob)

In the constructor set your database name IE www.myserver.com:c:\yourpath\yourdatabase.gdb
and the SQL dialect

Add a public declaration for the class IE
PUBLIC
 SessionMgr:TMISession;

In your webmodule add the following:
in the oncreate event
SessionMgr:=TMISession.create;
in the ondestroy event add:
SessionMgr.free;

Use is very similar to MDweb without all the extra stuff IE special tags etc
This class works with the standard Webbroker pageproducer.

In the before dispatch add something like this:
 if request.queryFields.Values['islogon'] <> 'true' then
      begin
           SessionMgr.SessionID :=
             StrToIntDef(Request.CookieFields.Values['SID'], 0);
           if (Not SessionMgr.FindSessionRecord) then
           Response.SendRedirect('http://www.yourserver.com/timeout.htm');
      end;

In your logon or other action add code like this:
 SessionMgr.CreateSessionRecord;
     cookiestrings:=tstringlist.create;
     cookiestrings.add('SID='+intTostr(sessionmgr.SessionID));
     response.SetCookieField(cookiestrings,'','',now+1,false);
     SessionMgr.Values['USERID']        := userid;
     SessionMgr.Values['PINNUMBER']     := pinnumber;
     SessionMgr.Values['COMPANYPATH']   := companypath ;
     SessionMgr.Values['TOPATH']        := topath ;
     SessionMgr.Values['FROMPATH']      := frompath ;
     SessionMgr.Values['COMPANYNAME']   := companyname;
     SessionMgr.Values['COMPANYID']     := CompanyID;
     SessionMgr.Values['FIRSTNAME']     := firstname;
     SessionMgr.Values['LASTNAME']      := Lastname;
     SessionMgr.Values['MI']            := MidIntial;
     SessionMgr.Values['EMAIL']         := UserEmail;

     To read or set values do this:

     SET A value
     SessionMgr.values['Firstname'] := 'Tony';

     Get a Value
     thelastname:=  SessionMgr.values['Lastname']

     Because this is not based on a shared btree this class should work on
     linux as well as with
     CGI.  You are not limited to ISAPI

}

interface

uses
sysutils,

classes,
passqlite,
passql;

type
  TLiteSession = class(Tobject)

  private
    SessionDatabase: TLiteDb;
  protected
  public
    ExpireInterval : TDateTime;

    SessionID: Integer;
    SessionTimeStamp: TDateTime;
    SessionData: TStringList;

  procedure SetValue(const Name, Value: string);

  function GetValue(const Name: string): string;

  function  FindSessionRecord:boolean;
  procedure DeleteExpiredSessions(thetime:tdatetime);

  procedure CreateSessionRecord;
  property  Values[const Name: string]: string read GetValue write SetValue;

  constructor Create(ADataBase: TLiteDb);
  destructor Destroy; override;

  published
end;

implementation

{ TLiteSession }

constructor TLiteSession.Create(ADataBase: TLiteDb);

begin
inherited Create;
SessionDatabase := ADataBase;
SessionData := TStringList.Create;

end;

procedure TLiteSession.CreateSessionRecord;
var
lSql: string;

begin
//Delete any expired sessions before createing a new one
DeleteExpiredSessions(Now - ExpireInterval);

//********************create random ID number ***************************************

randomize;
SessionID := Random(2000000000);

//*******************Add new session to the database*********************************

lSql :=
  'INSERT INTO sessions(SESSIONID,SESSIONTIMESTAMP,SESSIONDATA)' +
  'VALUES (%d, ''%s'', ''%s'')';

lSql := Format(lSql, [sessionID, FormatDateTime('yyyy-mm-dd hh:mm:ss', now), '']);

SessionDatabase.Query(lSql);
end;

procedure TLiteSession.DeleteExpiredSessions(thetime: tdatetime);

var
lSql: string;

begin
lSql :=

  'DELETE From SESSIONS WHERE (SESSIONTIMESTAMP < %f)';
lSql := Format(lSql, [thetime]);

SessionDatabase.Query(lSql);
end;

destructor TLiteSession.Destroy;

begin
SessionData.Free;
inherited;
end;

function TLiteSession.FindSessionRecord: boolean;

var
lSql: string;

begin
Result := False;

//**************First Check for Expired Sessions********************************
DeleteExpiredSessions(Now - ExpireInterval);

//******************************************************************************

lSql := Format('select SESSIONID, SESSIONTIMESTAMP, SESSIONDATA from SESSIONS Where SESSIONID = %d', [SessionID]);
if SessionDatabase.Query(lSql) then

  if SessionDatabase.RowCount > 0 then
  begin
    SessionId := StrToInt(SessionDatabase.Results[0].Strings[0]);

    ShortDateFormat := 'yyyy-mm-dd';
    DateSeparator := '-';
    SessionTimeStamp:= StrToDateTime(SessionDatabase.Results[0].Strings[1]);

    SessionData.Text := SessionDatabase.Results[0].Strings[2];

    Result := True;
  end;
end;

function TLiteSession.GetValue(const Name: string): string;

begin
result := SessionData.Values[Name];
end;

procedure TLiteSession.SetValue(const Name, Value: string);

var
lSql: string;

begin
SessionData.Values[Name] := Value;

//Save session string list to the database
lSql :=
  'UPDATE SESSIONS SET SESSIONDATA = ''%s'' WHERE SESSIONID = %d';
lSql := Format(lSql, [sessiondata.text, SessionID]);

SessionDatabase.QueryOne(lSql);
end;

end.

Sending big files to friends

2007-05-13T21:41:00.000-07:00

A couple of weeks ago, my sister was working on an AutoCad design for an university assignment and wanted to send it to his teammate by email. She zipped it and tryed without any luck to send using her HotMail account, she can't send the file because HotMail imposes a size limitation of attachment files, and she was trying to send a 30mb file.

She called me and asked how to send big files to her friends, and I answered she can install an FTP server in her machine and a client on her teammate side...or an Apache web server and copy the files to the htdocs directory to allow others to download the file. Fortunately, I remembered her current computer is an Athlon 1100 I used for a long time with an Apache installed and working, and told her how to publish the file to allow her friend's access and download.

File Sharer

After that incident, I started to figure out a real use for the Embedded Web Server project I mentioned in my last post, and File sharer was born.

File Sharer is a small utility that allows navigation and downloading of files from a friend's computer just using a web browser. Tecnically, is a web server embedded into a simple Win32 application, once the server is started, one can access to the server's IP address and access shared files using the browser.

ScreenShots

Your own zero-configuration web server

2007-04-15T13:18:00.000-07:00

One month ago, a customer who's using a client/server application I've created for his office asked me if it's possible to make a simple web form where customers can add orders to his system using a web browser. Of course it's possible, one way is to contract with a web hosting provider and upload some CGI or PHP programs, another way is by installing a web server like Apache or IIS into his office and connect it to Internet, but both methods involves some degree of configuration.

A third method is the creation of a stand alone web/application server installed on one of his computers just like any other program, without any configuration. I suggested him to use IntraWeb or WebBroker, and the system was developed using IntraWeb.

After that small requirement I'd keep dreaming of a very small, fast and multiplatform (Win32/Linux/Bsd) stand alone web server and endded up with a working version of the project.

A first usable version of the server can be downloaded from here. It's based on the HttpServ example of Synapse, It's multithreaded, 100% Object Pascal and compiles without modifications with Delphi and FreePascal.

Looking for voluntieers

I know this can be the starting point of a very interesting project, and I'll be very happy to find some enthusiasts who can contribute with code and Ideas, so if you are one of them feel free to contact me.

Object Pascal & LDAP

2007-02-25T12:02:00.000-08:00

Object Pascal & LDAP

One common feature of enterprise software is security, applications must be prepared to allow/deny access to its resources (modules or dialogs) to different usesers. The vast majority of development teams, every time a project involves user authentication develops its own methods based on a repository (database) of user accounts. This approach isn't bad at all, but implies in some cases the duplication of users, one user account for the app, another with the same name for the operating system session, anoter one for email.

To resolve the problem described above, Directory Services were created, basically they are a common database of users and groups shared across a computer network allowing its access from different applications. Windows servers (2000 and 2003) call it Active Directory, UNIX and Linux uses LDAP and OpenLdap.

Personally, I preffer open standards, and the fact that Ms Active Directory can cooperate transparently with an LDAP server favors the later because it can be installed and accesed by Windows, Linux, and other Oses.

In this article, I'll show how to set up a simple OpenLDAP server and a client that works on Delphi or FreePascal with the help of the great Synapse library.

Installing OpenLdap

First, download the OpenLdap binaries from Win32 port or you can look at this link for other operating systems. Of course you can download the sources and build an OpenLdap server from scratch.

From here, all examples will be based on the Win32 version of the server, but I'm sure you'll understand how to adapt the examples and configuration to a Linux based server.

After installing and configuring slapd, the OpenLDAP daemon, I'll change the default settings. Stop the OpenLDAP Directory Service going to Control Panel -> Administrative Tools -> Services in windows and edit the slapd.conf file replacing the default entries with:

ucdata-path ./ucdata
include  ./schema/core.schema
include  ./schema/cosine.schema
include  ./schema/inetorgperson.schema

suffix  "dc=ldapserver,dc=com"
rootdn  "dc=ldapserver,dc=com
rootpw          secret

Save and restart the service.

The next step you must do is the creation of a root entry in the LDAP database, this can be done by creating an ldif file like this:

dn: dc=ldapserver,dc=com
objectClass: top
objectClass: dcObject
objectClass: domain
dc: ldapserver
o: MyLdapServer, Inc.

save the file as root.ldif and add to the database using this command from the command prompt:

ldapadd -D "dc=ldapserver,dc=com" -W -f root.ldif

The next step is the creation of a group of users. To accomplish this, I'll create the users.ldif file:

dn: ou=users,dc=ldapserver,dc=com
objectClass: top
objectClass: organizationalUnit
ou: users

To add this group use this statement:

ldapadd -D "dc=ldapserver,dc=com" -W -users.ldif

Now, I must populate the database with user and group entries using an ldif file like this one:

# User leonardo
dn: cn=Leonardo M. Rame,ou=users,dc=ldapserver,dc=com
objectClass: top
objectClass: person
objectClass: organizationalPerson
objectClass: inetOrgPerson
uid: leonardorame
cn: Leonardo M. Rame
gn: Leonardo M.
sn: Rame
ou: users
mail: martinrame@yahoo.com
userPassword: lrame123

# User Peter
dn: cn=Peter Jones,ou=users,dc=ldapserver,dc=com
objectClass: top
objectClass: person
objectClass: organizationalPerson
objectClass: inetOrgPerson
uid: peterjones
cn: Peter Jones
gn: Peter
sn: Jones
ou: users
mail: peterjones@yahoo.com
userPassword: peter111

Save the file as leonardo.ldif and add the user using this command:

ldapadd -D "dc=ldapserver,dc=com" -W -f leonardo.ldif

If you whant to check if the entries where added correctly, you can try this:

ldapsearch -b "dc=ldapserver,dc=com" "objectclass=*" -x

Now, I'll create two groups of users, Full Access and Limited. The first, has access to all features of the system, the second one, has a limited vision. Let's create this groups.ldif file:

# Groups
dn: ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: organizationalUnit
ou: groups

# Full Access group
dn: cn=Full Access,ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: groupOfNames
cn=Full Access
memberuid: leonardorame

# Limited Access group
dn: cn=Limited,ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: groupOfNames
cn=Limited
memberuid: peterjones

Save the file as leonardo.ldif and add the user using this command:

ldapadd -D "dc=ldapserver,dc=com" -W -f leonardo.ldif

If you whant to check if the entries where added correctly, you can try this:

ldapsearch -b "dc=ldapserver,dc=com" "objectclass=*" -x

Now, I'll create two groups of users, Full Access and Limited. The first, has access to all features of the system, the second one, has a limited vision. Let's create this groups.ldif file:

# Groups
dn: ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: organizationalUnit
ou: groups

# Full Access group
dn: cn=Full Access,ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: groupOfNames
cn=Full Access
memberuid: leonardorame

# Limited Access group
dn: cn=Limited,ou=groups,dc=ldapserver,dc=com
objectClass: top
objectClass: groupOfNames
cn=Limited
memberuid: peterjones

of course, you must type:

ldapadd -D "dc=ldapserver,dc=com" -W -f grouops.ldif

With that, I finished the server configuration part. Now, I must code the program to access the Ldap server:

program ldapexample;

{$APPTYPE CONSOLE}

uses
 SysUtils,
 classes,
 lDapSend; // <-- Synapse Ldap unit


function CheckAccess(ALevel, AUserName, APassword: string): Boolean;
(* This function checks if a user has access to a group
   in the ldap server *)
var
 ldap: TLDAPsend;
 lAttribs: TStringList;
 I: Integer;
 A: Integer;
 lMember: string;
begin
 Result := False;
 ldap:= TLDAPsend.Create;
 lAttribs := TStringList.Create;
 try
   ldap.TargetHost := 'localhost';
   (* Anonimous access *)
   ldap.Login;
   if ldap.Bind then
   begin
     lAttribs.Add('member');
     ldap.Search('cn=' + ALevel + ',ou=groups,dc=ldapserver,dc=com',
       False, '', lAttribs);
     if ldap.SearchResult.Count = 1 then
     begin
       (* Iterate through members of this group *)
       for I := 0 to ldap.SearchResult[0].Attributes.Count - 1 do
       begin
         (* search for this member attributes *)
         lAttribs.Clear;
         lAttribs.Add('uid');
         lAttribs.Add('userPassword');
         lMember := ldap.SearchResult[0].Attributes[I][0];
         ldap.Search(lMember, False, 'uid=' + AUserName, lAttribs);
         if ldap.SearchResult.Count = 1 then
         begin
           (* if found, iterate through its attributes to find uid and userPassword *)
           for A := 0 to ldap.SearchResult[0].Attributes.Count - 1 do
             if ldap.SearchResult[0].Attributes[A].AttributeName = 'userPassword' then
               if ldap.SearchResult[0].Attributes[A][0] = APassword then
               begin
                 Result := True;
                 break; // for A
               end;
           break; // for I
         end;
       end;
     end;
   end
   else
     (* Display ldap error message *)
     Writeln(ldap.ResultString);
   (* Disconnect from ldap server *)
   ldap.Logout;
 finally
   ldap.Free;
   lAttribs.Free;
 end;
end;

begin
 if CheckAccess('Full Access', 'leonardorame', 'lrame123') then
   writeln('User authenticated Ok.')
 else
   writeln('Wrong user.');

 if CheckAccess('Limited', 'leonardorame', 'lrame123') then
   writeln('User authenticated Ok.')
 else
   writeln('Wrong user.');

 if CheckAccess('Limited', 'peterjones', 'peter111') then
   writeln('User authenticated Ok.')
 else
   writeln('Wrong user.');

end.

Is Delphi a memory predator?

2006-11-26T16:09:00.000-08:00

In this article, i want to show why the Delphi way of development of visual applications is not as cleaner as you should want. When I say clean, i mean in memory terms, it mantains an instance of every form in memory, even if you don't want it.

To show it in an example, just create a new application and add two forms. The code in your Project1.dpr file is similar to this:

program Project1;

uses
  Forms,
  form1 in 'form1.pas',
  form2 in 'form2.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm2, Form2);
  Application.Run;
end.

The Application.CreateForm method creates an instance of a form and mantains it in memory until Application object is destroyed. That means the form is in memory even if the program doesn't requires it.
I remember some candidates for the Coding Horror blog, applications with tens of forms created in this way. That's not a programmer's fault, it's the fault of the Delphi IDE, and its Help, and many books that teach how to create elegant and scalable Delphi applications.

Keeping control of the forms

Every time you create a form in Delphi, it adds its unit to the uses of the project (.dpr file) and an Application.Create(...) between Application.Initialize and Application.Run methods. To keep memory usage low, you must delete those instructions from the project file, and also the variable (like var Form1: TForm1;) declared just below "implementation" declaration in the form's unit.

If you want to use the form, for example when an event of the main form is called, just create it and free inmediately after you use it:

procedure TForm1.Button1Click(Sender: TObject);
var
  Form2: TForm2;
begin
  Form2 := TForm2.Create(nil);
  try
    Form2.ShowModal;
  finally
    Form2.Free;
  end;
end;

Just be careful to include form2 unit in the uses clause of form1 and remove the Form2 variable that Delphi automatically creates when you design the form.
The example above creates a "modal" form, if you want to create a "modeless" form, you must create it using the "standard" Delphi way.

Web software in Pascal?

2006-10-05T08:31:00.000-07:00

In 1997, i and a partner where the owners of a small graphic design and editorial studio working with 133mhz - Win95 PCs and a Mac Performa 6200 (90 mhz). In that time, the usual type of job a customer could request was the design of a leaflet or printed magazine, eventually a customer could call asking for the design of a static (html only) web page.

Later that year, the web started to get traction between small business here in Argentina and an idea came to our mind, bring people the possibility to check the price of any product before buy, all using the web. What a great idea!, the only problem was that we didn't know how to create dynamic web pages such those of (in that time) Viaweb (now Yahoo Store). Since then, i started to learn everything i could with the objective to generate dynamic web pages.

The first tool i used was IDC (Internet Database Connector), a small utility created by Microsoft for the IIS (Internet Information Server) that allows users to embed a database query into an HTML page. Later came ASP with a lot more features, i remember used it to create the firtst elshopping.com, now defunct (it makes me sad). Then cames PHP, way faster than ASP and multiplatform and Java with JSP. Now we must add Python and frameworks.

With that background i thought web development meant scripting languages, in fact, i'd repeatedly read that CGI isn't a good development choice because after each request, a new fork is created turning the proccess very inefficient. Well, this site shows that the inneficient CGI is more efficient than scripting languages (many times faster).

After that introduction, i'll show you an open source library that allows CGI creation using FreePascal. It's name is Pascal Server Pages (PSP for short).

Many times i wanted to create dynamic web pages in FreePascal, and must admit, i tought Pascal Server Pages was an emulation of ASP, but for Pascal language, and did't pay much attention to it. But last week, i found PSP fits very well into the kind of software i like to create, fast-efficient and easy to improve.

You can start reading Vladimirs Sibirov's introduction to PSP to learn more.

Well, we have arrived to the end of this post, and i know you want to see some code. The example below is a neat trick that allows you to embed images into the HTML generated by PSP.

To compile this program, you must download PSP from http://sourceforge.net/projects/pascal-webdev/ and make sure your compiler can find the base64enc unit included in the PSP source tree. Also you'll need a web server capable of executing CGI files (i preffer Apache) and copy the resulting file (embedimage.exe) to it.

program embedimage;

{$mode objfpc}{$H+}

uses
 SysUtils,
 Classes,
 base64enc,
 pwu;

var
 lImage:    TMemoryStream;
 lString:   PChar;
 lStrImage: string;

begin
 WebWriteLn('<html>');

 WebWriteLn('Hello, this is an embedded image<hr>');

 (* Load the image from disk as a stream *)
 lImage := TMemoryStream.Create;
 lImage.LoadFromFile('image1.jpg');

 (* Convert the stream to a Base64 encoded string *)
 GetMem(lString, lImage.Size);
 lImage.Read(lString^, lImage.Size);
 SetString(lStrImage, lString, lImage.Size);

 WebWriteLn('</html>');
 WebWriteLn('<img src="data:image/jpg;base64,'
   + base64_encode(lStrImage) + '">');
end.

Why i can't capture exceptions from Dlls?

2006-09-20T10:03:00.000-07:00

A very common topic in newsgroups is Dll Exception handling. If your dll raises an exception, the exception handler in the host app should not be able to recognize the class of the exception it trapped. That's because the host application doesn't recognizes the exception class raised by the dll.

The recommended aproach is to capture any exception within the Dll and create functions that return values of success or failure, then the host application can evaluate such results and raise an exception.

This is an example produces different results when compiled with Delphi or FreePascal, you shouldn't do this:

library failedlib;

uses
 SysUtils;


function divide(a, b: integer): Boolean; cdecl;
begin
 if b = 0 then
   raise Exception.Create('Can''t divide by zero');
 Result := True;

end;

exports
 divide;

end.

program sample;

{$APPTYPE CONSOLE}

type
 TDivide = function (a, b: integer): Boolean; cdecl;


var
 FuncDivide: TDivide;
 lHandle:    Cardinal;

begin
lHandle := LoadLibrary('failedlib.dll');
if lHanlde <> 0 then

begin
  FuncDivide = GetProcAddress(lHandle, 'divide');
  if pointer(@FuncDivide) <> nil then
  begin

    try
      if FuncDivide(10, 0) then
        writeln('Success!');
    except

      writeln('Failure!');
    end;
  end;
  UnloadLibrary(lHandle);
end; 
end.

The correct method is this:

library correctlib;

uses
 SysUtils;


function divide(a, b: integer): Boolean; cdecl;
var
 c: Integer;
begin
 (* Catch any exception before return *)
 try

   c := a div b;
   Result := True;
 except
   Result := False;
 end;
end;

exports
 divide;


end.

program sample;

{$APPTYPE CONSOLE}

type
 TDivide = function (a, b: integer): Boolean; cdecl;


var
 FuncDivide: TDivide;
 lHandle:    Cardinal;

begin
lHandle := LoadLibrary('correctlib.dll');
if lHanlde <> 0 then

begin
  FuncDivide = GetProcAddress(lHandle, 'divide');
  if pointer(@FuncDivide) <> nil then
  begin

    if FuncDivide(10, 0) then
      writeln('Success!')
    else
      (* The exception is raised in the host app, not in the DLL *)

      raise 'Failure!';
  end;
  UnloadLibrary(lHandle);
end; 
end.

Cross compiler Data Access

2006-09-06T08:35:00.000-07:00

Object Pascal compilers offers a wide range of classes and components that allows you to connect to different databases, ranging from BDE to open source components. But many of them only works in Delphi or only in FreePascal, turning very dificult to develop cross platform database applications.

One of the most known data access components is Zeos Lib, a heavy weight component library that allows you to acces a lot of database backends like MySql, PostGreSQL, Oracle, MsSql Server, Interbase and others. It's free, open source and works on Delphi, Kylix and FreePascal. You can get more information and download from http://sourceforge.net/projects/zeoslib, also, if you want to install it in Lazarus must read this http://wiki.lazarus.freepascal.org/index.php/Zeos_tutorial.

If you (like me) like smaller and faster programs, i'll recommend a small library called LibSQL. Just like Zeos, this library allows access to different databases, but allows you to use driver you want, making the executable many times smaller than Zeos. If you want to download it, go to http://sourceforge.net/projects/libsql

If you know different cross platform libraries or components like Zeos or LibSQL, please comment on them.

Designing for the future

2006-08-15T12:21:00.000-07:00

Most programmers doesn't take care of the future of the software they're writing, they just try to make it work and send it to the market. But many times, when a customer asks for a change, very large portions of the code must be rewritten. This is specially known in applications that share Database, Business Rules and User Interface.

A large portion of Object Pascal developers came from Delphi, where one tend to think in a Delphish (RAD) way, placing data aware components inside their UI forms, then adding another form and placing more data components inside it and so on (with forms i mean TForms and TDataModules). This method of working, can be very rapid in small applications, but in enterprise-class software this approach can cause more headaches than applauses.

Must be a better way

The first step to architect your software for the future is to identify what parts can be classified into Database, Business Rules and User Interface, i'll call them packages (don't confuse with Borland Package Libraries) so you'll end writing Database package, BR package and UI package. Each package must have an interface to communicate with the world (other packages), so if you whant to execute a function (or method) that retrieves information from a database, just call the Database package and access to the required method.

Supouse your application uses a Database package that connects to MySql, and your customer uses an Oracle server. It's easier to create a new package for Oracle than rewriting the whole program.

The same rule applies to user interfaces. Using modules like i propouse, your application's Business Rules can be shared by Win32 UI, GTK UI, Web UI or something else without re-coding busines rules and database access for every UI client.

It's not rocket science

This method of working receives the name of MVC (Model-View-Controller), a Design Pattern used mostly in modern web environments (in Java and .NET especially), but applies to any object oriented language and fills very well in Object Pascal.

To communicate different packages, i recommend not to use any platform nor language native feature. With simple shared libraries (like i explain in this post), you can create portable, cross-platform applications that works for the future.

Feel free to express your opinions about this approach.

Example added

2006-06-23T06:09:00.000-07:00

In order to finalize this series of articles related to interfacing objects with Dll's i've added an example (as promised on my last post) you can download from this url.

Feel free to post comments about the example and/or propose alternatives.

Virtual-Abstract objects as Interfaces

2006-06-20T12:43:00.000-07:00

In my last post i exposed a method to share objects between Dll's and applications. As i wrote in that post, the compiler doesn't know the type of received object (it assumes it's a pointer), so you must cast it to the correct type. In the code below, i casted it to TObject only to be sure it compiles correctly:

(* Initialize exported class *)
myObj := TObject(_EC).create;
(* work with exported class 
       :
       :
       ... and free exported class *)
myObj.free;

This aproach allows you to create objects inside Dlls (in some cases it's all you need), but compiler can't access public methods and properties of the object because it doesn't know the object's type.

Delphi & Kylix developers can argue (with reason) that if you use Packages (bpl's) instead of Dll's you can share objects and the compiler will intelligently know wich is the type of shared objects. But if applications must compile in FreePascal in addition to that compilers you have to devise a workaround.

Well, the workaround is to create an interface who'll allow the compiler to access objects methods and properties. Object Pascal knows two Interface types, COM Interfaces and CORBA interfaces wich i'm not going to explain here, and a third one that isn't really an Interface type but works the same way is called Virtual-Abstract Objects, it will help you with code portability.

To define a Virtual-Abstract Object you have to create a class with all of it's methods virtual and abstract as this code shows:

Type
 TAgeCalculator = Class
 public
   function GetAge: Integer; virtual; abstract;
   procedure SetAge; virtual; abstract;
 end;

Abstract means that the implementation of the object doesn't have to be in the same level of inheritance of the interface, but inherited to be implemented. Virtual means methods can be oberriden.

As an example, if you need to share objects between Dll's and must access to methods and properties, you have to include the class definition (like TAgeCalculator) in both units, the one wich implements the methods and the one wich access to the instance.

In my next post i'll include a complete example of this.

How to import an Object from a dll?

2006-06-13T07:34:00.000-07:00

Some time ago, a boss of a company that i used to work gave a course of COM & DCOM technologies because he thought packages (bpl's) wasn't working as one might expect (actually the problem wasn't packages at all, but that's another story). He was trying to change packages to COM interfaces as a way to share application's objects with Dll's (dynamic link libraries). Thanks god we solved the problem without changing the more than 50 packages the application uses.

Well, there's a way to export objects (and classes) from dll's. The first thing you have to do is to code a Unit containing the classes you want to export:

{ MyClasses.pas }

unit MyClasses;

interface

uses
 Classes;

type
 TMyClass = class
  public
    constructor create;
    (* Here you can create the methods you want *)
  end;

implementation

constructor TMyClass.create;
begin
 writeln('Create!!!');
end;

end.

The second thing to do is to create the the library project and include the recent unit:

{ interfaces.dpr }

library interfaces;

uses
 Classes,
 MyClasses;

function GetMyExportedClass: Pointer; cdecl;
begin
 Result := GetClass('TMyClass');
end;

exports
 GetMyExportedClass;

end.

After this you have to create a program that loads the dll and execute the exported function (GetMyExportedClass) to create TMyClass objects:

{ test.dpr }

program test;

{$APPTYPE CONSOLE}

uses
  {$ifdef fpc}
dynlibs,
  {$endif}
SysUtils,
Classes;

var
  {$ifdef fpc}
mHandle: TLibHandle;
  {$else}
mHandle: THandle;
  {$endif}

var
myObj: TObject;
_EC: function : Pointer; cdecl;

begin
  (* load shared library *)
  if (pointer(mHandle) = nil) then
  begin
  (* Try to load shared library *)
  mHandle := LoadLibrary('lib.dll');
    if (pointer(mHandle) <> nil) then
    begin
    writeln('Loaded!');
   (* instantiate a TMyExportedClass object *)
   _EC := GetProcAddress(mHandle, 'GetMyExportedClass');
   if (pointer(@_EC) <> nil) then
   begin
    (* Initialize exported class *)
     myObj := TObject(_EC).create;
    (* work with exported class 
           :
           :
           ... and free exported class *)
    myObj.free;
  end;
 (* unload shared library *)
 {$ifdef fpc}
 UnLoadLibrary(mHandle);
 {$else}
 FreeLibrary(mHandle);
 {$endif}
end;
end;
end.

The code above exports an object from a dll, but as the object must be type casted to TObject, you can't view it's methods. In the next post, i'll show you how to create interfaces that allows to view the object's metods.

First blog!

2006-06-13T05:06:00.000-07:00

Hi everybody, my name is Leonardo M. Ramé, i'm software developer from Córdoba, Argentina and started this blog to help the Object Pascal community with some hacks useful to me (and you).