Solved

How can i make a multithreaded app with TTcpServer on delphi?

Posted on 2007-11-23
9
2,823 Views
Last Modified: 2013-11-23
Hello guys,

I have made an application on delphi using TTCPServer and TTCPClient without using vlc (just plain code).
I want to make it multithreaded but i dont have much idea how to do it. Can anyone show me an example of how to do  it?

NOTE: Do not tell me about Indy or any of those components, i know they are exellent and they already comes with multithreading but they are much big in size that ttcpserver component and i need the exe file to be SMALL.

Thanks in advance,

Elias
0
Comment
Question by:epagos
  • 5
  • 4
9 Comments
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
1st: no matter that you use the IDE or plain code, if you use VCL components, then you are using VCL :)

2nd: I don't remember seeing such an example, but the idea behind it is really simple.
- when a client connects (in the onaccept), you create a new thread. that thread will have a member that holds the connection (so it can keep reading from it). you should put that thread in a list (TObjectLsit for example) os that you can manage the connections.
- when a client disconnects, search for that thread in the list (you know the disconnecting client and each threads connection) and remove it from list and destroy it
the server can expose an event, like onexecute, similar to indy and the threads will call that event when they have some data to be read.

let me know if that does not make sense for you
0
 

Author Comment

by:epagos
Comment Utility
hey ciuly,

Yes it makes sense, its basically what im trying to do. For what i can read on sockets.pas (TTcpServer and TTcpClient unit) it automatically destroy the thread after the client disconnect so i should not worry about that.

I have atached the code of the app. Right now it works like a proxy server, its the easiest way for testing the multithreading (i still didnt add the real functions for it).

I have 2 problems, the first one is the multithreading issue, and the second one is that sometimes it wont take new incoming connections, wich i think is because of the first issue.

Any help is welcome :)

Thanks,
Elias


program eclipse;
 

{$APPTYPE CONSOLE}
 

uses

  sysutils,

   sockets in 'sockets.pas';
 
 
 

type

      Server = class(TTcpServer)

   private
 

   public

       Procedure Start;

       procedure FOnAccept(Sender: TObject; ClientSocket: TCustomIpClient);

       Procedure FGetThread(Sender: TObject; var ClientSocketThread: TClientSocketThread);

  end;
 

  type

      Client = class(TTcpClient)

  end;
 
 

  type             

  SocketClient = class(TClientSocketThread)

  private              

    { Private declarations }

  public

    procedure Execute(ClientSocket: TCustomIpClient);

  end;
 
 
 

  var  Server1: Server;

  Client1: array[0..100] of Client;  // the program will just use 1 client, initially i made an array of 100 clients to test.

  clients: integer;

  //ServerThread: SocketClient;
 
 

procedure SocketClient.Execute (ClientSocket: TCustomIpClient);

begin

   writeln('Thread Executed'); // This event is never executed, i dont know why.

end;
 

Procedure Server.FGetThread(Sender: TObject; var ClientSocketThread: TClientSocketThread);

begin

  writeln('Creating Thread');

  ClientSocketThread := SocketClient.Create(Server1.ServerSocketThread);

end;
 

Procedure Server.Start();

Begin
 
 

    server1 := Server.Create(nil);

    Server1.Active := False;

    Server1.LocalPort := '1759';

    Server1.Localhost := Server1.LocalHostName;

    Server1.BlockMode := bmThreadBlocking;

    Server1.OnAccept := Server1.FonAccept;

    Server1.OnGetThread := Server1.FGetThread;
 

    Server1.Active := True;
 

    repeat

      sleep(500);

    until 1=2; // I make sure that the server wont stop
 

End;
 

procedure Server.FOnAccept(Sender: TObject; ClientSocket: TCustomIpClient);

var

  s,x,y: string;

  Rbuf: array[0..32768] of char;

  RCount, counter, a: integer;
 

begin

 

    s:=ClientSocket.Receiveln();

    Repeat
 

         if(pos('Host:',s) > 0) then

          begin

            y := StringReplace(s, 'Host:','', [rfReplaceAll, rfIgnoreCase	]);

            y := StringReplace(y, ' ','', [rfReplaceAll, rfIgnoreCase	]);

          end;

         if(pos('Proxy-Connection:',s) > 0) then

         begin

           s := StringReplace(s, 'Proxy-Connection:','Connection:', [rfReplaceAll]);

         end;
 

         x:= x + s;
 

         if(s<>'') then begin x:= x + #13 + #10; end;

         s:=ClientSocket.Receiveln();

    Until s='';
 

    for a := 1 to clients do

    begin

      if Client1[a].Connected = False then counter := a;

    end;
 

    Client1[counter].RemoteHost := y;
 
 

     while Client1[counter].Connected = True do begin

         Client1[counter].WaitForData(100);

     end;
 

     try

       Client1[counter].Active := True;

       if Client1[counter].Connect then

       begin

         Client1[counter].Sendln(x);

         Client1[counter].Sendln('');

      end;

     finally

     end;

      RCount := Client1[counter].ReceiveBuf(Rbuf, 1024);

      ClientSocket.SendBuf(Rbuf,RCount);

      sleep(100);

      while Client1[counter].WaitforData(1000) AND Client1[counter].connected do

      begin

           RCount := Client1[counter].ReceiveBuf(Rbuf, 4092);

           if ClientSocket.Connected = True then

              ClientSocket.SendBuf(Rbuf,RCount)

           else  begin client1[counter].Disconnect;  break; end;
 

           sleep(100);

      end;
 

     Client1[counter].Disconnect;

     writeln('Client Disconecting');

  end;
 

// CLIENT START
 

var cc : integer;

begin

clients := 100;

for cc := 0 to clients do

  begin

  Client1[cc] := Client.Create(nil);

  Client1[cc].BlockMode := bmBlocking;

  Client1[cc].RemotePort := '80';

  end;

Server1.start();

end.

Open in new window

0
 
LVL 28

Accepted Solution

by:
ciuly earned 500 total points
Comment Utility
as a suggestions, never name you methods with a starting F. that is the naming convention for private members.

also, no need to write "type" in front of every type declaration. it acts like var: you can gave multiple type declarations one after anotehr provided that all types declarations are under the same "type" keyword. if some otehr comes in(const, var, or some function) then of course you'll need to start a new series of "type"

don't ever use the variable in the type definition (declaration). you wil most certainly cause bugs, and in case of multithreaded or multiinstance objects, you will 99.99% of cases have problems. The cases in which it is required to use the gloabl variable are very rare so for starters, let's not discuss it. Make it a rule to never use it.

use correct code identation. it makes code nice and readable.

also, it is a convension that types start with capital T.

?? // This event is never executed, i dont know why.

because it is not an event. it's a method. and there is no code to execute it anywhere in your code. there is in TClientSocketThread, but for that you need to "override" it and remove the parameter.
AAAAAAND you need to connect the client to the server in order for something to happen, no?
also, .. you are creating client objects but you are not doing anything with it. besides connecting, you need to send some data.

when you have multithreading, you must protect the resources that can be accessed by more threads. it's calle dsynchronization and it is a must. you should start reading on it if you don't know about it because without it, you will not be abel to write correct multi-threaded applications.

another golden rule: keep you server and client code separated (2 or more units)
and another one: keep your type declaration in another unit then your application. help making code re-usable.

I don't know about your proxy stuff, but your server listens on one port and your clients connect to port 80. in my understanding, that is wrong.

next big problem is that you aredoing the processing in the onaccept event which is wrong. you do only acceptance related stuff tehre. all processing goes into the TSocketClient.Execute method of the thread. that's why it's there, no?
actually, it's there to check if there is data and in case thre is, fire an event which you would delcare in the server object and that event should be assigned by your code in which you do the processing.

I attached your modified code which actually does somethign. I didn't spend any extra time to figure out what you want to do, but as another rule of thumb when it comes to client-server applications:
you MUST have a correcta and complete communication protocol which should be implemented in code. just like http, ftp, etc. but probably not that complex.

the code is not yet usable, but it's something for you to continue on. I got bored :D
so try to adapt it to your needs, and hit me with problems you encounter.
program program1;

 

{$APPTYPE CONSOLE}

 

uses

  madExcept,

  madLinkDisAsm,

  madListHardware,

  madListProcesses,

  madListModules,

  sysutils,

  sockets;
 

type

  TServer = class(TTcpServer)

  private

    procedure Accept(Sender: TObject; ClientSocket: TCustomIpClient);

    Procedure GetThread(Sender: TObject; var ClientSocketThread: TClientSocketThread);

  public

    constructor Create;

    Procedure Start;

  end;

 

  TClient = class(TTcpClient)

  end;

 

  TSocketClient = class(TClientSocketThread)

  public

    procedure Execute; override;

  end;
 

const

  port = '1579';

 

var

  Client1: array[0..100] of TClient;  // the program will just use 1 client, initially i made an array of 100 clients to test.

  clients: integer;

  //ServerThread: SocketClient;

 

 

procedure TSocketClient.Execute;

begin

  writeln('Thread Executed'); 

end;

 

Procedure TServer.GetThread(Sender: TObject; var ClientSocketThread: TClientSocketThread);

begin

  writeln('Creating Thread');

  ClientSocketThread := TSocketClient.Create(ServerSocketThread);

end;

 

Procedure TServer.Start;

Begin

  Active := True;
 

{  repeat

    sleep(500);

  until 1=2; // I make sure that the server wont stop

  }

  // NOT a good idea.

  // 1. you must have somehow a control on how to stop the server

  // 2. the server will not stop if you get out of this method.

  // 3. it's the applicaiton that you don't want to stop and not the server object ;)

End;

 

procedure TServer.Accept(Sender: TObject; ClientSocket: TCustomIpClient);

var

  s,x,y: string;

  Rbuf: array[0..32768] of char;

  RCount, counter, a: integer;

begin

  s:=ClientSocket.Receiveln();

  Repeat

    if(pos('Host:',s) > 0) then

    begin

      y := StringReplace(s, 'Host:','', [rfReplaceAll, rfIgnoreCase       ]);

      y := StringReplace(y, ' ','', [rfReplaceAll, rfIgnoreCase   ]);

    end;

    if(pos('Proxy-Connection:',s) > 0) then

      s := StringReplace(s, 'Proxy-Connection:','Connection:', [rfReplaceAll]);
 

    x:= x + s;
 

    if(s<>'') then

      x:= x + #13 + #10;

    s:=ClientSocket.Receiveln();

  Until s='';

 

  for a := 1 to clients do

    if Client1[a].Connected = False then

      counter := a;// what happens if more clients are disconnected?
 

  Client1[counter].RemoteHost := y;

  // [Warning] Project1.dpr(88): Variable 'counter' might not have been initialized

  // bad bad bad. read and fix the compiler hints/warning

 

  while Client1[counter].Connected = True do

    Client1[counter].WaitForData(100);
 

  try

    Client1[counter].Active := True;

    if Client1[counter].Connect then

    begin

      Client1[counter].Sendln(x);

      Client1[counter].Sendln('');

    end;

  finally

  end;

  RCount := Client1[counter].ReceiveBuf(Rbuf, 1024);

  ClientSocket.SendBuf(Rbuf,RCount);

  sleep(100);

  while Client1[counter].WaitforData(1000) AND Client1[counter].connected do

  begin

    RCount := Client1[counter].ReceiveBuf(Rbuf, 4092);

    if ClientSocket.Connected = True then

      ClientSocket.SendBuf(Rbuf,RCount)

    else

    begin

      client1[counter].Disconnect;

      break;

    end;

 

    sleep(100);

  end;
 

  Client1[counter].Disconnect;

  writeln('Client Disconecting');

end;

 

constructor TServer.Create;

begin

  inherited create(false);

  Active := False;

  LocalPort := port;

  Localhost := '0.0.0.0';// it's a server. it shoudl listen on all interfaces

  BlockMode := bmThreadBlocking;

  OnAccept := Accept;

  OnGetThread := GetThread;

end;
 

// CLIENT START

 

var

  cc : integer;

  Server1: TServer;

begin

  server1 := TServer.Create;

  try

    Server1.start;

    clients := 100;

    for cc := 0 to clients do

    begin

      Client1[cc] := TClient.Create(nil);

      Client1[cc].BlockMode := bmBlocking;

      Client1[cc].RemotePort := port;
 

      Client1[cc].RemoteHost:='localhost';

      if not Client1[cc].Connect then

        writeln('failure to connect')

      else

        Client1[cc].Sendln('blabla');

    end;

    repeat

      sleep(500);

    until 1=2; // make sure the app won't stop.

  finally

    freeandnil(server1);

  end;

end.

Open in new window

0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
sprry about the madexcept stuff. you can remove the first mad* units :)
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:epagos
Comment Utility
Thanks a LOT for all those info. As u can see im a real noob on delphi :)

I will check your code and let u know if i have any other question. About all those clients they are not for connecting to the server, initially i wanted to do a very simple proxy server, so when the server received a connections it will order the clients to get the requested url.  (thats the correct method?)

Elias
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
not exactly. a proxy is somethign that intermediates.

so if the client says:
GET something
the proxy will get that something and then send it back to the client.

soi, either you don't want a "proxy" but something else, or you miss-explained the behaviour.
0
 

Author Comment

by:epagos
Comment Utility
thats what the app is doing, when the server1.accept is executed it will get the header of the request and then it will GET that website through the client components and then it will return it through clientsocket on Server1.Accept
0
 

Author Comment

by:epagos
Comment Utility
oh i forgot...

Im trying to connect to this app from other diferent pcs on diferent networks... sometimes it works and it receives the remote connection and sometimes it just do not receive it. Do u see any problem on the code wich can be causing that?

Just from my pc i connect from my own machine i can connect about 80-90% of the times.
0
 
LVL 28

Expert Comment

by:ciuly
Comment Utility
I see. well, I'm not sure how to test the behaviour you are saying. what are you using? a browser is ok?

as I said, you will have problems with not synchronizing the resources accessed by many threads. for one axample: the clients array. plus that warning I mentioned. etc.

so, try to put all my suggestions into practice in your code and I'll continue on it tomorrow. (I'm off to bed now)
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Viewers will learn how to properly install and use Secure Shell (SSH) to work on projects or homework remotely. Download Secure Shell: Follow basic installation instructions: Open Secure Shell and use "Quick Connect" to enter credentials includi…
After creating this article (http://www.experts-exchange.com/articles/23699/Setup-Mikrotik-routers-with-OSPF.html), I decided to make a video (no audio) to show you how to configure the routers and run some trace routes and pings between the 7 sites…

763 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

13 Experts available now in Live!

Get 1:1 Help Now