Solved

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

Posted on 2007-11-23
9
2,858 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:2266180
ID: 20343125
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
ID: 20343299
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:
2266180 earned 500 total points
ID: 20343462
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:2266180
ID: 20343466
sprry about the madexcept stuff. you can remove the first mad* units :)
0
Control application downtime with dependency maps

Visualize the interdependencies between application components better with Applications Manager's automated application discovery and dependency mapping feature. Resolve performance issues faster by quickly isolating problematic components.

 

Author Comment

by:epagos
ID: 20343524
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:2266180
ID: 20343573
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
ID: 20343754
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
ID: 20343758
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:2266180
ID: 20343948
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

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Correct Component for Shopping Cart. 2 95
select query - oracle 16 92
Base1 Encode/Decode 3 67
No RSTP between switches 3 46
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…
Please see preceding article here: http://www.experts-exchange.com/Networking/Operating_Systems/A_11209-Root-Bridge-Election.html Figure 1 After Root Bridge has been elected, then what?..... Let's start by defining a Root Port in la…
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…

911 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

20 Experts available now in Live!

Get 1:1 Help Now