Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Pascal, Borland Delphi 7, IdCmdTCPServer1.Contexts.LockList

Posted on 2007-08-04
20
Medium Priority
?
1,240 Views
Last Modified: 2013-11-05
Somebody can explain for what and how to use this command from TIdCmdTcpServer on Indy 10:

IdCmdTCPServer1.Contexts.LockList
0
Comment
Question by:rafaelrgl
  • 10
  • 6
  • 4
20 Comments
 
LVL 17

Accepted Solution

by:
Aleksandar Bradarić earned 1000 total points
ID: 19631859
LockList generally gives you the list of current connections. See some examples here: http://www.devarticles.com/c/a/Delphi-Kylix/Sever-Side-Chat-Application-with-Borland-DelphiIndy/3/
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19634009
I get this code there, but how to add a mycontext when the client connects on the server, i thy like that and did not worked?

procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  Tempo, Mensagem: string;
  Maq, Ver, PathInstall : shortstring;
  LVCod : integer;
  mycontext : TMyContext;
begin
            mycontext.IP := AContext.Connection.Socket.Binding.PeerIP;
            mycontext.Nick := Maq;
            mycontext.Con := now();
            mycontext.Create(AContext.Connection,AContext.Yarn,nil); // i think this is not working

becouse my program close when this command is execute????






here is the code that i got there:

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

TMyContext = class(TIdContext)
        public
           IP: String;
           Nick: String;
           Con: TDateTime;
           // compname:string;
           procedure SendMsg(const ANick: String; const AMsg: String);
           //procedure BroadcastMsg(const bmsg: String);
           procedure BroadcastMsgAll(const ANick: String; const bmsg: String);
           procedure SendNicks;
           //procedure SendFile(const ANick,Fn:string);
        end;


////////////////////////////////////////////////////////////////////////////////
///////////// function to TidContext .///////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////


procedure TMyContext.SendNicks;
var
  List: TList;
  Context: TMyContext;
  I: Integer;
begin
    List := FContextList.LockList;
    try
       if List.Count > 1 then
       begin
          //Connection.IOHandler.WriteLn('Currently Connected:');
          for I := 0 to List.Count-1 do
          begin
             Context := TMyContext(List[I]);
             if Context <> Self then Connection.IOHandler.WriteLn('list@'+ Context.Nick); end;
          end else
             Context.Connection.IOHandler.WriteLn('list@No-one else isconnected');
    finally
          FContextList.UnlockList;
    end;
end;

procedure TMycontext.BroadcastMsgAll(const ANick: String; const bmsg: String);
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 <> Self  then
              try
                 Context.Connection.IOHandler.WriteLn(ANick + '> ' + bmsg);
              except end;
           end;
    finally
       FContextList.UnlockList;
    end;
end;

procedure TMyContext.SendMsg(const ANick: String; const AMsg:String);
var
   List: TList;
   Context: TMyContext;
   I: Integer;
begin
//lock the list, so nothing is added while searching for the name
    List := FContextList.LockList;
    try
       for I := 0 to List.Count-1 do
       begin
           //start the search
           Context := TMyContext(List[I]);
           if Context.Nick = ANick then
           begin
               try
                 //if found sent the message
                 Context.Connection.IOHandler.WriteLn(AMsg);
               except
               end;
               Exit;
           end;
       end;
    finally
       FContextList.UnlockList;
    end;
    //if not found sent an error msg
   //     Self.Connection.IOHandler.WriteLn('The name you send the
   // message to does not exist. Please click on ''Get list of Names on
   // Chat'' button to get a full list of names.');
end;

{procedure TMyContext.SendFile(const ANick,Fn:string);
var
   List: TList;
   Context: TMyContext;
   I: Integer;
   FStream,fstream2: TFileStream;
   IdStream,idstream2: TIdStreamVCL;
   MStream: TMemoryStream;
begin
   // lock the list
   List := FContextList.LockList;
   try
       for I := 0 to List.Count-1 do
       begin
          //search for the recipient name
          Context := TMyContext(List[I]);
          if Context.Nick = ANick then
          begin
             try
                //found it, now create the file
                FStream := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
                try
                  IdStream := TIdStreamVCL.Create(fstream);
                    try
                       //send it!
                       Context.Connection.IOHandler.WriteLn('pic@'+fn+';Sending file...');
                       Context.Connection.IOHandler.Write(IdStream, 0,True);
                       Context.Connection.IOHandler.WriteLn('done!');
                    finally
                       IdStream.Free;
                    end;
                 finally
                    FStream.Free;
                 end;
             //if recipient name not found
             except
             end;
             Exit;
       end;
   end;
   finally
      FContextList.UnlockList;
   end;
       // Self.Connection.IOHandler.WriteLn( The name you send the
        //message to does not exist. Please click on ''Get list of Names on
       // Chat'' button to get a full list of names.');
end;

}
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
0
 
LVL 17

Expert Comment

by:Aleksandar Bradarić
ID: 19634020
MyContext is a class. You have to create an object first, assign later.
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 1

Author Comment

by:rafaelrgl
ID: 19635011
so, can you show me how to do it?
0
 
LVL 17

Expert Comment

by:Aleksandar Bradarić
ID: 19635083
Depends on what you're trying to do, but the example above lists almost everything you need... What exactly are you having problems with? The point here is to loop through the list and by setting `Context := TMyContext(List[I]);` to get access to each item in turn. Not sure what you're trying to do...
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19635972
when the clients connects, i can't add a client???????: that's not the right way to add a mycontext!!!

procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  mycontext : TMyContext;
begin
            mycontext.IP := AContext.Connection.Socket.Binding.PeerIP;
            mycontext.Nick := Maq;
            mycontext.Con := now();
            mycontext.Create(AContext.Connection,AContext.Yarn,nil);
0
 
LVL 17

Expert Comment

by:Aleksandar Bradarić
ID: 19637000
You don't add a client. It's already there. You just read it's information from the structure/class.
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19640167
ok, but what about the vars nick, con and ip that we created, how to add this information on the client when it connects? where this var is update on this code? that's what i want to know, i try like this and my program crashs:

procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  mycontext : TMyContext;
begin
            mycontext.IP := AContext.Connection.Socket.Binding.PeerIP;
            mycontext.Nick := Maq;
            mycontext.Con := now();
            mycontext.Create(AContext.Connection,AContext.Yarn,nil);
0
 
LVL 17

Expert Comment

by:Aleksandar Bradarić
ID: 19640939
It srashes because `mycontext` is nil when you try to assign values to `mycontext.IP`. You have to create it first with something like `mycontext := TMyContext.Create(...)`. Then you can assign values.

Now, what do you want to achieve with it?

Why don't you just use `mycontext := TMyContext(AContext)` in that event and then assign all the properties?
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19641395
here is the message when we try the command sendmsg:

Access violation at address 7C901010 in module 'ntdll.dll'. Read of address 0000001C


can you put this in code, i think you are not understando what's the problem, put this in code and send a link to download. you will see what i'm talking about. also i'm using tidcmdtcpclient and tidcmdtcpserver from indy 10. so i'm waiting the code.
0
 
LVL 10

Assisted Solution

by:dinilud
dinilud earned 1000 total points
ID: 19644060
0
 
LVL 17

Expert Comment

by:Aleksandar Bradarić
ID: 19644417
I'm trying to understand what you're trying to do, but I think you're going backwards... I see no point in your code. More details about what you are actually trying to do would be great... :(
0
 
LVL 10

Expert Comment

by:dinilud
ID: 19644816
Try like this


procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  mycontext : TMyContext;
begin    
            mycontext:= AContext;
            mycontext.IP := AContext.Connection.Socket.Binding.PeerIP;
            mycontext.Nick := Maq;
            mycontext.Con := now();
            .......................
            .......................
            try
               FContextList.LockList.Add(mycontext);
           finally
              FContextList.UnlockList;
          end;
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19647893
it's say like this: Incompatible types: 'TMyContext' and 'TIdContext'

but anyway, may i can do it like the example you show on delphi.about, only one thing that i don't want do it, on the example the server only send command back on the event onexecute, is there anyway to send command back to the client when i click in some button on my program??

and also, what's the better way to store the information about the clients:

like this:

type
  PClient   = ^TClient;
  TClient   = record
    HostName    : String[20];  { Hostname }
    PeerIP      : string[15];  { Cleint IP address }
    TakeShot    : boolean;     { explained later }
    Connected,                 { Time of connect }
    LastAction  : TDateTime;   { Time of last transaction }
    Thread      : Pointer;     { Pointer to thread }
  end;

or this way:

TMyContext = class(TIdContext)
        public
           IP: String;
           Nick: String;
           Con: TDateTime;
           // compname:string;
           procedure SendMsg(const ANick: String; const AMsg: String);
           //procedure BroadcastMsg(const bmsg: String);
           procedure BroadcastMsgAll(const ANick: String; const bmsg: String);
           procedure SendNicks;
           //procedure SendFile(const ANick,Fn:string);
        end;
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19648612
the way that example did will not work for me, image a 2000 client connect to the server then each client send a message to the server to check if there is a command to it, the network will crash like i never see it before, so what i need is a way to send a message to the client without the client send anything to check to the server. that's what i need.
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19648909
leannom, i think i'm understand what you sad. the variable FContextList.LockList it's allready there,

but how this structure to sendmsg will work with we do not add a nick or ip on the TmyContext????

take a look here:

procedure TMyContext.SendMsg(const ANick: String; const AMsg:String);
var
   List: TList;
   Context: TMyContext;
   I: Integer;
begin
//lock the list, so nothing is added while searching for the name
    List := FContextList.LockList;   /// get the list contexts from the variable.
    try
       for I := 0 to List.Count-1 do
       begin
           //start the search
           Context := TMyContext(List[I]);
           if Context.Nick = ANick then   /// here is what i'm telling to you, how this will work if we do not add a nick on the TMyContext?????
           begin
               try
                 //if found sent the message
                 Context.Connection.IOHandler.WriteLn(AMsg);
               except
               end;
   
0
 
LVL 10

Expert Comment

by:dinilud
ID: 19651951
OK. i try to study that code.


i think from that code this very importent.
We are assigning the contextclass as "TMyContext"

   constructor TForm1.Create(AOwner: TComponent);
    begin
        inherited Create(AOwner);
        ts.ContextClass := TMyContext;
    end;

..............

 {Here we are updatting IP,Con,Nick}
 procedure TForm1.tsConnect(AContext: TIdContext);
    begin
        with TMyContext(AContext) do
        begin
            Con := Now;
            if (Connection.Socket <> nil) then
            IP :=Connection.Socket.Binding.PeerIP;

            Nick := Connection.IOHandler.ReadLn;
            if Nick <> '' then
            begin
                Connection.IOHandler.WriteLn('Welcome ' + Nick + '!');
                BroadcastMsg(Nick + ' just joined!');
               //SendNicks;

            end else
            begin
                Connection.IOHandler.WriteLn('No Nick provided! Goodbye.');
                Connection.Disconnect;
            end;
        end;
    end;
0
 
LVL 10

Expert Comment

by:dinilud
ID: 19651961
Try like this

   constructor TForm1.Create(AOwner: TComponent);
    begin
        inherited Create(AOwner);
        IdCmdTCPServer1.ContextClass := TMyContext;
    end;

..............
procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
begin
            TMyContext(mycontext).IP := AContext.Connection.Socket.Binding.PeerIP;
            TMyContext(mycontext).Nick := Maq;
            TMyContext(mycontext).Con := now();

      ...................
      ....................

end;

0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19656737
did not worked, i think what i'm going to do is put a tcpserver on the client and a tcpclient on the server, then when i want to send something to the client i will send a message using tcpclient, then the client send a message back to the server asking for the task. It will be complicate this communication, becouse the client will be a server too, so maybe i will have someproblem with firewalls. So if you can build a sample with this code that we are trying above, will be great. but for now i will change the strateg.
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 19657299
i found the solution, if anyones has the same problem here we go:

the only thing that i don't know which one is better:


and also, what's the better way to store the information about the clients:

like this:

type
  PClient   = ^TClient;
  TClient   = record
    HostName    : String[20];  { Hostname }
    PeerIP      : string[15];  { Cleint IP address }
    TakeShot    : boolean;     { explained later }
    Connected,                 { Time of connect }
    LastAction  : TDateTime;   { Time of last transaction }
    Thread      : Pointer;     { Pointer to thread }
  end;

or this way:

TMyContext = class(TIdContext)
        public
           IP: String;
           Nick: String;
           Con: TDateTime;
           // compname:string;
           procedure SendMsg(const ANick: String; const AMsg: String);
           //procedure BroadcastMsg(const bmsg: String);
           procedure BroadcastMsgAll(const ANick: String; const bmsg: String);
           procedure SendNicks;
           //procedure SendFile(const ANick,Fn:string);
        end;








here is the code that will work for you guys:




type
////////////////////////////////////////////////////////////////////////////////
////////////////////////////Manager Clients/////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

  PClient   = ^TClient;
  TClient   = record
    HostName    : String[20];  { Hostname }
    PeerIP      : String[15];  { Cleint IP address }
    Connected,                 { Time of connect }
    LastAction  : TDateTime;   { Time of last transaction }
    AContext    : Pointer;     { Pointer to thread }
    Connection  : TIdTCPConnection;
  end;

  //put this on the var section
  //var
  //Clients : TThreadList;

////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////





then when the clients connect to the server you put this code:

procedure TFPrinc.IdCmdTCPServer1Connect(AContext: TIdContext);
var
  NewClient: PClient;
begin
            GetMem(NewClient, SizeOf(TClient));

            NewClient.PeerIP      := AContext.Connection.Socket.Binding.PeerIP;
            NewClient.TakeShot    := False;
            NewClient.Connected   := Now;
            NewClient.LastAction  := NewClient.Connected;
            NewClient.AContext    :=  Acontext;
            NewClient.Connection  := Acontext.Connection;
            AContext.Data := TObject(NewClient);
            Clients.LockList.Add(NewClient);
            Clients.UnlockList;


then to send message back to all clients you do:


var
  AClient :PClient;
  i:integer;
begin
  with Clients.LockList do
  try
    for i := 0 to Count-1 do
    begin
      AClient := Items[i];
      AClient.Connection.IOHandler.WriteLn('hello client!!!!');
    end;
  finally
    Clients.UnlockList;
  end;
end;





0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
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…
this video summaries big data hadoop online training demo (http://onlineitguru.com/big-data-hadoop-online-training-placement.html) , and covers basics in big data hadoop .
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…
Suggested Courses

580 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