Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 421
  • Last Modified:

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

0
Scay7
Asked:
Scay7
  • 11
  • 6
1 Solution
 
TheRealLokiSenior DeveloperCommented:
There are many ways to do this
Here is a demo I wrote for you showing you how to do this, using the standard sockets in delphi.

unit sockettestmain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;
(* demo by }-=Loki=-{ lokiwashere@yahoo.co.nz *)
type
  TForm2 = class(TForm)
    mLog: TMemo;
    ClientSocket1: TClientSocket;
    gbServer: TGroupBox;
    rbServer: TRadioButton;
    ServerSocket1: TServerSocket;
    eServerPort: TEdit;
    Label1: TLabel;
    bListen: TButton;
    eServerSend: TEdit;
    bServerSendToAll: TButton;
    gbClient: TGroupBox;
    Label2: TLabel;
    eClientPort: TEdit;
    bConnect: TButton;
    eClientSend: TEdit;
    bClientSend: TButton;
    rbClient: TRadioButton;
    Label3: TLabel;
    eAddress: TEdit;
    bOffline: TButton;
    bDisconnect: TButton;
    procedure bListenClick(Sender: TObject);
    procedure bServerSendToAllClick(Sender: TObject);
    procedure rbServerClick(Sender: TObject);
    procedure rbClientClick(Sender: TObject);
    procedure bConnectClick(Sender: TObject);
    procedure bClientSendClick(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure bOfflineClick(Sender: TObject);
    procedure bDisconnectClick(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

IMPLEMENTATION

{$R *.DFM}

procedure TForm2.rbServerClick(Sender: TObject);
    begin
        gbServer.Enabled := True;
        gbClient.Enabled := False;
    end;

procedure TForm2.rbClientClick(Sender: TObject);
    begin
        gbServer.Enabled := False;
        gbClient.Enabled := True;
    end;


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

procedure TForm2.bOfflineClick(Sender: TObject);
    begin
        ServerSocket1.Active := True;
    end;

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

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

procedure TForm2.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add(Socket.ReceiveText);
    end;

procedure TForm2.bServerSendToAllClick(Sender: TObject);
    var
        i: integer;
    begin
        for i := 0 to pred(ServerSocket1.Socket.ActiveConnections) do
         ServerSocket1.Socket.Connections[i].SendText(eServerSend.Text);
    end;

// ********************************     client code here
procedure TForm2.bConnectClick(Sender: TObject);
    begin
        ClientSocket1.Address := eAddress.Text;
        ClientSocket1.Port := StrToIntDef(eClientPort.Text, 2000);
        ClientSocket1.Open;
    end;

procedure TForm2.bClientSendClick(Sender: TObject);
    begin
        ClientSocket1.Socket.SendText(eClientSend.Text);
    end;

procedure TForm2.bDisconnectClick(Sender: TObject);
    begin
        ClientSocket1.Close;
    end;

procedure TForm2.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add(Socket.ReceiveText);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Connecting(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connecting to ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('connected to ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

procedure TForm2.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
    begin
        mLog.lines.add('disconnected from ' + ClientSocket1.Address + ':' + IntToStr(ClientSocket1.Port));
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
    end;

end.


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


object Form2: TForm2
  Left = 345
  Top = 300
  BorderStyle = bsSingle
  Caption = 'Form2'
  ClientHeight = 323
  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
  PixelsPerInch = 96
  TextHeight = 13
  object mLog: TMemo
    Left = 372
    Top = 48
    Width = 261
    Height = 265
    TabOrder = 0
  end
  object gbServer: TGroupBox
    Left = 16
    Top = 40
    Width = 337
    Height = 105
    Caption = 'Server'
    TabOrder = 1
    object Label1: TLabel
      Left = 16
      Top = 28
      Width = 19
      Height = 13
      Caption = 'Port'
    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 bServerSendToAll: TButton
      Left = 224
      Top = 72
      Width = 75
      Height = 25
      Caption = 'Send to all'
      TabOrder = 3
      OnClick = bServerSendToAllClick
    end
    object bOffline: TButton
      Left = 224
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Offline'
      TabOrder = 4
      OnClick = bOfflineClick
    end
  end
  object rbServer: TRadioButton
    Left = 16
    Top = 8
    Width = 113
    Height = 17
    Caption = 'Server'
    TabOrder = 2
    OnClick = rbServerClick
  end
  object gbClient: TGroupBox
    Left = 16
    Top = 176
    Width = 337
    Height = 137
    Caption = 'Client'
    TabOrder = 3
    object Label2: TLabel
      Left = 16
      Top = 44
      Width = 19
      Height = 13
      Caption = 'Port'
    end
    object Label3: TLabel
      Left = 16
      Top = 20
      Width = 38
      Height = 13
      Caption = 'Address'
    end
    object eClientPort: TEdit
      Left = 72
      Top = 40
      Width = 41
      Height = 21
      TabOrder = 1
      Text = '2000'
    end
    object bConnect: TButton
      Left = 224
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Connect'
      TabOrder = 2
      OnClick = bConnectClick
    end
    object eClientSend: TEdit
      Left = 8
      Top = 88
      Width = 193
      Height = 21
      TabOrder = 3
      Text = 'Text to send from server'
    end
    object bClientSend: TButton
      Left = 224
      Top = 88
      Width = 75
      Height = 25
      Caption = 'Send'
      TabOrder = 4
      OnClick = bClientSendClick
    end
    object eAddress: TEdit
      Left = 72
      Top = 16
      Width = 113
      Height = 21
      TabOrder = 0
      Text = '127.0.0.1'
    end
    object bDisconnect: TButton
      Left = 224
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Disconnect'
      TabOrder = 5
      OnClick = bDisconnectClick
    end
  end
  object rbClient: TRadioButton
    Left = 16
    Top = 152
    Width = 113
    Height = 17
    Caption = 'Client'
    Checked = True
    TabOrder = 4
    TabStop = True
    OnClick = rbClientClick
  end
  object ClientSocket1: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Host = 'localhost'
    Port = 2000
    OnConnecting = ClientSocket1Connecting
    OnConnect = ClientSocket1Connect
    OnDisconnect = ClientSocket1Disconnect
    OnRead = ClientSocket1Read
    Left = 356
    Top = 164
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 2000
    ServerType = stNonBlocking
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    Left = 360
    Top = 88
  end
end
0
 
huferryCommented:
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.
0
 
Scay7Author Commented:
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
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Scay7Author Commented:
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
0
 
Scay7Author Commented:
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...
0
 
Scay7Author Commented:
TheReadLoki ?
Huferry ?

Feedback is welcome...

Peace Scay7
0
 
TheRealLokiSenior DeveloperCommented:
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)
0
 
Scay7Author Commented:
Hi Loki

Listen how do i list the serversocket1.Socket.Connections[0] into string/TString better string, that i can ID the IPs
0
 
TheRealLokiSenior DeveloperCommented:
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;
0
 
Scay7Author Commented:
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;
0
 
TheRealLokiSenior DeveloperCommented:
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 :-)
0
 
Scay7Author Commented:
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
0
 
Scay7Author Commented:
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;
0
 
TheRealLokiSenior DeveloperCommented:
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


0
 
Scay7Author Commented:
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.
0
 
TheRealLokiSenior DeveloperCommented:
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
0
 
Scay7Author Commented:
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
0
 
Scay7Author Commented:
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
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

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