Ah, the very source code I also learnt from lol.
Remy will no doubt have some advice for you though - IE about them threads
etc.
In my own server I use an array to keep track of users and threads. Until
recently I thought all was good but recently I've been told that the server
threads could mess up my arrays - now hunting for a way of dealing with it
lol
Gotta give Jeremy Darling credit though, he wrote a good basic demo to get
me started - shame he didn't show how to deal with the thread issue :(
"brandon" <someone@microsoft.com> wrote in message
news:44888e88$1@newsgroups.borland.com...
>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
