Scay7
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.T ext, '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
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:
begin
Sock1.SendDatagram(Memo1.T
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
huferry okay i havent used Indy before, so could you give a basic example ? Ive got Indy that comes with D7
Peace 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
and i had to change all you TForm2 to Tform1 :P
Still want some ides from Huferry...
Peace 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...
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...
ASKER
TheReadLoki ?
Huferry ?
Feedback is welcome...
Peace Scay7
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.Te xt, 2000); // change this to the port you wish to use
e.g. ServerSocket1.Port := 3000;
...
procedure TForm2.bConnectClick(Sende r: TObject);
begin
ClientSocket1.Address := eAddress.Text; // or mydomain.com or 123.456.789.123
ClientSocket1.Port := StrToIntDef(eClientPort.Te xt, 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)
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
begin
ServerSocket1.Port := StrToIntDef(eServerPort.Te
e.g. ServerSocket1.Port := 3000;
...
procedure TForm2.bConnectClick(Sende
begin
ClientSocket1.Address := eAddress.Text; // or mydomain.com or 123.456.789.123
ClientSocket1.Port := StrToIntDef(eClientPort.Te
...
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)
ASKER
Hi Loki
Listen how do i list the serversocket1.Socket.Conne ctions[0] into string/TString better string, that i can ID the IPs
Listen how do i list the serversocket1.Socket.Conne
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 ServerSocket1ClientDIsconn ect() 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(T hisSocketI sClosing: TCustomWinSocket);
procedure TfSocketTestMain.ServerSoc ket1Client Connect(Se nder: TObject; Socket: TCustomWinSocket);
begin
mLog.lines.add('connection from ' + Socket.RemoteAddress);
mLog.Perform(EM_SCROLL,SB_ LINEDOWN,0 );
DisplayActiveConnections(N il);
end;
procedure TfSocketTestMain.ServerSoc ket1Client Disconnect (Sender: TObject; Socket: TCustomWinSocket);
begin
mLog.lines.add('disconnect ion from ' + Socket.RemoteAddress);
mLog.Perform(EM_SCROLL,SB_ LINEDOWN,0 );
DisplayActiveConnections(S ocket);
end;
procedure TfSocketTestMain.DisplayAc tiveConnec tions(This SocketIsCl osing: TCustomWinSocket);
var
i: integer;
begin
lbActiveConnections.Items. BeginUpdat e;
try
lbActiveConnections.Items. Clear;
for i := 0 to pred(ServerSocket1.Socket. ActiveConn ections) 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.Conne ctions[i]) ) then
lbActiveConnections.Items. Add(
ServerSocket1.Socket.Conne ctions[i]. RemoteHost + ' (' +
ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess + '):' +
IntToStr(ServerSocket1.Soc ket.Connec tions[i].R emotePort) );
end;
finally
lbActiveConnections.Items. EndUpdate;
end;
end;
We will use this to show the "active connections" to the server.
Change the ServerSocket1ClientConnect
DisplayActiveConnections()
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(T
procedure TfSocketTestMain.ServerSoc
begin
mLog.lines.add('connection
mLog.Perform(EM_SCROLL,SB_
DisplayActiveConnections(N
end;
procedure TfSocketTestMain.ServerSoc
begin
mLog.lines.add('disconnect
mLog.Perform(EM_SCROLL,SB_
DisplayActiveConnections(S
end;
procedure TfSocketTestMain.DisplayAc
var
i: integer;
begin
lbActiveConnections.Items.
try
lbActiveConnections.Items.
for i := 0 to pred(ServerSocket1.Socket.
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.Conne
lbActiveConnections.Items.
ServerSocket1.Socket.Conne
ServerSocket1.Socket.Conne
IntToStr(ServerSocket1.Soc
end;
finally
lbActiveConnections.Items.
end;
end;
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.DisplayActiveConnec tions(This SocketIsCl osing: TCustomWinSocket);
var i: integer;
begin
listbox2.Items.BeginUpdate ;
try
listbox2.Items.Clear;
for i := 0 to pred(ServerSocket1.Socket. ActiveConn ections) do
begin
if ( (ThisSocketIsClosing = nil) or (ThisSocketIsClosing <> ServerSocket1.Socket.Conne ctions[i]) ) then
listbox2.Items.Add(ServerS ocket1.Soc ket.Connec tions[i].R emoteAddre ss);
//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.Conne ctions[i]. RemoteAddr ess = edit11.Text then data[1].st := i;
if ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess = edit12.Text then data[2].st := i;
if ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess = edit13.Text then data[3].st := i;
if ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess = edit14.Text then data[4].st := i;
if ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess = edit15.Text then data[5].st := i;
if ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess = 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;
You done great work so far, really !
procedure Tform1.DisplayActiveConnec
var i: integer;
begin
listbox2.Items.BeginUpdate
try
listbox2.Items.Clear;
for i := 0 to pred(ServerSocket1.Socket.
begin
if ( (ThisSocketIsClosing = nil) or (ThisSocketIsClosing <> ServerSocket1.Socket.Conne
listbox2.Items.Add(ServerS
//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.Conne
if ServerSocket1.Socket.Conne
if ServerSocket1.Socket.Conne
if ServerSocket1.Socket.Conne
if ServerSocket1.Socket.Conne
if ServerSocket1.Socket.Conne
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 :-)
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 :-)
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
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
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;
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.ClientSoc ket1Error( 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_SendLockMessageToSocket User = 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_SendUnlockMessageToSock etUser = 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_SendGeneralTextMessageT oSocketUse r = 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(TServerClientWinSock et)
public
Stage: integer; //ss_WaitingForLogin, ss_LoggedIn
UsersListIndex: integer;
Name: string; // same as UsersListIndex[UsersListIn dex], 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(S ender: TObject);
procedure ServerSocket1ClientRead(Se nder: TObject; Socket: TCustomWinSocket);
procedure bOfflineClick(Sender: TObject);
procedure ServerSocket1ClientConnect (Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconn ect(Sender : TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ServerSocket1GetSocket(Sen der: TObject; Socket: Integer;
var ClientSocket: TServerClientWinSocket);
procedure ServerSocket1ClientError(S ender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
procedure Message_SendLockMessageToS ocketUser( var Msg: TMessage); message WM_SendLockMessageToSocket User;
procedure Message_SendUnlockMessageT oSocketUse r(var Msg: TMessage); message WM_SendUnlockMessageToSock etUser;
procedure Message_SendGeneralTextMes sageToSock etUser(var Msg: TMessage); message WM_SendGeneralTextMessageT oSocketUse r;
procedure DisplayActiveConnections(T hisSocketI sClosing: 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.FormCre ate(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(Ext ractFilePa th(Paramst r(0) + 'Users.txt');
cbUserNames.ItemIndex := 0; // default to "send to all"
end;
procedure TfSocketServerMain.FormDes troy(Sende r: TObject);
begin
UsersList.Clear;
UsersList.Free;
end;
// ************************** ****** server code here
procedure TfSocketServerMain.bListen Click(Send er: TObject);
begin
ServerSocket1.Port := StrToIntDef(eServerPort.Te xt, 2000);
ServerSocket1.Active := True;
end;
procedure TfSocketServerMain.bOfflin eClick(Sen der: TObject);
begin
ServerSocket1.Active := False;
end;
procedure TfSocketServerMain.ServerS ocket1Clie ntConnect( Sender: TObject; Socket: TCustomWinSocket);
begin
AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Connect, 'Connected');
DisplayActiveConnections(N il);
// send "welcome" message
(Socket as TLoggedOnUserSocket).TextT oSend := 'Hello. please send your name';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end;
procedure TfSocketServerMain.ServerS ocket1Clie ntDisconne ct(Sender: TObject; Socket: TCustomWinSocket);
begin
AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Disconnect, 'Disconnected');
DisplayActiveConnections(S ocket);
end;
procedure TfSocketServerMain.ServerS ocket1Clie ntRead(Sen der: 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.bServer SendUserTe xtClick(Se nder: TObject);
var
i: integer;
begin
if cbUserNames.ItemIndex = 0 then
begin // send to all
for i := 0 to pred(ServerSocket1.Socket. ActiveConn ections) do
begin
AddToLog((ServerSocket1.So cket.Conne ctions[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
ServerSocket1.Socket.Conne ctions[i]. SendText(e ServerSend .Text);
end;
end
else
begin
i := self.IndexOfUserSocket(cbU serNames.I tems[cbUse rNames.Ite mIndex]); // get the name from the combobox
if i <> -1 then
begin
AddToLog((ServerSocket1.So cket.Conne ctions[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
ServerSocket1.Socket.Conne ctions[i]. SendText(e ServerSend .Text);
end;
end;
end;
procedure TfSocketServerMain.Display ActiveConn ections(Th isSocketIs Closing: TCustomWinSocket);
var
i: integer;
begin
lbActiveConnections.Items. BeginUpdat e;
cbUserNames.Items.BeginUpd ate;
try
lbActiveConnections.Items. Clear;
cbUserNames.Items.Clear;
cbUserNames.Items.Add('(AL L)');
for i := 0 to pred(ServerSocket1.Socket. ActiveConn ections) 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.Conne ctions[i]) ) then
begin
lbActiveConnections.Items. Add(
ServerSocket1.Socket.Conne ctions[i]. RemoteHost + ' (' +
ServerSocket1.Socket.Conne ctions[i]. RemoteAddr ess + '):' +
IntToStr(ServerSocket1.Soc ket.Connec tions[i].R emotePort) );
// only add the name to the list if they have logged in
if (ServerSocket1.Socket.Conn ections[i] as TLoggedOnUserSocket).Stage >= ss_LoggedIn then
cbUserNames.Items.Add( (ServerSocket1.Socket.Conn ections[i] as TLoggedOnUserSocket).Name) ;
end;
end;
cbUserNames.ItemIndex := 0;
finally
lbActiveConnections.Items. EndUpdate;
cbUserNames.Items.EndUpdat e;
end;
end;
// Returns the server soket's index to the user connection, or -1 if not found
function TfSocketServerMain.IndexOf UserSocket (Username_ : string): integer;
var
i: integer;
begin
result := -1; // not found
Username_ := lowercase(Username_);
i := 0;
while ( (result = -1) and (i < ServerSocket1.Socket.Activ eConnectio ns) ) do
begin
if lowercase( (ServerSocket1.Socket.Conn ections[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 _SendLockM essageToSo cketUser(v ar Msg: TMessage);
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP aram).Send Text('LOCK ');
AddToLog(TLoggedOnUserSock et(Msg.WPa ram), 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 _SendUnloc kMessageTo SocketUser (var Msg: TMessage);
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP aram).Send Text('UNLO CK');
AddToLog(TLoggedOnUserSock et(Msg.WPa ram), lt_Information, dd_DataOut, 'UNLOCK');
// start our timer
TLoggedOnUserSocket(Msg.WP aram).Time rThread := TSimpleTimerThread.Create( True); // create suspended so we can set the settings
TLoggedOnUserSocket(Msg.WP aram).Time rThread.In terval := (DefaultSecondsToLock * 1000); //seconds to miliseconds
TLoggedOnUserSocket(Msg.WP aram).Time rThread.Ha ndleToTalk To := fSocketServerMain.Handle; // Main Form's handle
TLoggedOnUserSocket(Msg.WP aram).Time rThread.So cket := TLoggedOnUserSocket(Msg.WP aram);
TLoggedOnUserSocket(Msg.WP aram).Time rThread.Fr eeOnTermin ate := True;
TLoggedOnUserSocket(Msg.WP aram).Time rThread.Re sume;
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 _SendGener alTextMess ageToSocke tUser(var Msg: TMessage);
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP aram).Send Text(TLogg edOnUserSo cket(Msg.W Param).Tex tToSend);
AddToLog(TLoggedOnUserSock et(Msg.WPa ram), lt_Information, dd_DataOut, TLoggedOnUserSocket(Msg.WP aram).Text ToSend);
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.AddToLo g(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.AddToLo g(MessageT ext: string);
begin
mLog.Lines.Add(MessageText );
mLog.Perform(EM_SCROLL,SB_ LINEDOWN,0 );
end;
procedure TfSocketServerMain.ServerS ocket1GetS ocket(Send er: 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.CheckLo ginDetails (Sender: TObject; Socket: TCustomWinSocket; LoginName: string);
var
whichuser: integer;
begin
whichuser := UsersList.IndexOf(LoginNam e);
if whichuser <> -1 then
begin // found the user
// check if user is already logged on
if IndexOfUserSocket(LoginNam e) = -1 then
begin
(Socket as TLoggedOnUserSocket).Users ListIndex := whichuser;
(Socket as TLoggedOnUserSocket).Name := UsersList[whichuser];
(Socket as TLoggedOnUserSocket).Secon dsUntilLoc k := DefaultSecondsToLock;
(Socket as TLoggedOnUserSocket).Stage := ss_LoggedIn;
PostMessage(Handle, WM_SendUnlockMessageToSock etUser, integer(Socket), 0);
DisplayActiveConnections(n il); // refresh the combobox, etc
end
else
begin // this user is already connected
(Socket as TLoggedOnUserSocket).TextT oSend := 'ERROR This user is already connected';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end;
end
else
begin // could not find user in our list
(Socket as TLoggedOnUserSocket).TextT oSend := 'ERROR Unknown User "' + LoginName + '"';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end;
end;
procedure TfSocketServerMain.ParseCl ientComman d(Sender: TObject; Socket: TCustomWinSocket; CommandLine: string);
begin
if uppercase(CommandLine) = '?' then
begin
(Socket as TLoggedOnUserSocket).TextT oSend := 'the first thing you should send is your login name. After that you can send the commands "?", "DATE", or "JUMP"';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end
else if uppercase(CommandLine) = 'DATE' then
begin
(Socket as TLoggedOnUserSocket).TextT oSend := FormatDateTime('dd"-"mmm"- "yyyy', Now);
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end
else if uppercase(CommandLine) = 'JUMP' then
begin
(Socket as TLoggedOnUserSocket).TextT oSend := 'Wheeee!';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end
else
begin
(Socket as TLoggedOnUserSocket).TextT oSend := 'UNKNOWN COMMAND: "' + CommandLine + '"';
PostMessage(Handle, WM_SendGeneralTextMessageT oSocketUse r, integer(Socket), 0);
end
end;
procedure TfSocketServerMain.ServerS ocket1Clie ntError(Se nder: 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_SendLockMessageToSocket User, integer(Socket), 0);
end;
{ TLoggedOnUserSocket }
destructor TLoggedOnUserSocket.Destro y;
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 = ServerSocket1ClientDisconn ect
OnClientRead = ServerSocket1ClientRead
Left = 360
Top = 64
end
end
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.ClientSoc
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_SendLockMessageToSocket
WM_SendUnlockMessageToSock
WM_SendGeneralTextMessageT
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(TServerClientWinSock
public
Stage: integer; //ss_WaitingForLogin, ss_LoggedIn
UsersListIndex: integer;
Name: string; // same as UsersListIndex[UsersListIn
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(S
procedure ServerSocket1ClientRead(Se
procedure bOfflineClick(Sender: TObject);
procedure ServerSocket1ClientConnect
procedure ServerSocket1ClientDisconn
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ServerSocket1GetSocket(Sen
var ClientSocket: TServerClientWinSocket);
procedure ServerSocket1ClientError(S
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
procedure Message_SendLockMessageToS
procedure Message_SendUnlockMessageT
procedure Message_SendGeneralTextMes
procedure DisplayActiveConnections(T
procedure CheckLoginDetails(Sender: TObject; Socket: TCustomWinSocket; LoginName: string);
procedure ParseClientCommand(Sender:
public
{ Public declarations }
UsersList: TStringList;
function IndexOfUserSocket(Username
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.FormCre
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(Ext
cbUserNames.ItemIndex := 0; // default to "send to all"
end;
procedure TfSocketServerMain.FormDes
begin
UsersList.Clear;
UsersList.Free;
end;
// **************************
procedure TfSocketServerMain.bListen
begin
ServerSocket1.Port := StrToIntDef(eServerPort.Te
ServerSocket1.Active := True;
end;
procedure TfSocketServerMain.bOfflin
begin
ServerSocket1.Active := False;
end;
procedure TfSocketServerMain.ServerS
begin
AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Connect, 'Connected');
DisplayActiveConnections(N
// send "welcome" message
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end;
procedure TfSocketServerMain.ServerS
begin
AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_Disconnect, 'Disconnected');
DisplayActiveConnections(S
end;
procedure TfSocketServerMain.ServerS
var
InString: string;
begin
InString := Socket.ReceiveText;
AddToLog((Socket as TLoggedOnUserSocket), lt_Information, dd_DataIn, InString);
case ( Socket as TLoggedOnUserSocket).Stage
ss_WaitingForLogin: CheckLoginDetails(Sender, Socket, InString);
ss_LoggedIn: ParseClientCommand(Sender,
end;
end;
procedure TfSocketServerMain.bServer
var
i: integer;
begin
if cbUserNames.ItemIndex = 0 then
begin // send to all
for i := 0 to pred(ServerSocket1.Socket.
begin
AddToLog((ServerSocket1.So
ServerSocket1.Socket.Conne
end;
end
else
begin
i := self.IndexOfUserSocket(cbU
if i <> -1 then
begin
AddToLog((ServerSocket1.So
ServerSocket1.Socket.Conne
end;
end;
end;
procedure TfSocketServerMain.Display
var
i: integer;
begin
lbActiveConnections.Items.
cbUserNames.Items.BeginUpd
try
lbActiveConnections.Items.
cbUserNames.Items.Clear;
cbUserNames.Items.Add('(AL
for i := 0 to pred(ServerSocket1.Socket.
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.Conne
begin
lbActiveConnections.Items.
ServerSocket1.Socket.Conne
ServerSocket1.Socket.Conne
IntToStr(ServerSocket1.Soc
// only add the name to the list if they have logged in
if (ServerSocket1.Socket.Conn
cbUserNames.Items.Add( (ServerSocket1.Socket.Conn
end;
end;
cbUserNames.ItemIndex := 0;
finally
lbActiveConnections.Items.
cbUserNames.Items.EndUpdat
end;
end;
// Returns the server soket's index to the user connection, or -1 if not found
function TfSocketServerMain.IndexOf
var
i: integer;
begin
result := -1; // not found
Username_ := lowercase(Username_);
i := 0;
while ( (result = -1) and (i < ServerSocket1.Socket.Activ
begin
if lowercase( (ServerSocket1.Socket.Conn
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
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP
AddToLog(TLoggedOnUserSock
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
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP
AddToLog(TLoggedOnUserSock
// start our timer
TLoggedOnUserSocket(Msg.WP
TLoggedOnUserSocket(Msg.WP
TLoggedOnUserSocket(Msg.WP
TLoggedOnUserSocket(Msg.WP
TLoggedOnUserSocket(Msg.WP
TLoggedOnUserSocket(Msg.WP
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
begin
// the Message.wParam property holds the pointer to the socket connection
try
TLoggedOnUserSocket(Msg.WP
AddToLog(TLoggedOnUserSock
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.AddToLo
var
completemessage: string;
begin
completemessage := FormatDateTime('hh":"nn":"
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.AddToLo
begin
mLog.Lines.Add(MessageText
mLog.Perform(EM_SCROLL,SB_
end;
procedure TfSocketServerMain.ServerS
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
(ClientSocket as TLoggedOnUserSocket).Stage
end;
procedure TfSocketServerMain.CheckLo
var
whichuser: integer;
begin
whichuser := UsersList.IndexOf(LoginNam
if whichuser <> -1 then
begin // found the user
// check if user is already logged on
if IndexOfUserSocket(LoginNam
begin
(Socket as TLoggedOnUserSocket).Users
(Socket as TLoggedOnUserSocket).Name := UsersList[whichuser];
(Socket as TLoggedOnUserSocket).Secon
(Socket as TLoggedOnUserSocket).Stage
PostMessage(Handle, WM_SendUnlockMessageToSock
DisplayActiveConnections(n
end
else
begin // this user is already connected
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end;
end
else
begin // could not find user in our list
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end;
end;
procedure TfSocketServerMain.ParseCl
begin
if uppercase(CommandLine) = '?' then
begin
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end
else if uppercase(CommandLine) = 'DATE' then
begin
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end
else if uppercase(CommandLine) = 'JUMP' then
begin
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end
else
begin
(Socket as TLoggedOnUserSocket).TextT
PostMessage(Handle, WM_SendGeneralTextMessageT
end
end;
procedure TfSocketServerMain.ServerS
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
end;
{ TLoggedOnUserSocket }
destructor TLoggedOnUserSocket.Destro
begin
if assigned(TimerThread) then
try
TimerThread.Terminate;
except
end;
inherited;
end;
end.
**************************
**************************
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 = ServerSocket1ClientDisconn
OnClientRead = ServerSocket1ClientRead
Left = 360
Top = 64
end
end
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.
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.So cket.Conne ctions[i] as TLoggedOnUserSocket), lt_Information, dd_DataOut, eServerSend.Text);
ServerSocket1.Socket.Conne ctions[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.Conne ctions[i]. MyEditBox
The Timer thread can easily be changed to send a message every second also
Take a look at the function IndexOfUserSocket(Username
and the bServerSendUserTextClick()
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.So
ServerSocket1.Socket.Conne
end;
end;
you could also add a "MyEditBox" property to the TLoggedOnUserSocket class, so that you can reference it by
ServerSocket1.Socket.Conne
The Timer thread can easily be changed to send a message every second also
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
But can i still ask questions here about this/you examples incase i get stuck...
Peace 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
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
Simply use write and read to send/receive messages.