Solved

Indy and TidTCPServer

Posted on 2007-11-29
5
4,724 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
5 Comments
 
LVL 28

Expert Comment

by:2266180
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:
2266180 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:2266180
ID: 20390705
B grade?

*Comment removed by Netminder 2 Dec 2007*
0

Featured Post

Enroll in May's Course of the Month

May’s Course of the Month is now available! Experts Exchange’s Premium Members and Team Accounts have access to a complimentary course each month as part of their membership—an extra way to increase training and boost professional development.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
error 1.1 400 Bad request idhttp delphi 18 271
Downloading email attachments 2 96
Convert a string into a TDateTime 5 80
Using MMsystem To change audio input 1 38
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…
This video shows how to use Hyena, from SystemTools Software, to update 100 user accounts from an external text file. View in 1080p for best video quality.

732 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