1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
| TLog = class(TIdSync)
protected
FMsg: String;
procedure DoSynchronize; override;
public
constructor Create(const AMsg: String);
class procedure AddMsg(const AMsg: String);
end;
procedure TLog.DoSynchronize;
begin
Form2.AddInfoDebugger( 'RECEPTION', FMsg );
end;
class procedure TLog.AddMsg( const AMsg : String );
begin
with Create( AMsg ) do
try
Synchronize;
finally
Free;
end;
end;
constructor TLog.Create( const AMsg : String );
begin
FMsg := AMsg;
inherited Create;
end;
/// TFORM 2 ///
constructor TForm2.Create( AOwner : TComponent );
begin
inherited Create( AOwner );
LoadIniConfiguration;
IdTCPServer1.ContextClass := TMyContext;
IdTCPServer1.DefaultPort := IndyServerPort;
DictionaryMessage := TDictionaryMessage.Create;
fSvrClose := False;
if fileexists( SaveFileName )
then
DictionaryMessage.LoadFromFile( SaveFileName );
UpdateListQuestions;
if IndyAutoStart
then
StartStopIndyServer;
// add info state debug save
if DebugConfigState
then
LabelStateDebugSave.Caption :=
'Sauvegarde des journaux sur disque: Activé'
else
LabelStateDebugSave.Caption :=
'Sauvegarde des journaux sur disque: Désactivé';
end;
procedure TForm2.FormClose(
Sender : TObject;
var action : TCloseAction );
var
iA : integer;
Context : TIdContext;
begin
if IdTCPServer1.Active
then
begin
fSvrClose := true;
IdTCPServer1.Active := False;
fSvrClose := False;
end;
end;
// ******
// ******INDY procedures START*******//
// ******
procedure TForm2.StartStopIndyServer;
begin
if not IdTCPServer1.Active
then
begin
IdTCPServer1.Active := true;
Form2.AddInfoDebugger( 'ONLINE',
'Server is now connected and ready to accept clients' );
ListBoxClients.Clear;
ListBoxClients.Items.Add( 'Serveur' );
UpdateCountClients;
Button1.Caption := 'Arret';
end
else
begin
fSvrClose := true;
IdTCPServer1.Active := False;
fSvrClose := False;
ListBoxClients.Clear;
Form2.AddInfoDebugger( 'Offline', 'Server is now disconnected' );
Button1.Caption := 'Démarrer';
UpdateCountClients;
end;
end;
procedure TForm2.tsConnect( AContext : TIdContext );
begin
with TMyContext( AContext ) do
begin
Con := Now;
if ( Connection.Socket <> nil )
then
IP := Connection.Socket.Binding.PeerIP;
Nick := Connection.IOHandler.ReadLn;
if Nick <> ''
then
begin
Connection.IOHandler.WriteLn( 'Welcome ' + Nick + '!' );
ListBoxClients.Items.Add( Nick );
end
else
begin
Connection.IOHandler.WriteLn( 'No Nick provided! Goodbye.' );
Connection.Disconnect;
end;
end;
end;
procedure TForm2.tsExecute( AContext : TIdContext );
var
FMsg, FMSG2, FMSG3, msg, str, toname, filename, cmd, from,
orsender : string;
FStream, fstream2 : TFileStream;
MStream : TMemoryStream;
idx, posi, col : integer;
Name1, Name2, Name3, MainStr : string;
RXStreamRichedit, DictionaryMessageStream : TStringStream;
LStreamSize : int64;
begin
//Empty for test//
end;
procedure TForm2.tsDisconnect( AContext : TIdContext );
begin
AContext.Connection.Socket.InputBuffer.Clear;
AContext.Connection.Disconnect;
TLog.AddMsg( TMyContext( AContext ).Nick + ' Left the chat' );
ListBoxClients.Items.Delete
( ListBoxClients.Items.IndexOf( TMyContext( AContext ).Nick ) );
end; |
Partager