• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 471
  • Last Modified:

Simple client/server application continued

Hi,

I took the example that was made by TheRealLoki from this question :

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21842452.html

How do I enumerate (get information) of all connected clients ??

Suppose I want to write the _ID of all connected clients.

Another strange thing is, I put "Label2" in the fServerMain form.

Then I changed two of the events, added this line :

Label2.Caption := IntToStr(IdTCPServer1.Threads.LockList.Count);

I just want to print the number of connected clients.

procedure TfServerMain.IdTCPServer1Connect(AThread: TIdPeerThread);
    var
        ID_: string;
    begin
        Label2.Caption := IntToStr(IdTCPServer1.Threads.LockList.Count);
        ID_ := AThread.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AThread.Connection.Socket.Binding.PeerPort);
        AThread.Data := TClientSpecificData.CreateWithSettings(ID_);
        LogMessage(lmtInformation, ldNone, ID_ + ' Connected');
    end;

procedure TfServerMain.IdTCPServer1Disconnect(AThread: TIdPeerThread);
    begin
        if assigned(AThread.Data) then
        begin
            (AThread.Data as TClientSpecificData).Free;
            AThread.Data := nil;
        end;
        Label2.Caption := IntToStr(IdTCPServer1.Threads.LockList.Count);
        LogMessage(lmtInformation, ldNone, AThread.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AThread.Connection.Socket.Binding.PeerPort) + ' Disconnected');
    end;

But then, the server got stuck after a client got disconnected.

Any idea why this happen ?

Thanks in advance.
0
dudup
Asked:
dudup
  • 6
  • 4
1 Solution
 
TheRealLokiSenior DeveloperCommented:
locklist is not just a list, it's a command, you need to unlock it after
you should also use a message to update the count, it is not wise to use events
here's the ocde you need, i probably should have thought of it and put it in the main demo i wrote for you
I put a TListbox (lbConnections) and a TLabel (lConnectionCount) on the server form

  WM_DisplayConnectionCount = WM_user + 101;

    Procedure DisplayConnectionCount(var Msg:TMessage);Message WM_DisplayConnectionCount;

Procedure TfServerMain.DisplayConnectionCount(var Msg:TMessage);
    var
        i: integer;
    begin
        with IdTCPServer1.Contexts.LockList do
         try
            lbConnections.Items.BeginUpdate;
            lbConnections.Items.Clear;
            lConnectionCount.Caption := IntToStr(Count) + ' connections';
            for i := 0 to Count - 1 do
            begin
                if assigned(TIdContext(Items[i]).Data) then
                  lbConnections.Items.Add( TClientSpecificData(TIdContext(Items[i]).Data).ID)
                else
                  lbConnections.Items.Add( 'new' );
            end;
         finally
            lbConnections.Items.EndUpdate;
            IdTCPServer1.Contexts.UnLockList;
         end;
    end;

procedure TfServerMain.IdTCPServer1Connect(AContext: TIdContext);
    var
        ID_: string;
    begin
        ID_ := AContext.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AContext.Connection.Socket.Binding.PeerPort);
        AContext.Data := TClientSpecificData.CreateWithSettings(ID_);
        LogMessage(lmtInformation, ldNone, ID_ + ' Connected');
        PostMessage(fServerMain.Handle, WM_DisplayConnectionCount, 0, 0);
    end;

procedure TfServerMain.IdTCPServer1Disconnect(AContext: TIdContext);
    begin
        if assigned(AContext.Data) then
        begin
            (AContext.Data as TClientSpecificData).Free;
            AContext.Data := nil;
        end;
        LogMessage(lmtInformation, ldNone, AContext.Connection.Socket.Binding.PeerIP + ':' + IntToStr(AContext.Connection.Socket.Binding.PeerPort) + ' Disconnected');
        PostMessage(fServerMain.Handle, WM_DisplayConnectionCount, 0, 0);
    end;
0
 
dudupAuthor Commented:
So, inside the execute thread we may not access the GUI in the main form. If we want to do this, we have to post message and capture it from the main thread.

Because later on, I would like to display progress bar for every process that are submitted by the clients :

CLIENT_1: 10%
CLIENT_2: 15%
CLIENT_3: Done
CLIENT_4: 95%

To do this, inside the execute thread, I will check the progress and then post message to the main form. Catch the message, and update the progress bar list.

Is this a good plan ?

Multithreading is also new to me :)
0
 
TheRealLokiSenior DeveloperCommented:
Ok, I'll explain my logic, and then show you some code to do this

we're going to need another message
e.g.  WM_ClientFileProgress = WM_user + 102;

To know the progress, in the TCPServer's execute method you need to use the AContext.Connection.OnWorkBegin OnWork and OnWorkEnd events
You will need to keep a count of the progress, and post a message to the main form when it changes
Your main form will likely need to know
a) the progress percent
b) which user/thread, so you can update the appropriate progress bar

Unfortunately, those events run as TidTCPConnection, not as TIdContext, which does not have a "parent context" property or similar to see upwards (to get at our "client data" (TClientSpecificData) object that we put in AContext.Data), so it's not easy to get our unique "ID"

1 Solution: also store our client data in Connection.Tag
ie. AContext.Connection.Tag := integer(AContext.Data);
this is an integer, but it's big enough to hold our pointer

We also want to store a "ShowProgress" flag, so we only update the progress bar when we are sending a file
I'm going to put these events, progress count, the showprogress flag, and the code to do the PostMessage in the TClientSpecificData object itself

The main form's WM_ClientFileProgress handler will need to decode the message, and retrieve the "ID" or thread.
for demonstration reasons, I have made the listbox items the same as the "ID" to make it easy to find.
If you wish, you could actually pass integer(AContext) ot integer(AContext.Data) as the param instead of the "ID" string.
If you do this, rememeber to use the "locklist" to get the data out that you need, otherwise it will not be thread safe.
My example uses the ID string, so we do not need to worry about that.

I'm actually going to show you how to put a progress bar in each line of the TListbox, so we don't need to messs around with dynamically creating progress bars. You might like this approach anyway.
We tell the listbox we want to do the drawing ourselves
set lbConnections.Style to lbOwnerDrawFixed
and add a DrawItem event (click on lbConnections, then the events tab in the object inspector)
In order for the listbox to know what progress to paint, we will use a trick and use the Objects property of the listbox item to store the progress. WE could have used this objects property to store the actual TIdContext or TClientSpecificData also, but we'd have to emssa round with the locklist again.
Finally, because the progress bar will be getting updated quite a lot during file copies, we want to get rid of the nasty flicker
by doing
lbConnections.DoubleBuffered := True;

===================
new code to add to my demo
===================

const
  WM_ClientFileProgress = WM_user + 102;

type
    TClientSpecificData = class(TObject)
        private
            function GetCurrentProgressPercent: integer;
        public
            ClientStage: TClientStage;
            ID: string; // just the unique id we create for each connection
            Username: string;

// used for file progress
            ProgressMax, CurrentProgress: Int64;
            ShowProgress: boolean;
            property CurrentProgressPercent: integer read GetCurrentProgressPercent;

            procedure TCPClientInsideThreadWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
            procedure TCPClientInsideThreadWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
            procedure TCPClientInsideThreadWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
            procedure LogProgress;

            Constructor CreateWithSettings(ID_: string);
            Destructor Destroy; override;
        end;

this bit goes in the form's public block
    Procedure ClientFileProgress(var Msg:TMessage);Message WM_ClientFileProgress;

Add a FormCreate event
procedure TfServerMain.FormCreate(Sender: TObject);
    begin
        lbConnections.DoubleBuffered := True;
        lbConnections.Style := lbOwnerDrawFixed; //otherwise the DrawItem event will not run
    end;

procedure TfServerMain.ClientFileProgress(var Msg: TMessage);
    var
        PS:PString;
        S: string;
        i, progresspercent: integer;
        LogMessageType: TLogMessageType;
        LogDirection: TLogDirection;
    begin
        PS:=Pointer(Msg.WParam);
        S := PS^; // the unique "ID" so that we can find it in the listbox. you could pass anything here, even the TIdPeerthread
        Dispose(PS);

        progresspercent := Msg.LParam;
        i := lbConnections.Items.IndexOf(S);
        if i <> -1 then
        begin
            lbConnections.Items.Objects[i] := Pointer(progresspercent);
            lbConnections.Repaint;
        end;
    end;

Below are the file progress methods

Constructor TClientSpecificData.CreateWithSettings(ID_: string);
begin
....
    ShowProgress := False;
......


procedure TClientSpecificData.TCPClientInsideThreadWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
    var
        ClientSpecificData: TClientSpecificData;
    begin
        if ShowProgress then
        begin
            ClientSpecificData := TClientSpecificData((ASender as TIdTCPConnection).Tag);
            ClientSpecificData.ProgressMax := AWorkCountMax;
            ClientSpecificData.CurrentProgress := 0;
            ClientSpecificData.LogProgress;
        end;
    end;

procedure TClientSpecificData.TCPClientInsideThreadWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
    var
        ClientSpecificData: TClientSpecificData;
    begin
        if ShowProgress then
        begin
            ClientSpecificData := TClientSpecificData((ASender as TIdTCPConnection).Tag);
            ClientSpecificData.CurrentProgress := CurrentProgress + AWorkCount;
            ClientSpecificData.LogProgress;
        end;
    end;

procedure TClientSpecificData.TCPClientInsideThreadWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    var
        ClientSpecificData: TClientSpecificData;
    begin
        if ShowProgress then
        begin
            ClientSpecificData := TClientSpecificData((ASender as TIdTCPConnection).Tag);
            ClientSpecificData.CurrentProgress := 0;
            ClientSpecificData.LogProgress;
        end;
    end;

procedure TClientSpecificData.LogProgress;
    var
        i: Integer;
        PS: PString;
    begin
        New(PS);
        PS^ := ID;
        PostMessage(fServerMain.Handle, WM_ClientFileProgress, Integer(PS), CurrentProgressPercent);
    end;

function TClientSpecificData.GetCurrentProgressPercent: integer;
    begin
        if ProgressMax = 0 then
          result := 0
        else
          result := Trunc(CurrentProgress / ProgressMax);
    end;


now these are the changes you need to make for the server's execute event

procedure TfServerMain.IdTCPServer1Execute(AContext: TIdContext);
    var
        i: integer;
        S, S2: string;
        InCmd: string;
        AStream: TIdStreamVCL;
// for file receiving
        Filename: string;
        FileSize: Int64;

    begin
    acontext.Connection.Tag := integer(AContext.Data); //store our data object here also, so that the file progress knows a bit more about us
    acontext.Connection.OnWorkBegin := (AContext.Data as TClientSpecificData).TCPClientInsideThreadWorkBegin;
    acontext.Connection.OnWork := (AContext.Data as TClientSpecificData).TCPClientInsideThreadWork;
    acontext.Connection.OnWorkEnd := (AContext.Data as TClientSpecificData).TCPClientInsideThreadWorkEnd;
....

(*new*)                            (AContext.Data as TClientSpecificData).ShowProgress := True;
                            AStream := TIDStreamVCL.Create(
                            TFileStream.Create(ExtractFilePath(Paramstr(0)) + 'In\' + Filename, fmCreate), True);
                            try
                                ThreadlogMessage(lmtInformation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Receiving file "' + Filename + '" ' + IntToStr(Filesize) + ' bytes');
                                AContext.Connection.IOHandler.ReadStream(AStream, Filesize, False);
                                ThreadLogMessage(lmtInformation, ldNone, (AContext.Data as TClientSpecificData).ID + ' - Received file "' + Filename + '"');
                            finally
                                FreeAndNil(AStream);
                            end;
(*new*)                            (AContext.Data as TClientSpecificData).ShowProgress := False;



and finally, here is the listbox draw routine.
procedure TfServerMain.lbConnectionsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
    var
        progressbarrect: TRect;
        progressrect: TRect;

        lastcolor: tcolor;
        s: string;
        currentx: integer;
        progresspercent: integer;
    begin
        with (Control as TListbox).Canvas do
        begin
(* This ensures the correct highlight color is used *)
            FillRect(Rect);
// outline of progress bar
            progressbarrect.Top := Rect.Top;
            progressbarrect.Left := Rect.Left;
            progressbarrect.Bottom := Rect.Bottom;
            progressbarrect.Right := (progressbarrect.Left + 57);

            lastcolor  := Brush.Color;
            InflateRect(progressbarrect,-2,-2);
            if odSelected in State then
              Brush.Color := clWhite
            else
              Brush.Color := clBlack;
            (Control as TListbox).Canvas.FrameRect(progressbarrect);

// actual progress
            progresspercent := Integer((Control as TListbox).Items.Objects[Index]);
            if progresspercent > 0 then
            begin
                progressrect.Top := progressbarrect.Top + 1;
                progressrect.Left := progressbarrect.Left + 1;
                progressrect.Bottom := progressbarrect.Bottom - 1;
                progressrect.Right := progressrect.Left + 1 + (progresspercent div 2); // to get 1-100 to 1-50 pixels
                Brush.Color := clLime;
                (Control as TListbox).Canvas.FillRect(progressrect);
            end;
            Brush.Color := lastcolor;
            currentx := Rect.Left + (progressbarrect.Right - progressbarrect.Left) + 4 + 2;
            TextOut(currentx, Rect.Top, lbConnections.items[Index]);
        end;
    end;

I hope all of this makes sense.
I'm not saying it's the best way of doing what you want, but it shows you the aspects that need to be done
0
2018 Annual Membership Survey

Here at Experts Exchange, we strive to give members the best experience. Help us improve the site by taking this survey today! (Bonus: Be entered to win a great tech prize for participating!)

 
TheRealLokiSenior DeveloperCommented:
btw, if you are using Indy 9 change the "DisplayConnectionCount" procedure to

procedure TfServerMain.DisplayConnectionCount(var Msg: TMessage);
    var
        i: integer;
        FoundDisconnection: boolean;
    begin
        FoundDisconnection := True;
        with IdTCPServer1.Threads.LockList do
         try
            lbConnections.Items.BeginUpdate;
            lbConnections.Items.Clear;
            lConnectionCount.Caption := IntToStr(Count) + ' connections';
            for i := 0 to Count - 1 do
            begin
                if assigned( TIdPeerThread(Items[i]).Data) then
                  lbConnections.Items.Add( TClientSpecificData(TIdPeerThread(Items[i]).Data).ID)
                else
                begin
                    lbConnections.Items.Add( 'Disconnecting...' );
                    FoundDisconnection := True;
                end;
            end;
         finally
            lbConnections.Items.EndUpdate;
            IdTCPServer1.Threads.UnLockList;
         end;
         if FoundDisconnection then
           PostMessage(fServerMain.Handle, WM_DisplayConnectionCount, 0, 0);
    end;
0
 
TheRealLokiSenior DeveloperCommented:
oops, top line should read
        FoundDisconnection := False;
0
 
dudupAuthor Commented:
Loki, could you please posted the source and form of the server part ?

If not, please the complete server Execute procedure. I cant get it to work.

Thanks
0
 
dudupAuthor Commented:
Here is my server execute that is taken from your demo :

procedure TfServerMain.IdTCPServer1Execute(AThread: TIdPeerThread);
    var
        i: integer;
        S, S2: string;
        InCmd: string;
    begin
// send the ID command and the user's unique "ID"
        try
    // Main Command Loop
            while AThread.Connection.Connected do
            begin
// check if user is logged in
                InCmd := ReceiveStringWithLogging(AThread);
                case (AThread.Data as TClientSpecificData).ClientStage of
                    csNone:
                    begin //LOGIN username password
                        if (pos('LOGIN', uppercase(InCmd)) = 1) then CMD_LOGIN(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else SendStringWithLogging(AThread, 'ERROR Not logged in. Can not use "' + InCmd +'" command');
                    end;
                    csLoggedIn:
                    begin
                        if InCmd = 'PING' then  SendStringWithLogging(AThread, 'PONG') //Note: we do not show logging for this, becaue we want it as fast as possible
                        else if InCmd = 'JUMP' then SendStringWithLogging(AThread, 'Whee!')
                        else if (pos('TIMER ', InCmd) = 1) then CMD_TIMER(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if (pos('COUNTDOWN ', InCmd) = 1) then CMD_COUNTDOWN(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if InCmd = 'FILE' then CMD_FILE(AThread)
                        else if (pos('PROCESS ', InCmd) = 1) then CMD_PROCESS(AThread, copy(InCmd, pos(' ', InCmd) + 1, maxint))
                        else if InCmd = 'QUIT' then AThread.Connection.Disconnect
                        else SendStringWithLogging(AThread, 'ERROR Unknown command "' + InCmd +'"');
                    end; // of ClientStage = csLoggedIn
                end; // of case notlogged in, or logged in
            end; // of while doing commands loop
        except
            on e: EIdSocketError do
            begin
                if pos('10053', E.Message) > 0 then
                  ThreadLogMessage(lmtInformation, ldNone, 'Client disconnected')
                else
                  ThreadLogMessage(lmtError, ldNone, E.Message);
            end;
            on e: exception do
            begin
                if pos('CONNECTION CLOSED GRACEFULLY', uppercase(e.Message)) > 0 then
                  ThreadLogMessage(lmtInformation, ldNone, 'Client disconnected gracefully')
                else
                  ThreadLogMessage(lmtError, ldNone, E.Message);
            end;
        end;
    end;
0
 
TheRealLokiSenior DeveloperCommented:
you are missing the "file progress" parts

    begin
        AThread.Connection.Tag := integer(AThread.Data); //store our data object here also, so that the file progress knows a bit more about us
        AThread.Connection.OnWorkBegin := (AThread.Data as TClientSpecificData).TCPClientInsideThreadWorkBegin;
        AThread.Connection.OnWork := (AThread.Data as TClientSpecificData).TCPClientInsideThreadWork;
        AThread.Connection.OnWorkEnd := (AThread.Data as TClientSpecificData).TCPClientInsideThreadWorkEnd;

apart from that, it's identical to my execute method
0
 
TheRealLokiSenior DeveloperCommented:
I've put the server and the client code on sourceforge for you
https://sourceforge.net/projects/internetdemos/
0
 
dudupAuthor Commented:
Thanks Loki!
0

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 6
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now