I have copied the code for the server below. The error is raised by the
client when issuing IdTCPClient1.Connect(10)
^=============================================================
unit MainForm;
interface
uses
Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes,
IdBaseComponent,
IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault, ShellAPI,
StrUtils,
IdAntiFreezeBase, IdAntiFreeze;
const
WM_APPSERVERICON = WM_USER + 1;
UI_INITIALIZE = WM_APPSERVERICON + 1;
type
TSimpleClient = class(TObject)
DNS,
Name : String;
ListLink : Integer;
Thread : Pointer;
IP : String;
FullName : String;
MachineName : String;
GUID : String;
ClientNickName: String;
end;
TfrmMain = class(TForm)
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
lbClients: TListBox;
PageControl1: TPageControl;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ImageList1: TImageList;
Label3: TLabel;
lblDNS: TLabel;
tcpServer: TIdTCPServer;
lblSocketVer: TLabel;
Label5: TLabel;
Label4: TLabel;
seBinding: TSpinEdit;
IdThreadMgrDefault1: TIdThreadMgrDefault;
Label6: TLabel;
memEntry: TMemo;
Label7: TLabel;
memEMotes: TMemo;
Label8: TLabel;
Label9: TLabel;
lblClientName: TLabel;
lblClientDNS: TLabel;
puMemoMenu: TPopupMenu;
Savetofile1: TMenuItem;
Loadfromfile1: TMenuItem;
ToolBar1: TToolBar;
btnServerUp: TToolButton;
ToolButton1: TToolButton;
btnKillClient: TToolButton;
btnClients: TToolButton;
btnPM: TToolButton;
Label12: TLabel;
edSyopName: TEdit;
Label1: TLabel;
lblClientIP: TLabel;
Label2: TLabel;
lblClientFullName: TLabel;
Label10: TLabel;
lblClientMachineName: TLabel;
Label11: TLabel;
lblClientGUID: TLabel;
Label13: TLabel;
lblClientNickName: TLabel;
pmIcon: TPopupMenu;
Show2: TMenuItem;
Show1: TMenuItem;
Shutdown1: TMenuItem;
Timer1: TTimer;
IdAntiFreeze1: TIdAntiFreeze;
procedure btnServerUpClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seBindingChange(Sender: TObject);
procedure tcpServerConnect(AThread: TIdPeerThread);
procedure tcpServerDisconnect(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure tcpServerExecute(AThread: TIdPeerThread);
procedure btnClientsClick(Sender: TObject);
procedure btnPMClick(Sender: TObject);
procedure btnKillClientClick(Sender: TObject);
procedure lbClientsClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Show2Click(Sender: TObject);
procedure Shutdown1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FTaskMessage: DWord;
FIconData: TNotifyIconData;
public
{ Public declarations }
Clients : TList;
procedure UpdateBindings;
procedure UpdateClientList;
procedure BroadcastMessage( WhoFrom, TheMessage : String );
procedure Initialize(FromService: boolean);
protected
procedure AddIcon;
procedure UIInitialize(var Message: TMessage); message UI_INITIALIZE;
procedure WMAPPSERVERIcon(var Message: TMessage); message
WM_APPSERVERICON;
procedure WndProc(var Message: TMessage); override;
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
uses
IdSocketHandle; // This is where the IdSocketHandle class is defined.
procedure TfrmMain.UpdateBindings;
var
Binding : TIdSocketHandle;
begin
{ Set the TIdTCPServer's port to the chosen value }
tcpServer.DefaultPort := seBinding.Value;
{ Remove all bindings that currently exist }
tcpServer.Bindings.Clear;
{ Create a new binding }
Binding := tcpServer.Bindings.Add;
{ Assign that bindings port to our new port }
Binding.Port := seBinding.Value;
end;
procedure TfrmMain.btnServerUpClick(Sender: TObject);
begin
try
{ Check to see if the server is online or offline }
tcpServer.Active := not tcpServer.Active;
btnServerUp.Down := tcpServer.Active;
if btnServerUp.Down then
begin
{ Server is online }
btnServerUp.ImageIndex := 1;
btnServerUp.Hint := 'Shut down server';
end
else
begin
{ Server is offline }
btnServerUp.ImageIndex := 0;
btnServerUp.Hint := 'Start up server';
end;
{ Setup GUI buttons }
btnClients.Enabled:= btnServerUp.Down;
seBinding.Enabled := not btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
except
{ If we have a problem then rest things }
btnServerUp.Down := false;
seBinding.Enabled := not btnServerUp.Down;
btnClients.Enabled:= btnServerUp.Down;
edSyopName.Enabled:= not btnServerUp.Down;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
{ Initalize our clients list }
Clients := TList.Create;
{ Call updatebindings so that the servers bindings are correct }
UpdateBindings;
{ Get the local DNS entry for this computer }
lblDNS.Caption := tcpServer.LocalName;
{ Display the current version of indy running on the system }
lblSocketVer.Caption := tcpServer.Version;
btnServerUp.Click;
end;
procedure TfrmMain.seBindingChange(Sender: TObject);
begin
UpdateBindings;
end;
procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Send a welcome message, and prompt for the users name }
AThread.Connection.WriteLn('ISD Connection Established...');
// AThread.Connection.WriteLn('Please send valid login sequence...');
// AThread.Connection.WriteLn('Your Name:');
{ Create a client object }
Client := TSimpleClient.Create;
{ Assign its default values }
Client.DNS := AThread.Connection.LocalName;
Client.Name := 'Logging In';
Client.ListLink := lbClients.Items.Count;
{ Assign the thread to it for ease in finding }
Client.Thread := AThread;
{ Add to our clients list box }
lbClients.Items.Add(Client.Name);
{ Assign it to the thread so we can identify it later }
AThread.Data := Client;
{ Add it to the clients list }
Clients.Add(Client);
end;
procedure TfrmMain.tcpServerDisconnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
{ Retrieve Client Record from Data pointer }
Client := Pointer(AThread.Data);
{ Remove Client from the Clients TList }
Clients.Delete(Client.ListLink);
{ Remove Client from the Clients List Box }
lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name));
BroadcastMessage('System', Client.Name + ' has logged out.');
{ Free the Client object }
Client.Free;
AThread.Data := nil;
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if (Clients.Count > 0) and (tcpServer.Active) then
begin
Action := caNone;
ShowMessage('Can''t close CBServ while server is online.');
end
else Clients.Free;
end;
procedure TfrmMain.UpdateClientList;
var
Count : Integer;
begin
{ Loop through all the clients connected to the system and set their
names }
for Count := 0 to lbClients.Items.Count -1 do
if Count < Clients.Count then
lbClients.Items.Strings[Count] :=
TSimpleClient(Clients.Items[Count]).Name;
end;
procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread);
var
Client: TSimpleClient;
Com, Msg, sToWho: String;
sl, slRecord: TStringList;
Count: Integer;
begin
{ Get the text sent from the client }
Msg := AThread.Connection.ReadLn;
{ Get the clients package info }
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }
if Client.Name = 'Logging In' then
begin
{ if not, assign the name and announce the client }
//parse the message here!!!
sl := TStringList.Create;
sl.Delimiter := '|';
sl.DelimitedText := Msg;
Client.Name := sl.Values['NAME'];
Client.IP := sl.Values['IP'];
Client.FullName := sl.Values['FullName'];
Client.MachineName := sl.Values['MachineName'];
Client.GUID := sl.Values['GUID'];
Client.ClientNickName := sl.Values['ClientNickName'];
sl.Clear;
FreeAndNil( sl );
//Client.Name := Msg;
UpdateClientList;
BroadcastMessage('System', Client.Name + ':(' + Client.FullName + ')'
+ ' has just logged in.');
AThread.Connection.WriteLn(memEntry.Lines.Text);
end
else
{ If name is set, then send the message }
if ( Msg[1] <> '@' ) and ( Msg[1] <> '#' ) then
begin
{ Not a system command }
BroadcastMessage(Client.Name, Msg);
end
else
begin
{ System command }
Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
Msg := Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg)));
if Com = 'CLIENTS' then
begin
//AThread.Connection.WriteLn( '@' + 'clients:' +
lbClients.Items.CommaText);
sl := TStringList.Create;
sl.Delimiter := '|';
sl.DelimitedText := Msg;
slRecord := TStringList.Create;
slRecord.Delimiter := '~';
for Count := 0 to Clients.Count -1 do
begin
slRecord.Clear;
slRecord.Add( 'NAME=' +
TSimpleClient(Clients[Count]).Name );
slRecord.Add( 'IP=' + TSimpleClient(Clients[Count]).IP );
slRecord.Add( 'FULLNAME=' +
TSimpleClient(Clients[Count]).FullName );
slRecord.Add( 'MACHINENAME=' +
TSimpleClient(Clients[Count]).MachineName );
slRecord.Add( 'GUID=' +
TSimpleClient(Clients[Count]).GUID );
slRecord.Add( 'ClientNickName=' +
TSimpleClient(Clients[Count]).ClientNickName );
sl.Add(slRecord.DelimitedText);
end;
AThread.Connection.WriteLn( '@' + 'clients:' + sl.DelimitedText);
sl.Clear;
FreeAndNil( sl );
slRecord.Clear;
FreeAndNil( slRecord );
end;
if Com = 'PRIVATE' then
begin
//get the id and send to that client
sToWho := MidStr(Msg,1,Pos('~',Msg) - 1 );
Msg := Trim(MidStr(Msg,Pos('~',Msg) + 1, 9999));
Msg := 'Private=>' + Msg;
for Count := 0 to Clients.Count - 1 do
begin
Client := TSimpleClient(Clients[Count]);
if Client.GUID = sToWho then
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;
if Com = 'SYSMSG' then
begin
//get the id and send to that client
sToWho := MidStr(Msg,1,Pos('~',Msg) - 1 );
Msg := Trim(MidStr(Msg,Pos('~',Msg) + 1, 9999));
Msg := '#SYSMSG:' + sToWho + '~' + Msg;
if sToWho = '*' then
begin
for Count := 0 to Clients.Count - 1 do
begin
Client := TSimpleClient(Clients[Count]);
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end
else
begin
for Count := 0 to Clients.Count - 1 do
begin
Client := TSimpleClient(Clients[Count]);
if Client.GUID = sToWho then
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;
end;
if Com = 'SYSCMD' then
begin
//get the id and send to that client
sToWho := MidStr(Msg,1,Pos('~',Msg) - 1 );
Msg := Trim(MidStr(Msg,Pos('~',Msg) + 1, 9999));
Msg := '#SYSCMD:' + sToWho + '~' + Msg;
if sToWho = '*' then
begin
for Count := 0 to Clients.Count - 1 do
begin
Client := TSimpleClient(Clients[Count]);
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end
else
begin
for Count := 0 to Clients.Count - 1 do
begin
Client := TSimpleClient(Clients[Count]);
if Client.GUID = sToWho then
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;
end;
end;
end;
procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String );
var
Count: Integer;
List : TList;
EMote,
Msg : String;
begin
Msg := Trim(TheMessage);
EMote := Trim(memEMotes.Lines.Values[Msg]);
if WhoFrom <> 'System' then Msg := WhoFrom + ': ' + Msg;
if EMote <> '' then Msg := Format(Trim(EMote), [WhoFrom]);
List := tcpServer.Threads.LockList;
try
for Count := 0 to List.Count -1 do
try
TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg);
except
TIdPeerThread(List.Items[Count]).Stop;
end;
finally
tcpServer.Threads.UnlockList;
end;
end;
procedure TfrmMain.btnClientsClick(Sender: TObject);
begin
UpdateClientList;
end;
procedure TfrmMain.btnPMClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Private Message', 'What is the message', '');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and (lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
end;
end;
procedure TfrmMain.btnKillClientClick(Sender: TObject);
var
Msg : String;
Client : TSimpleClient;
begin
Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect',
'');
Msg := Trim(Msg);
Msg := edSyopName.Text + '> ' + Msg;
if (Msg <> '') and (lbClients.ItemIndex <> -1) then
begin
Client := Clients.Items[lbClients.ItemIndex];
TIdPeerThread(Client.Thread).Connection.WriteLn(Msg);
TIdPeerThread(Client.Thread).Connection.Disconnect;
Clients.Delete(lbClients.ItemIndex);
lbClients.Items.Delete(lbClients.ItemIndex);
end;
end;
procedure TfrmMain.lbClientsClick(Sender: TObject);
var
Client : TSimpleClient;
begin
btnPM.Enabled := lbClients.ItemIndex <> -1;
btnKillClient.Enabled := btnPM.Enabled;
if lbClients.ItemIndex = -1 then exit;
Client := Clients.Items[lbClients.ItemIndex];
lblClientName.Caption := Client.Name;
lblClientDNS.Caption := Client.DNS;
lblClientIP.Caption := Client.IP;
lblClientFullName.Caption := Client.FullName;
lblClientMachineName.Caption := Client.MachineName;
lblClientGUID.Caption := Client.GUID;
lblClientNickName.Caption := Client.ClientNickName;
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
AddIcon;
Refresh;
Application.ProcessMessages;
end;
procedure TfrmMain.Show2Click(Sender: TObject);
begin
self.Show;
end;
procedure TfrmMain.Shutdown1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
self.Hide;
CanClose := false;
end;
procedure TfrmMain.AddIcon;
begin
with FIconData do
begin
cbSize := SizeOf(FIconData);
Wnd := Self.Handle;
uID := $DEDB;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
hIcon := Forms.Application.Icon.Handle;
uCallbackMessage := WM_APPSERVERICON;
StrCopy(szTip, PChar(Caption));
end;
Shell_NotifyIcon(NIM_Add, @FIconData);
end;
procedure TfrmMain.Initialize(FromService: boolean);
begin
FTaskMessage := RegisterWindowMessage('LicenseServerCreated');
end;
procedure TfrmMain.UIInitialize(var Message: TMessage);
begin
Initialize(Message.WParam <> 0);
end;
procedure TfrmMain.WMAPPSERVERIcon(var Message: TMessage);
var
pt: TPoint;
begin
case Message.LParam of
WM_RBUTTONUP:
begin
// if not Visible then
if true then
begin
SetForegroundWindow(Handle);
GetCursorPos(pt);
pmIcon.Popup(pt.x, pt.y);
end
else SetForegroundWindow(Handle);
end;
WM_LBUTTONDBLCLK: Show2Click(nil);
end;
end;
procedure TfrmMain.WndProc(var Message: TMessage);
begin
if Message.Msg = FTaskMessage then
begin
AddIcon;
Refresh;
end;
inherited WndProc(Message);
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @FIconData);
end;
"Remy Lebeau (TeamB)" <no.spam@no.spam.com> wrote in message
news:44888c5f$1@newsgroups.borland.com...
>
> "brandon" <someone@microsoft.com> wrote in message
> news:448887fc$1@newsgroups.borland.com...
>
>> The server is actually the Indy sample that came with Delphi 6. I did
>> little or no modifiaction to the server sample that was shipped.
>> The client was also based on the Indy sample. I have made modification
>> to to it only to handle different message types (Private, Global,
> Internal...)
>
> I don't have the samples onhand. Please just show the offending code.
>
>> The actual error appears to be that when a client session terminates in
>> an "unclean" manner, the server becomes unstatble. By that I mean, it
>> appears that the next user to attempt to connect gets the "Socket Error #
> 0"
>> message.
>
> That is very unlikely. Every client has its own unique socket endpoint in
> the server. Even if one client did crash, or otherwise got disconnected
> abnormally, the other clients would not be effected. Unless the network
> itself is having problems, that is.
>
>> Starting at the botom of the call stack and working up, the first line of
>> code that belongs to me is line 213:
>> if not IdTCPClient1.Connected then IdTCPClient1.Connect(10);
>> As stated above, it appears that the server has become unstable when a
> user
>> terminates the session without allowing the application to issue a clean
>> disconnect. Subsequent attempts by the offending user or other users
>> attempting to attach to the server raise the connection error at the
> client
>> end.
>
> That is not what the call stack was showing. But again, you did not show
> the COMPLETE call stack.
>
>> I am only speculating with regard to the server being "unstable", it
>> is only an observation of a person with limited exposure to Indy.
>
> Did you try connecting to the server with any non-Indy clients? The
> Telnet
> client that is built into Windows is useful for debugging.
>
>> There are no error messages at the server when the clients receive the
> error.
>
> Are any of the server events being triggered?
>
>> There is a listbox at the server that shows which users are logged into
>> the server
>
> Updating the UI from inside TIdTCPServer event handlers is not
> thread-safe,
> unless TThread.Synchronize() or TIdSync.Synchronize() are being used.
>
>
> Gambit
