Link to home
Start Free TrialLog in
Avatar of Scay7
Scay7Flag for South Africa

asked on

Communication between 2 programs over network

Hi Fellow Experts,

For about a week now im having trouble communicating between my programs using a component called Tsock http://www.ward.nu/computer/tsock

For some reason i cant get my programs to talk to each other ?

Below are its routines for sending and recieving, simple?

procedure TForm1.FormCreate(Sender: TObject);
begin
   Sock1.open;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
   Sock1.SendDatagram(Memo1.Text, '127.0.0.1');
end;

procedure TForm1.Sock1Read(Sender: TObject; Count: Integer);
Var Addr : String;
begin
   Memo2.Text := Sock1.ReceiveDatagram(Addr);
end;

mabey there is another way, or someone can check this component out, or suggest another method...

All im trying to do is send a string type value(server) to a statictext(client)
and a visa versa

eg:

1. Server send time(string) to pc1, pc read (string) display on statictext
2. pc1 send cancel to Server(integer) server read and close timer

Thanks Scay7

ASKER CERTIFIED SOLUTION
Avatar of TheRealLoki
TheRealLoki
Flag of New Zealand image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
If you have Indy components on your delphi, you could use the TCP server and client.
Simply use write and read to send/receive messages.
Avatar of Scay7

ASKER

TheRealloki : your demo doesnt compline "cannot find Tclientsocket" im using D7 by the way sorry forgot to mention earlier

huferry okay i havent used Indy before, so could you give a basic example ? Ive got Indy that comes with D7

Peace Scay7
Avatar of Scay7

ASKER

Ah wait never mind i had to install my dclsockets70.bpl which i didnt have
and i had to change all you TForm2 to Tform1 :P

Still want some ides from Huferry...

Peace Scay7
Avatar of Scay7

ASKER

Great that Demo works wonder, one thing

TheRealLoki : Can this thing work over a Hubbed network connected to internet EG:

               [ME/56k]
                    |
                    |
               Internet
                    |
                    |
     ____Modem 4 port____   [Them/ADSL]
      |         |        |        |
      |         |        |        |
      |         |        |        |
   server   PC1    PC2    PC3

If it cant work over the internet thats fine, but will it work on the hub from server through hub to say pc1 ?

Peace Scay7
PS nice demo, i already have a few ideas running through my head here...
Avatar of Scay7

ASKER

TheReadLoki ?
Huferry ?

Feedback is welcome...

Peace Scay7
yes, it will, sockets are tcp/ip which is what the itnernet uses. I wrote this assuming you wanted to use it on the internet.
you need to choose a "port" which you can set easily enough
e.g. port 2000
and enter an ip address or domain as the address
e.g.

procedure TForm2.bListenClick(Sender: TObject);
    begin
        ServerSocket1.Port := StrToIntDef(eServerPort.Text, 2000); // change this to the port you wish to use
e.g.  ServerSocket1.Port := 3000;
...

procedure TForm2.bConnectClick(Sender: TObject);
    begin
        ClientSocket1.Address := eAddress.Text; // or mydomain.com or 123.456.789.123
        ClientSocket1.Port := StrToIntDef(eClientPort.Text, 2000); // the port you wish to connect to. this port must match the server's port above
...

from your diagram, if you ran the server, it could talk to pc1, pc2, pc3, and "Me/56k" also

If their adsl modem (and/or the server pc) has a firewall, it will have to be told to allow port "2000" TCP data in. If their ADSL uses NAT or "virtual server" it will need to be told to direct all TCP 2000 data to the "server's" ip address.
This is just simple configuration
(if you are not using port 2000 then use that port instead in the instructions above)
Avatar of Scay7

ASKER

Hi Loki

Listen how do i list the serversocket1.Socket.Connections[0] into string/TString better string, that i can ID the IPs
drop a TListbox on the form, call it lbActiveConnections
We will use this to show the "active connections" to the server.
Change the ServerSocket1ClientConnect() and ServerSocket1ClientDIsconnect() events as below, and add the new
DisplayActiveConnections() procedure
I am explicitly ignoring the socket in the ondisconnect event becaue that socket is going to go away directly after that event, so we do not want to display it

Also note, if you are unfamiliar with socket port allocation
your client will connect to the server port 2000, but it may use port 32000 for its' local port
if you disconnect and reconnect, you will see it use 32001 for example. this is perfectly normal.


  private
    { Private declarations }
    procedure DisplayActiveConnections(ThisSocketIsClosing: TCustomWinSocket);



procedure TfSocketTestMain.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connection from ' + Socket.RemoteAddress);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
        DisplayActiveConnections(Nil);
    end;

procedure TfSocketTestMain.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('disconnection from ' + Socket.RemoteAddress);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
        DisplayActiveConnections(Socket);
    end;

procedure TfSocketTestMain.DisplayActiveConnections(ThisSocketIsClosing: TCustomWinSocket);
    var
        i: integer;
    begin
        lbActiveConnections.Items.BeginUpdate;
        try
            lbActiveConnections.Items.Clear;
            for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
            begin
// only add the socket to the list if it is not the closing one we received in the "OnClientDisconnect" event            
                if ( (ThisSocketIsClosing = nil) or (ThisSocketIsClosing <> ServerSocket1.Socket.Connections[i]) ) then
                  lbActiveConnections.Items.Add(
                    ServerSocket1.Socket.Connections[i].RemoteHost + ' (' +
                    ServerSocket1.Socket.Connections[i].RemoteAddress + '):' +
                    IntToStr(ServerSocket1.Socket.Connections[i].RemotePort));
            end;
        finally
            lbActiveConnections.Items.EndUpdate;
        end;
    end;
Avatar of Scay7

ASKER

TheRealLoki im going to increase the points, they are yours just need a bit more info...
You done great work so far, really !

procedure Tform1.DisplayActiveConnections(ThisSocketIsClosing: TCustomWinSocket);
var i: integer;
begin
listbox2.Items.BeginUpdate;
  try
  listbox2.Items.Clear;
    for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
    begin
      if ( (ThisSocketIsClosing = nil) or (ThisSocketIsClosing <> ServerSocket1.Socket.Connections[i]) ) then
      listbox2.Items.Add(ServerSocket1.Socket.Connections[i].RemoteAddress);

    //this is what i needed, i think it works but is there an easier way
   //when the person connects to server the .Connections gives it an ID 0,1,2,3 etc
   //what im trying to get is the ID's for each PC so that i can send personal msgs to each PC
   //this is all automated

                               //the address as it connects              //Set IP's id'ing them          //the Con. ID
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit11.Text then data[1].st := i;
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit12.Text then data[2].st := i;
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit13.Text then data[3].st := i;
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit14.Text then data[4].st := i;
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit15.Text then data[5].st := i;
    if ServerSocket1.Socket.Connections[i].RemoteAddress = edit16.Text then data[6].st := i;

    label121.Caption := inttostr(data[1].st);
    label122.Caption := inttostr(data[2].st);
    label123.Caption := inttostr(data[3].st);
    label124.Caption := inttostr(data[4].st);
    label125.Caption := inttostr(data[5].st);
    label126.Caption := inttostr(data[6].st);

    end;
  finally
  listbox2.Items.EndUpdate;
  end;
end;
If you do the above, you will be limiting the system to only allow 1 connection from each IP address.
If  this is ok, then I'll write something showing a good way to do that
If, however, you would like to allow more than 1 connction from the same IP address, thenyou are better off using a "Login" process. I can write a couple of  example of how to do this also
Let me know which approach you want to take

You are also making it less dynamic by using fixed labels, but that's no big deal if you know you only have 4 computers to deal with, but if your system grows to have 20 computers, you might want to think about something more dynamic. Let me know and I'll put together something along those lines if it's more suitable for you.
I wont start any of this until you answer the above, just to save time :-)
Avatar of Scay7

ASKER

1. And only one connection from each pc... nothing serious very basic
2. Its a fixed amount of 10 and no more they currently have 6 but only getting 4 more in the future... much later

Its a timer system the PC1 logs into server, server get the IP and ID
Server side sets 5min computer time, server sends command to PC1 saying UNLOCK
the server then starts streaming TIME to PC1, when the servers timer = 0 send the LOCK
PC1 locks...

Its that basic just that i need to get ID for each pc to send each PC its stream of time 6 for now 4 more much later...

Peace Scay7
Avatar of Scay7

ASKER

also how do i handle a exception with this i cant seem to get it right keeps crashing my PC/Delphi
if no server exists, just wait for it to come up...

 ClientSocket1.Address := 127.0.0.1;
 ClientSocket1.Port := StrToIntDef('2000', 2000);

 with ClientSocket1 do
  try
    open;
  except
    on E: Exception do
      begin
      showmessage('Try..except during open: ' + E.Message);
      form1.close;
      end;
  end;
Keep the source I posted above to use as a test client,
but make a new project with the following code as the "server" only

I've done more than you asked, but it should be a decent "proof of concept" for you to decide how to proceed

Run the server, and click "listen"
Run the old client and connect
Type "PC1" into the client's edit box, and click "send"
the server will send the "UNLOCK" command, then 5 seconds later (see DefaultSecondsToLock constant below)
the server will send the "LOCK" command

For your other question
To catch the client error (i.e. if you try to connect when the server is not running)
use the clientsocket's OnError event like this :-


procedure TfSocketTestMain.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
    showmessage('hi. ' + inttostr(errorcode)); //10061
    sysutils.abort;
end;

I haven't had much time to tidy this up, and there may be the odd bug, but hopefully there's enough for you to get a grip on things.
It's a bad idea to send to the socket from a socket's event
e.g. you should not send "hello" from the servers "OnClientConnect()" event, so I have included examples of posting a windows message and letting the main form send the "HELLO" after the event has ended
Any questions feel free to ask

*************************************

unit servermain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;

const
    WM_SendLockMessageToSocketUser = WM_USER + 1; // timers (threads in this example) and other events will post this message, so that the main vcl thread can send a "Lock" message to the remote user
    WM_SendUnlockMessageToSocketUser = WM_USER + 2; // timers (threads in this example) and other events will post this message, so that the main vcl thread can send an "Unlock" message to the remote user

    WM_SendGeneralTextMessageToSocketUser = WM_USER + 3; // timers (threads in this example) and other events will post this message, so that the main vcl thread can send an "Error" message to the remote user. Also makes use of "TextToSend" property below

    DefaultSecondsToLock = 5; // use 120 for 2 minutes

const
    ss_WaitingForLogin = 0; // can not do anything except let me know who you are
    ss_LoggedIn = 1; // logged in, can perform other commands/requests if desired

type
    TSimpleTimerThread = class(TThread)
    protected
        procedure execute;override;
    public
        HandleToTalkTo: THandle;
        Interval: integer; // miliseconds
        Socket: TServerClientWinSocket; // just a pointer to the sockt so that the postmessage will know which user to talk to
    end;


// Because we wish to keep more information about a a connection, e.g. name, timer etc
// we make our own socket class and add some properties/methods
type
    TLoggedOnUserSocket = class(TServerClientWinSocket)
    public
        Stage: integer; //ss_WaitingForLogin, ss_LoggedIn
        UsersListIndex: integer;
        Name: string; // same as UsersListIndex[UsersListIndex], but putting here saves looking it up each time
        SecondsUntilLock: integer;
        TextToSend: string; // used to store a detailed error message or text to send to the remote client
        destructor Destroy; override;
    private
        TimerThread: TSimpleTimerThread;
    end;

type TLogType = (lt_Information, lt_Warning, lt_Error); // show " " or "?" or "!"
type TDataDirection = (dd_Connect, dd_Disconnect, dd_DataIn, dd_Nowhere, dd_DataOut); // show " +" or " -" or "<-" or "  " or "->"


type
  TfSocketServerMain = class(TForm)
    gbServer: TGroupBox;
    ServerSocket1: TServerSocket;
    eServerPort: TEdit;
    Label1: TLabel;
    bListen: TButton;
    eServerSend: TEdit;
    bServerSendUserText: TButton;
    bOffline: TButton;
    lbActiveConnections: TListBox;
    Label5: TLabel;
    mLog: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    cbUserNames: TComboBox;
    procedure bListenClick(Sender: TObject);
    procedure bServerSendUserTextClick(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure bOfflineClick(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerSocket1GetSocket(Sender: TObject; Socket: Integer;
      var ClientSocket: TServerClientWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
  private
    { Private declarations }
    procedure Message_SendLockMessageToSocketUser(var Msg: TMessage); message WM_SendLockMessageToSocketUser;
    procedure Message_SendUnlockMessageToSocketUser(var Msg: TMessage); message WM_SendUnlockMessageToSocketUser;
    procedure Message_SendGeneralTextMessageToSocketUser(var Msg: TMessage); message WM_SendGeneralTextMessageToSocketUser;

    procedure DisplayActiveConnections(ThisSocketIsClosing: TCustomWinSocket);
    procedure CheckLoginDetails(Sender: TObject; Socket: TCustomWinSocket; LoginName: string);
    procedure ParseClientCommand(Sender: TObject; Socket: TCustomWinSocket; CommandLine: string);
  public
    { Public declarations }
    UsersList: TStringList;
    function IndexOfUserSocket(Username_: string): integer;
    procedure AddToLog(MessageText: string); overload;
    procedure AddToLog(Socket: TLoggedOnUserSocket; LogType: TLogType; DataDirection: TDataDirection; MessageText: string); overload;
  end;

var
  fSocketServerMain: TfSocketServerMain;

IMPLEMENTATION

{$R *.DFM}

function RightPad(S: string; len: Integer; PadWith: char): string;
    begin
        while Length(S) < len do
          S := S + PadWith;
        Result := S;
    end;

procedure TfSocketServerMain.FormCreate(Sender: TObject);
    begin
// Using a list of allowed users (pcs) because their IP Address may change, and this will keep it simple and dynamic
// either load the list from an external file (application path\users.txt) or hard code it here as below
        UsersList := TStringList.Create;
        UsersList.Add('PC1');
        UsersList.Add('PC2');
        UsersList.Add('PC3');
//        UsersList.LoadFromFile(ExtractFilePath(Paramstr(0) + 'Users.txt');
cbUserNames.ItemIndex := 0; // default to "send to all"
    end;

procedure TfSocketServerMain.FormDestroy(Sender: TObject);
    begin
        UsersList.Clear;
        UsersList.Free;
    end;

// ********************************     server code here
procedure TfSocketServerMain.bListenClick(Sender: TObject);
    begin
        ServerSocket1.Port := StrToIntDef(eServerPort.Text, 2000);
        ServerSocket1.Active := True;
    end;

procedure TfSocketServerMain.bOfflineClick(Sender: TObject);
    begin
        ServerSocket1.Active := False;
    end;

procedure TfSocketServerMain.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Connect, 'Connected');
        DisplayActiveConnections(Nil);
// send "welcome" message
        (Socket as TLoggedOnUserSocket).TextToSend := 'Hello. please send your name';
        PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
    end;

procedure TfSocketServerMain.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Disconnect, 'Disconnected');
        DisplayActiveConnections(Socket);
    end;

procedure TfSocketServerMain.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    var
        InString: string;
    begin
        InString := Socket.ReceiveText;
        AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_DataIn, InString);
case ( Socket as TLoggedOnUserSocket).Stage of // just splitting up code into more user-friendly blocks
        ss_WaitingForLogin: CheckLoginDetails(Sender, Socket, InString);
        ss_LoggedIn: ParseClientCommand(Sender, Socket, InString);
    end;
end;

procedure TfSocketServerMain.bServerSendUserTextClick(Sender: TObject);
    var
        i: integer;
    begin
        if cbUserNames.ItemIndex = 0 then
begin // send to all
          for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
        begin
            AddToLog((ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
            ServerSocket1.Socket.Connections[i].SendText(eServerSend.Text);
        end;
    end
    else
    begin
        i := self.IndexOfUserSocket(cbUserNames.Items[cbUserNames.ItemIndex]); // get the name from the combobox
        if i <> -1 then
        begin
            AddToLog((ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
            ServerSocket1.Socket.Connections[i].SendText(eServerSend.Text);
        end;
    end;
end;

procedure TfSocketServerMain.DisplayActiveConnections(ThisSocketIsClosing: TCustomWinSocket);
    var
        i: integer;
    begin
        lbActiveConnections.Items.BeginUpdate;
        cbUserNames.Items.BeginUpdate;
        try
            lbActiveConnections.Items.Clear;
            cbUserNames.Items.Clear;
            cbUserNames.Items.Add('(ALL)');
            for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
            begin
// only add the socket to the list if it is not the closing one we received in the "OnClientDisconnect" event
                if ( (ThisSocketIsClosing = nil) or (ThisSocketIsClosing <> ServerSocket1.Socket.Connections[i]) ) then
                begin
                    lbActiveConnections.Items.Add(
                    ServerSocket1.Socket.Connections[i].RemoteHost + ' (' +
                    ServerSocket1.Socket.Connections[i].RemoteAddress + '):' +
                    IntToStr(ServerSocket1.Socket.Connections[i].RemotePort));
// only add the name to the list if they have logged in
                    if (ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket).Stage >= ss_LoggedIn then
                      cbUserNames.Items.Add( (ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket).Name);
                end;
            end;
            cbUserNames.ItemIndex := 0;
        finally
            lbActiveConnections.Items.EndUpdate;
            cbUserNames.Items.EndUpdate;
        end;
    end;

// Returns the server soket's index to the user connection, or -1 if not found
function TfSocketServerMain.IndexOfUserSocket(Username_: string): integer;
    var
        i: integer;
    begin
        result := -1; // not found
        Username_ := lowercase(Username_);
        i := 0;
        while ( (result = -1) and (i < ServerSocket1.Socket.ActiveConnections) ) do
        begin
            if lowercase( (ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket).Name ) = Username_ then  // typecast the socket as our soucket type (with extra properties and methods)
            result := i // we found this user in our active connections list, return its' index
            else
              inc(i); // keep looking
        end;
    end;

// windows message used to get the main vcl thread to send a message to the user (fired from timer/thread or event)
procedure TfSocketServerMain.Message_SendLockMessageToSocketUser(var Msg: TMessage);
    begin
// the Message.wParam property holds the pointer to the socket connection
        try
            TLoggedOnUserSocket(Msg.WParam).SendText('LOCK');
            AddToLog(TLoggedOnUserSocket(Msg.WParam), lt_Information, dd_DataOut, 'LOCK');
        except
            on e: exception do
              AddToLog(nil, lt_Error, dd_DataOut, 'LOCK: ' + E.Message); // do not pass socket in case that is the error
        end;
    end;

// windows message used to get the main vcl thread to send a message to the user (fired from timer/thread or event)
procedure TfSocketServerMain.Message_SendUnlockMessageToSocketUser(var Msg: TMessage);
    begin
// the Message.wParam property holds the pointer to the socket connection
        try
            TLoggedOnUserSocket(Msg.WParam).SendText('UNLOCK');
            AddToLog(TLoggedOnUserSocket(Msg.WParam), lt_Information, dd_DataOut, 'UNLOCK');
// start our timer
            TLoggedOnUserSocket(Msg.WParam).TimerThread := TSimpleTimerThread.Create(True); // create suspended so we can set the settings
            TLoggedOnUserSocket(Msg.WParam).TimerThread.Interval := (DefaultSecondsToLock * 1000); //seconds to miliseconds
            TLoggedOnUserSocket(Msg.WParam).TimerThread.HandleToTalkTo := fSocketServerMain.Handle; // Main Form's handle
            TLoggedOnUserSocket(Msg.WParam).TimerThread.Socket := TLoggedOnUserSocket(Msg.WParam);
            TLoggedOnUserSocket(Msg.WParam).TimerThread.FreeOnTerminate := True;
            TLoggedOnUserSocket(Msg.WParam).TimerThread.Resume;
        except
            on e: exception do
              AddToLog(nil, lt_Error, dd_DataOut, 'UNLOCK: ' + E.Message); // do not pass socket in case that is the error
        end;
    end;

// windows message used to get the main vcl thread to send a message to the user (fired from timer/thread or event)
procedure TfSocketServerMain.Message_SendGeneralTextMessageToSocketUser(var Msg: TMessage);
    begin
// the Message.wParam property holds the pointer to the socket connection
        try
            TLoggedOnUserSocket(Msg.WParam).SendText(TLoggedOnUserSocket(Msg.WParam).TextToSend);
            AddToLog(TLoggedOnUserSocket(Msg.WParam), lt_Information, dd_DataOut, TLoggedOnUserSocket(Msg.WParam).TextToSend);
        except
            on e: exception do
              AddToLog(nil, lt_Error, dd_DataOut, 'TEXT: ' + E.Message); // do not pass socket in case that is the error
        end;
    end;

procedure TfSocketServerMain.AddToLog(Socket: TLoggedOnUserSocket; LogType: TLogType; DataDirection: TDataDirection; MessageText: string);
    var
        completemessage: string;
    begin
        completemessage := FormatDateTime('hh":"nn":"ss" "', Now);
        case LogType of
            lt_Information: completemessage := completemessage + ' ';
            lt_Warning: completemessage := completemessage + '?';
            lt_Error: completemessage := completemessage + '!';
        end;
       
        case DataDirection of
            dd_Connect: completemessage := completemessage + ' + ';
            dd_Disconnect: completemessage := completemessage + ' - ';
            dd_DataIn: completemessage := completemessage + '<- ';
            dd_Nowhere: completemessage := completemessage + '   ';
            dd_DataOut: completemessage := completemessage + '-> ';
        end;
        if socket <> nil then
          completemessage := completemessage +
        RightPad( Socket.Name, 5, ' ') +
        Socket.RemoteHost + ' (' +
        Socket.RemoteAddress + '):' +
        IntToStr(Socket.RemotePort) + ' ';
        AddToLog(completemessage + MessageText);
    end;

procedure TfSocketServerMain.AddToLog(MessageText: string);
    begin
        mLog.Lines.Add(MessageText);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TfSocketServerMain.ServerSocket1GetSocket(Sender: TObject;
Socket: Integer; var ClientSocket: TServerClientWinSocket);
    begin
// create our own socket component, and use that
// that way we can store connection specific information like name, and timers, etc if we want
        ClientSocket := TLoggedOnUserSocket.Create(Socket, (sender as TServerWinSocket)) ;
        (ClientSocket as TLoggedOnUserSocket).Stage := ss_WaitingForLogin;
    end;


procedure TfSocketServerMain.CheckLoginDetails(Sender: TObject; Socket: TCustomWinSocket; LoginName: string);
    var
        whichuser: integer;
    begin
        whichuser := UsersList.IndexOf(LoginName);
        if whichuser <> -1 then
        begin // found the user
// check if user is already logged on
            if IndexOfUserSocket(LoginName) = -1 then
            begin
                (Socket as TLoggedOnUserSocket).UsersListIndex := whichuser;
                (Socket as TLoggedOnUserSocket).Name := UsersList[whichuser];
                (Socket as TLoggedOnUserSocket).SecondsUntilLock := DefaultSecondsToLock;
                (Socket as TLoggedOnUserSocket).Stage := ss_LoggedIn;
                PostMessage(Handle, WM_SendUnlockMessageToSocketUser, integer(Socket), 0);
                DisplayActiveConnections(nil); // refresh the combobox, etc
            end
            else
            begin // this user is already connected
                (Socket as TLoggedOnUserSocket).TextToSend := 'ERROR This user is already connected';
                PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
            end;
        end
        else
        begin // could not find user in our list
            (Socket as TLoggedOnUserSocket).TextToSend := 'ERROR Unknown User "' + LoginName + '"';
            PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
        end;
    end;

procedure TfSocketServerMain.ParseClientCommand(Sender: TObject; Socket: TCustomWinSocket; CommandLine: string);
    begin
        if uppercase(CommandLine) = '?' then
        begin
            (Socket as TLoggedOnUserSocket).TextToSend := 'the first thing you should send is your login name. After that you can send the commands "?", "DATE", or "JUMP"';
            PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
        end
        else if uppercase(CommandLine) = 'DATE' then
        begin
            (Socket as TLoggedOnUserSocket).TextToSend := FormatDateTime('dd"-"mmm"-"yyyy', Now);
            PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
        end
        else if uppercase(CommandLine) = 'JUMP' then
        begin
            (Socket as TLoggedOnUserSocket).TextToSend := 'Wheeee!';
            PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
        end
        else
        begin
            (Socket as TLoggedOnUserSocket).TextToSend := 'UNKNOWN COMMAND: "' + CommandLine + '"';
            PostMessage(Handle, WM_SendGeneralTextMessageToSocketUser, integer(Socket), 0);
        end
    end;


procedure TfSocketServerMain.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
    begin
        AddToLog(nil, lt_Error, dd_Nowhere, 'Error: ' + IntToStr(ErrorCode));
        SysUtils.Abort;
    end;

{ TSimpleTimerThread }

procedure TSimpleTimerThread.execute;
    begin
        sleep(self.Interval);
        if not Terminated then
          PostMessage(HandleToTalkTo, WM_SendLockMessageToSocketUser, integer(Socket), 0);
    end;

{ TLoggedOnUserSocket }

destructor TLoggedOnUserSocket.Destroy;
    begin
        if assigned(TimerThread) then
        try
            TimerThread.Terminate;
        except
        end;
        inherited;
    end;

end.

********************************* FORM FOLLOWS
********************************* FORM FOLLOWS

object fSocketServerMain: TfSocketServerMain
  Left = 345
  Top = 300
  BorderStyle = bsSingle
  Caption = 'Socket Test'
  ClientHeight = 377
  ClientWidth = 641
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDefault
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label5: TLabel
    Left = 368
    Top = 0
    Width = 135
    Height = 13
    Caption = 'Active connections to server'
  end
  object gbServer: TGroupBox
    Left = 16
    Top = 16
    Width = 337
    Height = 161
    Caption = 'Server'
    TabOrder = 0
    object Label1: TLabel
      Left = 16
      Top = 28
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object Label2: TLabel
      Left = 8
      Top = 56
      Width = 59
      Height = 13
      Caption = 'Text to send'
    end
    object Label3: TLabel
      Left = 8
      Top = 104
      Width = 50
      Height = 13
      Caption = 'Recipients'
    end
    object eServerPort: TEdit
      Left = 72
      Top = 24
      Width = 41
      Height = 21
      TabOrder = 0
      Text = '2000'
    end
    object bListen: TButton
      Left = 224
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Listen'
      TabOrder = 1
      OnClick = bListenClick
    end
    object eServerSend: TEdit
      Left = 8
      Top = 72
      Width = 193
      Height = 21
      TabOrder = 2
      Text = 'Text to send from server'
    end
    object bServerSendUserText: TButton
      Left = 224
      Top = 120
      Width = 75
      Height = 25
      Caption = 'Send Text'
      TabOrder = 3
      OnClick = bServerSendUserTextClick
    end
    object bOffline: TButton
      Left = 224
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Offline'
      TabOrder = 4
      OnClick = bOfflineClick
    end
    object cbUserNames: TComboBox
      Left = 8
      Top = 120
      Width = 193
      Height = 21
      Style = csDropDownList
      ItemHeight = 13
      TabOrder = 5
      Items.Strings = (
        '(ALL)')
    end
  end
  object lbActiveConnections: TListBox
    Left = 368
    Top = 24
    Width = 257
    Height = 97
    ItemHeight = 13
    TabOrder = 1
  end
  object mLog: TMemo
    Left = 16
    Top = 208
    Width = 609
    Height = 145
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    ParentFont = False
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 2000
    ServerType = stNonBlocking
    OnGetSocket = ServerSocket1GetSocket
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    Left = 360
    Top = 64
  end
end


Avatar of Scay7

ASKER

I see that when a new users joins on it assign a new port, how does it do that.

This new server is wonderful, i have something else in mind for it.
But with what i posted i have a running program, i was just wondering if there is an easier way to capture the
.connections[x]

You server example works great, just that itll chew more CPU than my current working one...

Ill try explain more as to what my pogram does

        [server]                                                            [computers]
timer1-> ACTIVE always
 -pc1 = 5min --send-captation64.text               receive(server) = static1.text
 -pc2 = 60min
 -pc3 = 15min

Server has a timer component always active, inside of that are variables for each pc on the main form of server. person click pc1 do 5min which then assigns(inside the timer) the right values and starts counting down, now while its counting down the server has already sent to pc1 to unlock and let the client use the pc. Currently they cant see how the time is counting down. I have already made up something to send the servers time(pc1 assigned time) to pc1 displayed on pc1.statictext1.captation...

Now the problem comes in where the pc2 connects in and the .connection[x] where x is = 1 and pc1 = 0
so when i want to send pc2's time im not sure if pc1 = 1 or 0 cause they might connect at different times or the pc crashes or something...

So i need a way to ID the .connections[x] to an IP when i then can compare to edit.texts and assign each edit.text to the right .connection[x]'s so when the server starts sending TIME(00:00:00) to a station[x] i know which .connection[x] to use.

I hope that this makes sense, if not please ask a question then i answer it.

And about your login/server i have something else in mind for it, so it hasnt gone to waste....

Peacy Scay7
with the examples you gave me.
I made the server require a login because ip addresses may change (especially over the internet) so i wanted a reliable way of knowing who was at the other end, so that looking up the socket's "user name" (e.g. "PC1") will always find the correct socket
Take a look at the function IndexOfUserSocket(Username_: string): integer;
and the bServerSendUserTextClick() event

if you wanted to send a message to "pc1", all you need to do is this

var
     i: integer;
begin
    i := IndexOfUserSocket('PC1');
    if i <> -1 then
    begin
        AddToLog((ServerSocket1.Socket.Connections[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
        ServerSocket1.Socket.Connections[i].SendText('Blah');
    end;
end;

you could also add a "MyEditBox" property to the TLoggedOnUserSocket class, so that you can reference it by
ServerSocket1.Socket.Connections[i].MyEditBox
The Timer thread can easily be changed to send a message every second also
Avatar of Scay7

ASKER

TheRealLoki i Accepted the question, Great help i really truely appreciate this.
But can i still ask questions here about this/you examples incase i get stuck...

Peace Scay7
Avatar of Scay7

ASKER

Okay i found a problem which i have no clue of heres what happened

i connected 4 people
i then disconnect those 4 people 1 by 1 when i got to the last person
and disconnected him (leaving no one on the server)

i get error (on server)

Access violation at address 0040325E in module 'demo.exe'.
Read of address 00000100.

Peace Scay7