Solved

Indy and TidTCPServer

Posted on 2007-11-29
5
4,601 Views
Last Modified: 2012-05-05
Hi Guys, please I need some help here.

I am doing a program that uses indy with delphi 7. I had a technical question and sent my question to the support of the indy component:

My question was:

//////////////////////////////////////////// My Question to indy support
Hi,

I am using delphi 7 with indy 10.2.3 and TidTCPServer

I did this in my program (only a test):


type
TMyContext = class(TIdContext)
 public
     user_id: integer
     procedure SendMsg(const ID: Integer);
 end;


In OnConnect event of TidTCPServer i did this:


        with TMyContext(AContext) do
        begin
            user_id:=strtoint(Connection.IOHandler.ReadLn) ;
            Connection.IOHandler.WriteLn('User ' + inttostr(user_id) +
'connected');
        end;


In OnExecute i did this:


var
    touser:integer
begin
    touser:=strtoint(AContext.Connection.IOHandler.ReadLn);
    TMyContext(AContext).SendMsg(touser);
end


And in SendMsg procedure a did this:



procedure TMyContext.SendMsg(const ID: Integer);
    var
        List: TList;
        Context: TMyContext;
        I: Integer;
    begin

        List := FContextList.LockList;
        try
            for I := 0 to List.Count-1 do
            begin
                Context := TMyContext(List[I]);
                if Context.user_id = ID then
                begin
                    try
                        Context.Connection.IOHandler.WriteLn('Hi');
                    except
                    end;
                    Exit;
                end;
            end;
        finally
            FContextList.UnlockList;
        end;
    end;


Well, when a client send the number of another client, this client receives
the message 'HI'.
Now i need read a table in my data base and get the user_id, and then send
to the right connection. I dont know how do this outside of OnExecute event.
//////////////////////////////////////////////////////////////////////////// End Of my question

Well, the answer was:

///////////// The answer

In order for that to work properly, you need to implement a locking
mechanism in your Context class so that multiple threads cannot write to the
same client at the same time (locking the ContextList is not enough).  The
alternative is to implement a FIFO queue in the Context class that SendMsg()
simply appends to, and then have the OnExecute handler write out the
contexts of the queue peridoically.

> Now i need read a table in my data base and get the user_id, and
> then send to the right connection. I dont know how do this outside
> of OnExecute event.

Yes, you do, because your SendMsg() method is already doing it.  The
TIdContext.FContextList member points to the same list that the
TIdTCPServer.Contexts property points to, and that property is declared as
public, so any code you have that can reach the TIdTCPServer object can
access the Contexts list.

///////////////////// End of answer

Please Guys, I need help to develop  this locking mechanism in my Context class.
Can someone help me?

Thx
0
Comment
Question by:alpires
  • 3
  • 2
5 Comments
 
LVL 28

Expert Comment

by:ciuly
ID: 20380429
there is even a simpler one, using critical sections. I like CS better :)

see attached code.

depending on when you will do the userid "setting", you might not need to lock that write/read, but I did it anyway, jsut to be on the safe side.

PS: I wrote the code dirrectly in the browser so if there are minro compilation errors, you should be able to fix them. if not, just ask.
uses ... SyncObjs,..;
 

TMyContext = class(TIdContext)

private

  fuserid:integer;

  cs:TCriticalSection;

  function getUserId:integer;

  procedure setuserid(value:integer);

public

  property user_id: integer read getUserId write setuserid;

  procedure SendMsg(const ID: Integer);

  constructor Create(

      AConnection: TIdTCPConnection;

      AYarn: TIdYarn;

      AList: TIdThreadList = nil

      ); override;

  destructor Destroy; override;

end;
 
 

procedure TMyContext.SendMsg(const ID: Integer);

    var

        List: TList;

        Context: TMyContext;

        I: Integer;

    begin

cs.acquire;

try

        List := FContextList.LockList;

        try

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

            begin

                Context := TMyContext(List[I]);

                if Context.user_id = ID then

                begin

                    try

                        Context.Connection.IOHandler.WriteLn('Hi');

                    except

                    end;

                    Exit;

                end;

            end;

        finally

            FContextList.UnlockList;

        end;

finally

  cs.release;

end;

    end;
 

constructor TMyContext.Create(

      AConnection: TIdTCPConnection;

      AYarn: TIdYarn;

      AList: TIdThreadList = nil

      ); 

begin 

  cs:=TCriticalSection.Create;

  inherited;

end;
 

destructor TMyContext.Destroy;

begin

  freeandnil(cs);

  inherited;

end;
 

function TMyContext.getUserId:integer;

begin

  ca.acquire;

  try

    result:=fuserid;

  finally

    ca.release

  end;

end;
 

procedure TMyContext.setuserid(value:integer);

begin

  ca.acquire;

  try

    fuserid:=value;

  finally

    ca.release

  end;

end;

Open in new window

0
 

Author Comment

by:alpires
ID: 20385746
OK, Well What i want to do is insert in my data base (firebird with IBO component) all inbound message, I made this and send to indy support:

//////////////////
type
TMyContext = class(TIdContext)
 public
   user_id: integer
   ibSession:TIB_Session;
   ibConnection:TIB_Connection;
   ibtransacao:TIB_Transaction;
   my_table:tib_cursor;
 end;


procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
    touser:integer
begin

    touser:=strtoint(AContext.Connection.IOHandler.ReadLn);

    TMyContext(AContext).ibSession := TIB_Session.Create(nil);
    TMyContext(AContext).ibConnection :=
TIB_Connection.Create(TMyContext(AContext).ibSession );
    TMyContext(AContext).ibtransacao:=TIB_Transaction.Create(TMyContext(AContext).ibSession
 );
    TMyContext(AContext).ibtransacao.IB_Connection:=TMyContext(AContext).ibConnection
;
    TMyContext(AContext).ibtransacao.Isolation:=tiCommitted;
    TMyContext(AContext).ibtransacao.IB_Session:=TMyContext(AContext).ibSession
;
    TMyContext(AContext).ibConnection.DatabaseName := 'mydb';
    TMyContext(AContext).ibConnection.Path :='mydb.fdb';
    TMyContext(AContext).ibConnection.Server := 'localhost';
    TMyContext(AContext).ibConnection.UserName := 'sysdba';
    TMyContext(AContext).ibConnection.Password := 'masterkey';
    TMyContext(AContext).ibConnection.Protocol := cpTCP_IP;
    TMyContext(AContext).ibConnection.SQLDialect:=3;
    TMyContext(AContext).ibconnection.DefaultTransaction:=TMyContext(AContext).ibtransacao;
    TMyContext(AContext).ibconnection.IB_Session:=TMyContext(AContext).ibSession
;
    TMyContext(AContext).ibConnection.Connect;


        TMyContext(AContext).my_table:=TIB_Cursor.Create(TMyContext(AContext).ibSession);
        TMyContext(AContext).my_table.IB_Connection:=TMyContext(AContext).ibConnection;
        TMyContext(AContext).my_table.IB_Session:=TMyContext(AContext).ibSession;
        TMyContext(AContext).my_table.SQL.Add('insert into tb_userid
(userid) values (:id)');
        TMyContext(AContext).my_table.ParamByName('id').AsInteger:=touser;
        TMyContext(AContext).my_table.Open;
        TMyContext(AContext).ibtransacao.CommitRetaining;

       TMyContext(AContext).my_table.Free;
       TMyContext(AContext).tb_sessao.Free;
       TMyContext(AContext).ibtransacao.Free;
       TMyContext(AContext).ibConnection.Free;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
 var
   List: TList;
   Context: TMyContext;
   I: Integer;
begin
  tb_readline.open
  while tb_readline.recordcount<>0 then
  begin
    List :=  IdTCPServer1.Contexts.LockList
    try
      for I := 0 to List.Count-1 do
      begin
        Context := TMyContext(List[I]);
        if Context.user_id = tb_readline.FieldValues('userid') then
        begin
          try
            Context.Connection.IOHandler.WriteLn('Hi');
            tb_readline.delete
          except
        end;
        Exit;
      end;
    end;
    finally
    IdTCPServer1.Contexts.LockList.UnlockList;
  end;
end;
/////////////////////////

The answer was:

//////////////////////
I think creating and tearing down all those database components on each
inbound message is a bit overkill.  I suggest you move the database code to
its own thread so you can keep a single connection to the database alive at
all times.  Each client would simply post a request to that thread and let
it handle the transactions on its own time.
///////////////////// end of answer

I dont know how do this. Please can you help me ?

0
 
LVL 28

Accepted Solution

by:
ciuly earned 500 total points
ID: 20385931
what they say, makes sens.e but in your case that requires some more code to write and change and ttc which is defintly complicated for you, as I see.

so, easier way is to use what I ahve already said, but with a minor change: "global" locking of the object.

(I won't write all the code again, it's up there. just definitions and usage. you won't need the properties as in my initial post either)

there is also a need for a lock on the connection (db?) itself (every context will have different ciritcal section, different session/connecitone/etc objects), but the DB will be the same. I never worked with firebird and related, but if that is a problem, then you need to create one critical section in your idtcpserver declaration and acquire/release that critical section every time you work with the DB.
in this case, you might not even need the critical sectiosn for the context since those properties are db related anyway and will be protected by the DB general critical section declared in the server.
however, if you have other stuff that is used elsewhere not just for db stuff, and those stuff can be used by more than one thread at a time, then you will need those critical sections.


1 question:
in IdTCPServer1Execute you create and later on destroy the objects (ibSession, ibConnection, etc). why are you putting those in the tmycontext class anyway? why not local variables in the procedure?
type

TMyContext = class(TIdContext)

 private

   cs:TCriticalSection;

 public

   user_id: integer

   ibSession:TIB_Session;

   ibConnection:TIB_Connection;

   ibtransacao:TIB_Transaction;

   my_table:tib_cursor;

   procedure lock;

   procedure unlock;

 end;
 

procedure TMyContext.lock;

begin

  cs.acquire;

end;
 

procedure tmycontext.unlock;

begin

  cs.release;

end;
 

.....
 
 

procedure TForm1.Timer1Timer(Sender: TObject);

 var

   List: TList;

   Context: TMyContext;

   I: Integer;

begin

  tb_readline.open

  while tb_readline.recordcount<>0 then

  begin

    List :=  IdTCPServer1.Contexts.LockList

    try

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

      begin

        Context := TMyContext(List[I]);

Context.lock;

try

        if Context.user_id = tb_readline.FieldValues('userid') then

        begin

          try

            Context.Connection.IOHandler.WriteLn('Hi');

            tb_readline.delete

          except

          end;

         Exit;

        end;

finally

  Context.unlock;

end;

    end;

    finally

    IdTCPServer1.Contexts.LockList.UnlockList;

  end;

end;
 
 

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);

var

    touser:integer

begin
 

    touser:=strtoint(AContext.Connection.IOHandler.ReadLn);

TMyContext(AContext).lock;

try

    TMyContext(AContext).ibSession := TIB_Session.Create(nil);

    TMyContext(AContext).ibConnection := 

TIB_Connection.Create(TMyContext(AContext).ibSession );

    TMyContext(AContext).ibtransacao:=TIB_Transaction.Create(TMyContext(AContext).ibSession 

 );

    TMyContext(AContext).ibtransacao.IB_Connection:=TMyContext(AContext).ibConnection 

;

    TMyContext(AContext).ibtransacao.Isolation:=tiCommitted;

    TMyContext(AContext).ibtransacao.IB_Session:=TMyContext(AContext).ibSession 

;

    TMyContext(AContext).ibConnection.DatabaseName := 'mydb';

    TMyContext(AContext).ibConnection.Path :='mydb.fdb';

    TMyContext(AContext).ibConnection.Server := 'localhost';

    TMyContext(AContext).ibConnection.UserName := 'sysdba';

    TMyContext(AContext).ibConnection.Password := 'masterkey';

    TMyContext(AContext).ibConnection.Protocol := cpTCP_IP;

    TMyContext(AContext).ibConnection.SQLDialect:=3;

    TMyContext(AContext).ibconnection.DefaultTransaction:=TMyContext(AContext).ibtransacao;

    TMyContext(AContext).ibconnection.IB_Session:=TMyContext(AContext).ibSession 

;

    TMyContext(AContext).ibConnection.Connect;
 
 

        TMyContext(AContext).my_table:=TIB_Cursor.Create(TMyContext(AContext).ibSession);

        TMyContext(AContext).my_table.IB_Connection:=TMyContext(AContext).ibConnection;

        TMyContext(AContext).my_table.IB_Session:=TMyContext(AContext).ibSession;

        TMyContext(AContext).my_table.SQL.Add('insert into tb_userid 

(userid) values (:id)');

        TMyContext(AContext).my_table.ParamByName('id').AsInteger:=touser;

        TMyContext(AContext).my_table.Open;

        TMyContext(AContext).ibtransacao.CommitRetaining;
 

       TMyContext(AContext).my_table.Free;

       TMyContext(AContext).tb_sessao.Free;

       TMyContext(AContext).ibtransacao.Free;

       TMyContext(AContext).ibConnection.Free;

finally

  TMyContext(AContext).unlock;

end;

end;

Open in new window

0
 

Author Comment

by:alpires
ID: 20386111
>>in IdTCPServer1Execute you create and later on destroy the objects (ibSession, ibConnection, etc). why >>are you putting those in the tmycontext class anyway? why not local variables in the procedure

Well You think this way will work?:

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
   touser:integer
   ibSession:TIB_Session;
   ibConnection:TIB_Connection;
   ibtransacao:TIB_Transaction;
   my_table:tib_cursor;
begin
    touser:=strtoint(AContext.Connection.IOHandler.ReadLn);
TMyContext(AContext).lock;
try
    ibSession := TIB_Session.Create(nil);
    ibConnection := TIB_Connection.Create(ibSession );
    ibtransacao:=TIB_Transaction.Create(ibSession );
    ibtransacao.IB_Connection:=ibConnection;
    ibtransacao.Isolation:=tiCommitted;
    ibtransacao.IB_Session:=ibSession;

    ibConnection.DatabaseName := 'mydb';
    ibConnection.Path :='mydb.fdb';
    ibConnection.Server := 'localhost';
    ibConnection.UserName := 'sysdba';
    ibConnection.Password := 'masterkey';
    ibConnection.Protocol := cpTCP_IP;
    ibConnection.SQLDialect:=3;
    ibconnection.DefaultTransaction:=TMyContext(AContext).ibtransacao;
    ibconnection.IB_Session:=TMyContext(AContext).ibSession;
    ibConnection.Connect;
 
     my_table:=TIB_Cursor.Create(TMyContext(AContext).ibSession);
     my_table.IB_Connection:=TMyContext(AContext).ibConnection;
     my_table.IB_Session:=TMyContext(AContext).ibSession;
     my_table.SQL.Add('insert into tb_userid (userid) values (:id)');
     my_table.ParamByName('id').AsInteger:=touser;
     my_table.Open;
     ibtransacao.CommitRetaining;
 
     my_table.Free;
     tb_sessao.Free;
     ibtransacao.Free;
     ibConnection.Free;
finally
  TMyContext(AContext).unlock;
end;
end;
//////////////// end of code

But if I create a thread like this:

  TMyThread = class(TThread)
  private

   ibSession:TIB_Session;
   ibConnection:TIB_Connection;
   ibtransacao:TIB_Transaction;
   my_table:tib_cursor;

  protected
     procedure Execute; override;
     procedure insert_row(Data: INteger);
  public
     constructor Create();
  end;



procedure TMyThread.Execute;
begin
 
    ibSession := TIB_Session.Create(nil);
    ibConnection := TIB_Connection.Create(ibSession );
    ibtransacao:=TIB_Transaction.Create(ibSession);
    ibtransacao.IB_Connection:=ibConnection;
 
    (...)

    ibConnection.Connect;
 
    my_table:=TIB_Cursor.Create(.ibSession);
    my_table.IB_Connection:=ibConnection;
    my_table.IB_Session:=ibSession;
    my_table.SQL.Add('insert into tb_userid (userid) values (:id)');


    while not Terminated do
    begin
      application.ProcessMessages;
    end;
  finally

       my_table.Free;
       tb_sessao.Free;
       ibtransacao.Free;
       ibConnection.Free;

  end;
end;


procedure TMyThread.insert_row(Data: Integer);
begin
  my_table.close;
  my_table.ParamByName('id').AsInteger:=Data;
  my_table.Open;
  ibtransacao.CommitRetaining;
end;

If i to call insert_row from OnExecute this will work ? But how protect this code with TCriticalSection and how cal insert_row from OnExecute
0
 
LVL 28

Expert Comment

by:ciuly
ID: 20390705
B grade?

*Comment removed by Netminder 2 Dec 2007*
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now