unit MultiChannel_ServerMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, uROClientIntf, SyncObjs, uROBPDXHTTPServer, uROBPDXTCPServer, uROIndyUDPServer, uROSuperTCPServer, uROIndyTCPServer, uROIndyHTTPServer, uRONamedPipeServer, uROClient, uROServer, uROWinMessageServer, uROBinMessage, StdCtrls, uROPoweredByRemObjectsButton; type TMultiChannel_ServerMainForm = class(TForm) ROPoweredByRemObjectsButton1: TROPoweredByRemObjectsButton; ROBinMessage: TROBinMessage; WinMessageServer: TROWinMessageServer; NamedPipeServer: TRONamedPipeServer; IndyHTTPServer: TROIndyHTTPServer; IndyTCPServer: TROIndyTCPServer; SuperTcpServer: TROSuperTcpServer; IndyUDPServer: TROIndyUDPServer; BPDXTCPServer: TROBPDXTCPServer; BPDXHTTPServer: TROBPDXHTTPServer; Memo: TMemo; cbIndyHTTPServer: TCheckBox; cbBPDXHttpServer: TCheckBox; cbSuperTcpServer: TCheckBox; cbIndyTcpServer: TCheckBox; cbBPDXTcpServer: TCheckBox; cbIndyUdpServer: TCheckBox; cbNamedPipeServer: TCheckBox; cbWinMessageServer: TCheckBox; ErrorMemo: TMemo; procedure ROBinMessageInitializeMessage(Sender: TROMessage; const aTransport: IROTransport; const anInterfaceName, aMessageName: string); procedure stub(aStream: TStream); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure cbIndyHTTPServerClick(Sender: TObject); procedure cbBPDXHttpServerClick(Sender: TObject); procedure cbSuperTcpServerClick(Sender: TObject); procedure cbIndyTcpServerClick(Sender: TObject); procedure cbBPDXTcpServerClick(Sender: TObject); procedure cbLocalServerClick(Sender: TObject); procedure cbIndyUdpServerClick(Sender: TObject); procedure cbNamedPipeServerClick(Sender: TObject); procedure cbWinMessageServerClick(Sender: TObject); procedure EmailServerException(aSender: TObject; aExceptionClass: TClass; const aExceptionMessage: string); private { Private declarations } CriticalSection: tCriticalSection; procedure ActivateServer(Server: TROServer; Mode: Boolean); public procedure Log(Astr: string); { Public declarations } end; var MultiChannel_ServerMainForm: TMultiChannel_ServerMainForm; implementation uses Dialogs; {$R *.dfm} procedure TMultiChannel_ServerMainForm.Log(Astr: string); begin CriticalSection.Enter; try Memo.Lines.Add(Astr); finally CriticalSection.Leave; end; end; procedure TMultiChannel_ServerMainForm.ROBinMessageInitializeMessage( Sender: TROMessage; const aTransport: IROTransport; const anInterfaceName, aMessageName: string); begin Log('Connect via ' + Tobject(aTransport.GetTransportObject).ClassName); Log(anInterfaceName + ':'#9 + StringReplace(aMessageName, 'Response', '', [])); Log(''); end; procedure TMultiChannel_ServerMainForm.stub(aStream: TStream); begin // stub for prevention of a error end; procedure TMultiChannel_ServerMainForm.FormCreate(Sender: TObject); begin CriticalSection := TCriticalSection.Create; end; procedure TMultiChannel_ServerMainForm.FormDestroy(Sender: TObject); begin CriticalSection.Free; end; procedure TMultiChannel_ServerMainForm.cbIndyHTTPServerClick( Sender: TObject); begin ActivateServer(IndyHTTPServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbBPDXHttpServerClick( Sender: TObject); begin ActivateServer(BPDXHttpServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbSuperTcpServerClick( Sender: TObject); begin ActivateServer(SuperTcpServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbIndyTcpServerClick( Sender: TObject); begin ActivateServer(IndyTcpServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbBPDXTcpServerClick( Sender: TObject); begin ActivateServer(BPDXTcpServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbLocalServerClick(Sender: TObject); begin Log('This server can be tested only on client side.') end; procedure TMultiChannel_ServerMainForm.cbIndyUdpServerClick( Sender: TObject); begin ActivateServer(IndyUdpServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbNamedPipeServerClick( Sender: TObject); begin ActivateServer(NamedPipeServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.cbWinMessageServerClick( Sender: TObject); begin ActivateServer(WinMessageServer, TCheckBox(Sender).Checked); end; procedure TMultiChannel_ServerMainForm.ActivateServer(Server: TROServer; Mode: Boolean); begin Server.Active := Mode; Memo.Visible := WinMessageServer.Active or NamedPipeServer.Active or IndyHTTPServer.Active or IndyTCPServer.Active or SuperTcpServer.Active or IndyUDPServer.Active or BPDXTCPServer.Active or BPDXHTTPServer.Active; ErrorMemo.Visible := not Memo.Visible; if Server.Active then Log(Server.Name + ' is activated!') else Log(Server.Name + ' is deactivated!'); Log(''); end; procedure TMultiChannel_ServerMainForm.EmailServerException( aSender: TObject; aExceptionClass: TClass; const aExceptionMessage: string); begin ShowMessage('There was a problem in the Email Server Thread:'#13#13 + aExceptionClass.ClassName + ': ' + aExceptionMessage); end; end.