david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
475 lines
14 KiB
ObjectPascal
475 lines
14 KiB
ObjectPascal
unit MegaDemoServerMain;
|
|
|
|
{ Activate this define if you are using the demo without having Indy installed.
|
|
|
|
Simply click "Ignore" when opening the form to have the Indy components
|
|
remove, set the define and rebuild the demo. }
|
|
|
|
{.$DEFINE NO_INDY}
|
|
{$INCLUDE RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Spin, Buttons, ExtCtrls, SyncObjs,
|
|
|
|
{$IFNDEF NO_INDY}
|
|
IdBaseComponent, IdComponent,
|
|
IdTCPServer, IdHTTPServer, uROIndyTCPServer, uROIndyHTTPServer,
|
|
{$IFDEF RemObjects_INDY10}
|
|
IdContext,
|
|
{$ENDIF}
|
|
|
|
{$ENDIF NO_INDY}
|
|
|
|
uROClient, uROBINMessage, uROClientIntf, uROServer,
|
|
uROBPDXHTTPServer, uROBPDXTCPServer, uROPoweredByRemObjectsButton,
|
|
uROSOAPMessage, uROWinMessageServer, uROEncryption,
|
|
uROPostMessage, uROServerMultiMessage, uROXmlRpcMessage;
|
|
|
|
const
|
|
WM_LOG_MESSAGE = WM_APP + 1;
|
|
|
|
type
|
|
{$IFNDEF NO_INDY}
|
|
{$IFDEF RemObjects_INDY10}
|
|
TIdPeerThread = TIdContext;
|
|
{$ENDIF}
|
|
{$ENDIF NO_INDY}
|
|
TMegaDemoServerMainForm = class(TForm)
|
|
ROBINMessage: TROBinMessage;
|
|
IndyHttpServer: TROIndyHTTPServer;
|
|
Memo: TMemo;
|
|
Label2: TLabel;
|
|
cbUseCompression: TCheckBox;
|
|
WinMessageServer: TROWinMessageServer;
|
|
IndyTcpServer: TROIndyTCPServer;
|
|
ROSOAPMessage: TROSOAPMessage;
|
|
gbHTTP: TGroupBox;
|
|
gbTCP: TGroupBox;
|
|
gbWinMsg: TGroupBox;
|
|
Label1: TLabel;
|
|
seHTTPPort: TSpinEdit;
|
|
seTCPPort: TSpinEdit;
|
|
Label4: TLabel;
|
|
eServerID: TEdit;
|
|
bActivateHTTP: TBitBtn;
|
|
bActivateTCP: TBitBtn;
|
|
bActivateWinMsg: TBitBtn;
|
|
cbWinMsgMsg: TComboBox;
|
|
Label3: TLabel;
|
|
Label6: TLabel;
|
|
cbTCPMsg: TComboBox;
|
|
Label7: TLabel;
|
|
BpdxTcpServer: TROBPDXTCPServer;
|
|
BpdxHttpServer: TROBPDXHTTPServer;
|
|
RoPoweredByRemObjectsButton1: TRoPoweredByRemObjectsButton;
|
|
Label5: TLabel;
|
|
bDeactivateWinMsg: TBitBtn;
|
|
bDeactivateTCP: TBitBtn;
|
|
bDeactivateHTTP: TBitBtn;
|
|
Label13: TLabel;
|
|
Panel2: TPanel;
|
|
rbBpdxHttp: TRadioButton;
|
|
RbIndyHttp: TRadioButton;
|
|
Panel1: TPanel;
|
|
rbBpdxTcp: TRadioButton;
|
|
RbIndyTcp: TRadioButton;
|
|
Label8: TLabel;
|
|
ROSOAPMessage1: TROSOAPMessage;
|
|
ROBINMessage1: TROBINMessage;
|
|
cb_Encrypt: TCheckBox;
|
|
cb_SupportKeepAlive: TCheckBox;
|
|
cbDisableNagle: TCheckBox;
|
|
cbVerbose: TCheckBox;
|
|
ROPostMessage: TROPostMessage;
|
|
ROPostMessage1: TROPostMessage;
|
|
ErrorMemo: TMemo;
|
|
ROServerMultiMessage: TROServerMultiMessage;
|
|
ROXmlRpcMessage: TROXmlRpcMessage;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure IndyHTTPServerConnect(AThread: TIdPeerThread);
|
|
procedure IndyHTTPServerDisconnect(AThread: TIdPeerThread);
|
|
procedure HttpServerAfterServerActivate(Sender: TObject);
|
|
procedure HttpServerAfterServerDeactivate(Sender: TObject);
|
|
procedure cbUseCompressionClick(Sender: TObject);
|
|
procedure bActivateHTTPClick(Sender: TObject);
|
|
procedure bActivateTCPClick(Sender: TObject);
|
|
procedure bActivateWinMsgClick(Sender: TObject);
|
|
procedure cbTCPMsgChange(Sender: TObject);
|
|
procedure cbWinMsgMsgChange(Sender: TObject);
|
|
procedure bDeactivateHTTPClick(Sender: TObject);
|
|
procedure bDeactivateTCPClick(Sender: TObject);
|
|
procedure bDeactivateWinMsgClick(Sender: TObject);
|
|
procedure TcpServerAfterServerActivate(Sender: TObject);
|
|
procedure TcpServerAfterServerDeactivate(Sender: TObject);
|
|
procedure WinMessageServerAfterServerDeactivate(Sender: TObject);
|
|
procedure WinMessageServerAfterServerActivate(Sender: TObject);
|
|
procedure cb_EncryptClick(Sender: TObject);
|
|
procedure cb_SupportKeepAliveClick(Sender: TObject);
|
|
procedure cbDisableNagleClick(Sender: TObject);
|
|
procedure MessageInitializeMessage(Sender: TROMessage;
|
|
const aTransport: IROTransport; const anInterfaceName,
|
|
aMessageName: String);
|
|
private
|
|
|
|
fCritical: TCriticalSection;
|
|
|
|
procedure ActivateGroupBox(iGroupBox: TGroupBox; iActivate: boolean);
|
|
procedure CheckStatus;
|
|
protected
|
|
procedure WMLog(var Message: TMessage); message WM_LOG_MESSAGE;
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure Log(const someText: string);
|
|
|
|
end;
|
|
|
|
var
|
|
MegaDemoServerMainForm: TMegaDemoServerMainForm;
|
|
|
|
implementation
|
|
|
|
uses MegaDemoLibrary_Intf;
|
|
|
|
{$R *.DFM}
|
|
|
|
procedure TMegaDemoServerMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
{$IFDEF NO_INDY}
|
|
rbIndyHttp.Enabled := false;
|
|
rbIndyTcp.Enabled := false;
|
|
{$ENDIF NO_INDY}
|
|
|
|
{$IFNDEF NO_INDY}
|
|
// Necessary for Delphi5 since Object Inspector's limitations
|
|
IndyHTTPServer.IndyServer.DefaultPort := 8099;
|
|
{IndyHTTPServer.IndyServer.OnConnect := IndyHTTPServerConnect;
|
|
IndyHTTPServer.IndyServer.OnDisconnect := IndyHTTPServerDisconnect;}
|
|
|
|
IndyTCPServer.IndyServer.DefaultPort := 8090;
|
|
{IndyTCPServer.IndyServer.OnConnect := IndyHTTPServerConnect;
|
|
IndyTCPServer.IndyServer.OnDisconnect := IndyHTTPServerDisconnect;}
|
|
{$ENDIF NO_INDY}
|
|
|
|
cb_SupportKeepAliveClick(Sender);
|
|
|
|
// Misc
|
|
WinMessageServer.ServerID := LibraryUID;
|
|
|
|
seHTTPPort.Value := IndyHTTPServer.IndyServer.DefaultPort;
|
|
seTCPPort.Value := IndyTCPServer.IndyServer.DefaultPort;
|
|
eServerID.Text := WinMessageServer.ServerID;
|
|
|
|
cbTCPMsg.Items.Clear;
|
|
cbTCPMsg.Items.AddObject('Auto', ROServerMultiMessage);
|
|
cbTCPMsg.Items.AddObject('Bin', ROBINMessage);
|
|
cbTCPMsg.Items.AddObject('Soap', ROSOAPMessage);
|
|
cbTCPMsg.Items.AddObject('Post', ROPOSTMessage);
|
|
cbTCPMsg.Items.AddObject('XmlRpc', ROXmlRpcMessage);
|
|
cbTCPMsg.ItemIndex := 0;
|
|
cbTCPMsgChange(cbTCPMsg);
|
|
|
|
cbWinMsgMsg.Items.AddStrings(cbTCPMsg.Items);
|
|
cbWinMsgMsg.ItemIndex := 0;
|
|
cbWinMsgMsgChange(cbWinMsgMsg);
|
|
|
|
cbUseCompressionClick(cbUseCompression);
|
|
cb_EncryptClick(cb_Encrypt);
|
|
|
|
if (ParamCount > 0) and SameText(ParamStr(1), '/activate') then begin
|
|
Application.ProcessMessages();
|
|
bActivateHTTP.Click;
|
|
bActivateTcP.Click;
|
|
bActivateWinMsg.Click;
|
|
end;
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.Log(const someText: string);
|
|
var
|
|
p: pChar;
|
|
begin
|
|
if not cbVerbose.Checked then Exit;
|
|
|
|
GetMem(p, Length(someText) + 1);
|
|
Move(someText[1], p^, Length(someText) + 1);
|
|
PostMessage(Handle, WM_LOG_MESSAGE, 0, integer(p));
|
|
|
|
{ Access to the VCL may only happen from within the main thread. To allow
|
|
Log to be called from within the Service implementattion, we must ensure
|
|
it's threadsafe.
|
|
|
|
So instread of just addint the log message to the Memo, we'l send a
|
|
PostMessage to the window, which wil then later be handled within the
|
|
main thread.
|
|
|
|
As a side benefit, the secution of the Log doe snot need to wait for this
|
|
logging to happen (as usage of, for example, Synchronize would require),
|
|
which will in turn make the server more respinsible for a simultaneous
|
|
calls. }
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.WMLog(var Message: TMessage);
|
|
var
|
|
p: pChar;
|
|
begin
|
|
try
|
|
p := pChar(Message.LParam);
|
|
Memo.Lines.Add(p);
|
|
Freemem(p);
|
|
except
|
|
on E: Exception do
|
|
Memo.Lines.Add(E.Classname + ': ' + E.Message);
|
|
end;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.IndyHTTPServerConnect(AThread: TIdPeerThread);
|
|
begin
|
|
Log('Client connected')
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.IndyHTTPServerDisconnect(AThread: TIdPeerThread);
|
|
begin
|
|
Log('Client disconnected')
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.ActivateGroupBox(iGroupBox: TGroupBox; iActivate: boolean);
|
|
var
|
|
i, j: integer;
|
|
lPanel: TPanel;
|
|
begin
|
|
for i := 0 to (iGroupBox.ControlCount - 1) do begin
|
|
if not (iGroupBox.Controls[i] is TBitBtn) and
|
|
not (iGroupBox.Controls[i] is TComboBox) and
|
|
not ((iGroupBox.Controls[i] is TLabel) and (TLabel(iGroupBox.Controls[i]).Caption = 'Message:')) then iGroupBox.Controls[i].Enabled := iActivate;
|
|
if (iGroupBox.Controls[i] is TPanel) then begin
|
|
lPanel := TPanel(iGroupBox.Controls[i]);
|
|
for j := 0 to (lPanel.ControlCount - 1) do begin
|
|
lPanel.Controls[j].Enabled := iActivate;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.HttpServerAfterServerActivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbHttp, false);
|
|
Log((Sender as TComponent).Name + ' has been activated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.HttpServerAfterServerDeactivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbHttp, true);
|
|
Log((Sender as TComponent).Name + ' has been deactivated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.TcpServerAfterServerActivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbTcp, false);
|
|
Log((Sender as TComponent).Name + ' has been activated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.TcpServerAfterServerDeactivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbTcp, true);
|
|
Log((Sender as TComponent).Name + ' has been deactivated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.WinMessageServerAfterServerActivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbWinMsg, false);
|
|
Log((Sender as TComponent).Name + ' has been activated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.WinMessageServerAfterServerDeactivate(Sender: TObject);
|
|
begin
|
|
ActivateGroupBox(gbWinMsg, true);
|
|
Log((Sender as TComponent).Name + ' has been deactivated...');
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cbUseCompressionClick(Sender: TObject);
|
|
begin
|
|
ROBINMessage.UseCompression := cbUseCompression.Checked;
|
|
ROBINMessage1.UseCompression := cbUseCompression.Checked;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cbTCPMsgChange(Sender: TObject);
|
|
begin
|
|
with TComboBox(Sender) do begin
|
|
IndyTCPServer.Dispatchers[0].Message := TROMessage(Items.Objects[ItemIndex]);
|
|
BpdxTCPServer.Dispatchers[0].Message := TROMessage(Items.Objects[ItemIndex]);
|
|
end;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cbWinMsgMsgChange(Sender: TObject);
|
|
begin
|
|
with TComboBox(Sender) do
|
|
WinMessageServer.Dispatchers[0].Message :=TROMessage(Items.Objects[ItemIndex]);
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bActivateTCPClick(Sender: TObject);
|
|
begin
|
|
if rbBpdxTcp.Checked then begin
|
|
BpdxTCPServer.BpdxServer.ServerPort := seTCPPort.Value;
|
|
BpdxTCPServer.Active := true;
|
|
bDeactivateTcp.Enabled := false;
|
|
Log('Please note that BPDX Servers cannot be deactivated once they have been activated.' +
|
|
'This is a limitation of the BPDX Library, see the Help topic for this sample for more details.');
|
|
end
|
|
{$IFNDEF NO_INDY}
|
|
else begin
|
|
IndyTCPServer.IndyServer.DefaultPort := seTCPPort.Value;
|
|
IndyTCPServer.Active := true;
|
|
end;
|
|
{$ENDIF NO_INDY}
|
|
|
|
bDeactivateTcp.Visible := true;
|
|
bActivateTcp.Visible := false;
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bDeactivateTCPClick(Sender: TObject);
|
|
begin
|
|
bActivateTcp.Visible := true;
|
|
bDeactivateTcp.Visible := false;
|
|
|
|
BpdxTCPServer.Active := false;
|
|
{$IFNDEF NO_INDY}
|
|
IndyTCPServer.Active := false;
|
|
{$ENDIF NO_INDY}
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bActivateHTTPClick(Sender: TObject);
|
|
begin
|
|
if rbBpdxHttp.Checked then begin
|
|
BpdxHTTPServer.BpdxServer.ServerPort := seHTTPPort.Value;
|
|
BpdxHTTPServer.Active := true;
|
|
bDeactivateHttp.Enabled := false;
|
|
Log('Please note that BPDX Servers cannot be deactivated once they have been activated.' +
|
|
'This is a limitation of the BPDX Library, see the Help topic for this sample for more details.');
|
|
end
|
|
{$IFNDEF NO_INDY}
|
|
else begin
|
|
IndyHTTPServer.IndyServer.DefaultPort := seHTTPPort.Value;
|
|
IndyHTTPServer.Active := true;
|
|
end;
|
|
{$ENDIF NO_INDY}
|
|
|
|
bDeactivateHttp.Visible := true;
|
|
bActivateHttp.Visible := false;
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bDeactivateHTTPClick(Sender: TObject);
|
|
begin
|
|
bActivateHttp.Visible := true;
|
|
bDeactivateHttp.Visible := false;
|
|
|
|
BpdxHTTPServer.Active := false;
|
|
{$IFNDEF NO_INDY}
|
|
IndyHTTPServer.Active := false;
|
|
{$ENDIF NO_INDY}
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bActivateWinMsgClick(Sender: TObject);
|
|
begin
|
|
WinMessageServer.ServerID := eServerID.Text;
|
|
WinMessageServer.Active := true;
|
|
|
|
bDeactivateWinMsg.Visible := true;
|
|
bActivateWinMsg.Visible := false;
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.bDeactivateWinMsgClick(Sender: TObject);
|
|
begin
|
|
bActivateWinMsg.Visible := true;
|
|
bDeactivateWinMsg.Visible := false;
|
|
WinMessageServer.Active := false;
|
|
CheckStatus;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cb_EncryptClick(Sender: TObject);
|
|
var
|
|
lEncryption: TROEncryptionMethod;
|
|
begin
|
|
if cb_Encrypt.Checked then lEncryption := tetDES
|
|
else lEncryption := tetNone;
|
|
|
|
BpdxHttpServer.Encryption.EncryptionMethod := lEncryption;
|
|
BpdxTcpServer.Encryption.EncryptionMethod := lEncryption;
|
|
{$IFNDEF NO_INDY}
|
|
IndyHttpServer.Encryption.EncryptionMethod := lEncryption;
|
|
IndyTcpServer.Encryption.EncryptionMethod := lEncryption;
|
|
{$ENDIF NO_INDY}
|
|
WinMessageServer.Encryption.EncryptionMethod := lEncryption;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cb_SupportKeepAliveClick(Sender: TObject);
|
|
begin
|
|
BpdxHttpServer.SupportKeepAlive := cb_SupportKeepAlive.Checked;
|
|
{$IFNDEF NO_INDY}
|
|
{$IFDEF RemObjects_INDY8}
|
|
// IndyHttpServer.SupportKeepAlive := cb_SupportKeepAlive.Checked;
|
|
IndyHttpServer.KeepAlive := cb_SupportKeepAlive.Checked;
|
|
{$ELSE}
|
|
IndyHttpServer.IndyServer.KeepAlive := cb_SupportKeepAlive.Checked;
|
|
IndyHttpServer.KeepAlive := cb_SupportKeepAlive.Checked;
|
|
{$ENDIF}
|
|
{$ENDIF NO_INDY}
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.cbDisableNagleClick(Sender: TObject);
|
|
begin
|
|
IndyTcpServer.DisableNagle := cbDisableNagle.Checked
|
|
end;
|
|
|
|
constructor TMegaDemoServerMainForm.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fCritical := TCriticalSection.Create;
|
|
end;
|
|
|
|
destructor TMegaDemoServerMainForm.Destroy;
|
|
begin
|
|
fCritical.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.CheckStatus;
|
|
var
|
|
fStatus: Boolean;
|
|
begin
|
|
FStatus :=
|
|
IndyHttpServer.Active or
|
|
IndyTcpServer.Active or
|
|
WinMessageServer.Active or
|
|
BpdxHttpServer.Active or
|
|
BpdxTcpServer.Active;
|
|
if FStatus then begin
|
|
ErrorMemo.Visible := False;
|
|
Memo.Visible := True;
|
|
end
|
|
else begin
|
|
ErrorMemo.Visible := True;
|
|
Memo.Visible := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TMegaDemoServerMainForm.MessageInitializeMessage(
|
|
Sender: TROMessage; const aTransport: IROTransport;
|
|
const anInterfaceName, aMessageName: String);
|
|
begin
|
|
Log('Request via '+Sender.ClassName);
|
|
end;
|
|
|
|
end.
|
|
|