Solved

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

Posted on 2007-11-23
9
2,873 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
LVL 28

Expert Comment

by:2266180
ID: 20343466
sprry about the madexcept stuff. you can remove the first mad* units :)
0
 

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

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

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…
SSL is a very common protocol used these days when browsing the web.  The purpose is to provide security to communication, but how does it do it?  There are several pieces at work that have to be setup before SSL will even work and it requires both …
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…

776 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