mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
Example tested with Apollo 1.5
This commit is contained in:
mottadelli75@gmail.com
parent
0c06cb0b58
commit
5f0b12b98f
48
examples/QueueAck/QueueAck.groupproj
Normal file
48
examples/QueueAck/QueueAck.groupproj
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{BB470B6D-C5BC-4098-A153-1070BFC7248D}</ProjectGuid>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<Projects Include="Receiver\Receiver.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
<Projects Include="SendMessage\SendMessage.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Default.Personality/>
|
||||||
|
</BorlandProject>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Target Name="Receiver">
|
||||||
|
<MSBuild Projects="Receiver\Receiver.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Receiver:Clean">
|
||||||
|
<MSBuild Projects="Receiver\Receiver.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Receiver:Make">
|
||||||
|
<MSBuild Projects="Receiver\Receiver.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="SendMessage">
|
||||||
|
<MSBuild Projects="SendMessage\SendMessage.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="SendMessage:Clean">
|
||||||
|
<MSBuild Projects="SendMessage\SendMessage.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="SendMessage:Make">
|
||||||
|
<MSBuild Projects="SendMessage\SendMessage.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Build">
|
||||||
|
<CallTarget Targets="Receiver;SendMessage"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Clean">
|
||||||
|
<CallTarget Targets="Receiver:Clean;SendMessage:Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Make">
|
||||||
|
<CallTarget Targets="Receiver:Make;SendMessage:Make"/>
|
||||||
|
</Target>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/>
|
||||||
|
</Project>
|
||||||
15
examples/QueueAck/Receiver/Receiver.dpr
Normal file
15
examples/QueueAck/Receiver/Receiver.dpr
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
program Receiver;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Vcl.Forms,
|
||||||
|
ReceiverForm in 'ReceiverForm.pas' {ReceiverMainForm},
|
||||||
|
ThreadReceiver in 'ThreadReceiver.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TReceiverMainForm, ReceiverMainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
149
examples/QueueAck/Receiver/Receiver.dproj
Normal file
149
examples/QueueAck/Receiver/Receiver.dproj
Normal file
@ -0,0 +1,149 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{0DEF043B-A99C-4889-8351-5AB60AD893D1}</ProjectGuid>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<FrameworkType>VCL</FrameworkType>
|
||||||
|
<MainSource>Receiver.dpr</MainSource>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Application</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||||
|
<Base_Win64>true</Base_Win64>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||||
|
<DCC_UsePackage>bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;soaprtl;bindengine;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;IndyCore;fmxase;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
|
||||||
|
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||||
|
<DCC_UsePackage>DBXOdbcDriver;DBXSybaseASEDriver;vclimg;vclactnband;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;DBXDb2Driver;websnap;VclSmp;vcl;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<DCC_UsePackage>RlxDesignPackageXE2Professional;CustomDockForm;vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;DBXSybaseASEDriver;ibxpress;svnui;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;vclactnband;FMXTee;TeeUI;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;OmniThreadLibraryRuntimeXE2;bdertl;adortl;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_Optimize>false</DCC_Optimize>
|
||||||
|
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||||
|
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||||
|
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="ReceiverForm.pas">
|
||||||
|
<Form>ReceiverMainForm</Form>
|
||||||
|
<FormType>dfm</FormType>
|
||||||
|
</DCCReference>
|
||||||
|
<DCCReference Include="ThreadReceiver.pas"/>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">Receiver.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1040</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
<Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k160.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp160.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||||
|
</Excluded_Packages>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Deployment/>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
||||||
BIN
examples/QueueAck/Receiver/Receiver.res
Normal file
BIN
examples/QueueAck/Receiver/Receiver.res
Normal file
Binary file not shown.
125
examples/QueueAck/Receiver/ReceiverForm.dfm
Normal file
125
examples/QueueAck/Receiver/ReceiverForm.dfm
Normal file
@ -0,0 +1,125 @@
|
|||||||
|
object ReceiverMainForm: TReceiverMainForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Receiver Message'
|
||||||
|
ClientHeight = 455
|
||||||
|
ClientWidth = 478
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 66
|
||||||
|
Width = 122
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Message sent from apollo'
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 337
|
||||||
|
Width = 62
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Queue Name'
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 396
|
||||||
|
Height = 52
|
||||||
|
Caption =
|
||||||
|
'This example show how subscribe a queue and after you receive a ' +
|
||||||
|
'message from apollo you can send a ACK message to accept the mes' +
|
||||||
|
'sage or NACK message to refuse the message. If you refuse the me' +
|
||||||
|
'ssage apollo try to send the message to another subscriber conne' +
|
||||||
|
'cted'
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 176
|
||||||
|
Top = 337
|
||||||
|
Width = 95
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Current Message Id'
|
||||||
|
end
|
||||||
|
object Label5: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 202
|
||||||
|
Width = 150
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Stomp Frame Sent and Receive'
|
||||||
|
end
|
||||||
|
object MessageMemo: TMemo
|
||||||
|
Left = 8
|
||||||
|
Top = 85
|
||||||
|
Width = 432
|
||||||
|
Height = 116
|
||||||
|
ScrollBars = ssVertical
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object SubscribeButton: TButton
|
||||||
|
Left = 8
|
||||||
|
Top = 380
|
||||||
|
Width = 129
|
||||||
|
Height = 67
|
||||||
|
Caption = '1 - Subscribe '
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = SubscribeButtonClick
|
||||||
|
end
|
||||||
|
object QueueEdit: TEdit
|
||||||
|
Left = 8
|
||||||
|
Top = 353
|
||||||
|
Width = 129
|
||||||
|
Height = 21
|
||||||
|
TabOrder = 2
|
||||||
|
Text = '/queue/alarm'
|
||||||
|
end
|
||||||
|
object SendAckButton: TButton
|
||||||
|
Left = 176
|
||||||
|
Top = 380
|
||||||
|
Width = 98
|
||||||
|
Height = 31
|
||||||
|
Caption = '2 - Send ACK'
|
||||||
|
TabOrder = 3
|
||||||
|
OnClick = SendAckButtonClick
|
||||||
|
end
|
||||||
|
object SendNackButton: TButton
|
||||||
|
Left = 176
|
||||||
|
Top = 416
|
||||||
|
Width = 98
|
||||||
|
Height = 31
|
||||||
|
Caption = '2 - Send NACK'
|
||||||
|
TabOrder = 4
|
||||||
|
OnClick = SendNackButtonClick
|
||||||
|
end
|
||||||
|
object UnsubscribeButton: TButton
|
||||||
|
Left = 311
|
||||||
|
Top = 380
|
||||||
|
Width = 129
|
||||||
|
Height = 67
|
||||||
|
Caption = '3 - Unsubscribe '
|
||||||
|
TabOrder = 5
|
||||||
|
OnClick = UnsubscribeButtonClick
|
||||||
|
end
|
||||||
|
object MessageIdEdit: TEdit
|
||||||
|
Left = 174
|
||||||
|
Top = 353
|
||||||
|
Width = 266
|
||||||
|
Height = 21
|
||||||
|
TabOrder = 6
|
||||||
|
end
|
||||||
|
object LogMemo: TMemo
|
||||||
|
Left = 8
|
||||||
|
Top = 218
|
||||||
|
Width = 410
|
||||||
|
Height = 117
|
||||||
|
TabOrder = 7
|
||||||
|
end
|
||||||
|
end
|
||||||
117
examples/QueueAck/Receiver/ReceiverForm.pas
Normal file
117
examples/QueueAck/Receiver/ReceiverForm.pas
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
unit ReceiverForm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||||
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, StompClient, StompTypes,
|
||||||
|
ThreadReceiver;
|
||||||
|
|
||||||
|
type
|
||||||
|
TReceiverMainForm = class(TForm)
|
||||||
|
MessageMemo: TMemo;
|
||||||
|
Label1: TLabel;
|
||||||
|
SubscribeButton: TButton;
|
||||||
|
QueueEdit: TEdit;
|
||||||
|
Label2: TLabel;
|
||||||
|
SendAckButton: TButton;
|
||||||
|
SendNackButton: TButton;
|
||||||
|
Label3: TLabel;
|
||||||
|
UnsubscribeButton: TButton;
|
||||||
|
MessageIdEdit: TEdit;
|
||||||
|
Label4: TLabel;
|
||||||
|
LogMemo: TMemo;
|
||||||
|
Label5: TLabel;
|
||||||
|
procedure SubscribeButtonClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure SendNackButtonClick(Sender: TObject);
|
||||||
|
procedure SendAckButtonClick(Sender: TObject);
|
||||||
|
procedure UnsubscribeButtonClick(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
private
|
||||||
|
StompClient: TStompClient;
|
||||||
|
StompFrame: IStompFrame;
|
||||||
|
ThReceiver: TThreadReceiver;
|
||||||
|
procedure BeforeSendFrame(AFrame: IStompFrame);
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
ReceiverMainForm: TReceiverMainForm;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.BeforeSendFrame(AFrame: IStompFrame);
|
||||||
|
begin
|
||||||
|
LogMemo.Lines.Add(AFrame.Output);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
StompClient := TStompClient.Create;
|
||||||
|
try
|
||||||
|
StompClient.Connect;
|
||||||
|
except
|
||||||
|
on e: exception do
|
||||||
|
begin
|
||||||
|
raise Exception.Create('Cannot connect to Apollo server. Run the server and restart the application');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
StompClient.OnBeforeSendFrame := BeforeSendFrame;
|
||||||
|
StompFrame := StompUtils.NewFrame();
|
||||||
|
ThReceiver := TThreadReceiver.Create(True);
|
||||||
|
ThReceiver.StompClient := StompClient;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
ThReceiver.Free;
|
||||||
|
StompClient.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.SendAckButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if MessageIdEdit.Text='' then raise Exception.Create('Specify MessageId');
|
||||||
|
|
||||||
|
if StompClient.Connected then
|
||||||
|
begin
|
||||||
|
StompClient.Ack(MessageIdEdit.Text);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.SendNackButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if MessageIdEdit.Text='' then raise Exception.Create('Specify MessageId');
|
||||||
|
|
||||||
|
if StompClient.Connected then
|
||||||
|
begin
|
||||||
|
StompClient.Nack(MessageIdEdit.Text);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.SubscribeButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if QueueEdit.Text='' then raise Exception.Create('Specify queue name');
|
||||||
|
|
||||||
|
if StompClient.Connected then
|
||||||
|
begin
|
||||||
|
StompClient.Subscribe(QueueEdit.Text,amClientIndividual);
|
||||||
|
//StompClient.Subscribe(QueueEdit.Text,amAuto);
|
||||||
|
ThReceiver.Resume;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TReceiverMainForm.UnsubscribeButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if QueueEdit.Text='' then raise Exception.Create('Specify queue name');
|
||||||
|
|
||||||
|
if StompClient.Connected then
|
||||||
|
begin
|
||||||
|
StompClient.Unsubscribe(QueueEdit.Text);
|
||||||
|
ThReceiver.Suspend;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
108
examples/QueueAck/Receiver/ThreadReceiver.pas
Normal file
108
examples/QueueAck/Receiver/ThreadReceiver.pas
Normal file
@ -0,0 +1,108 @@
|
|||||||
|
unit ThreadReceiver;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
StompClient,
|
||||||
|
StompTypes;
|
||||||
|
|
||||||
|
type
|
||||||
|
TThreadReceiver = class(TThread)
|
||||||
|
private
|
||||||
|
FStompClient: TStompClient;
|
||||||
|
FStompFrame: IStompFrame;
|
||||||
|
procedure SetStompClient(const Value: TStompClient);
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
procedure ReceiveAlarmMemo;
|
||||||
|
procedure UpdateMessageMemo;
|
||||||
|
procedure UpdateMessageIdEdit;
|
||||||
|
constructor Create(CreateSuspended: Boolean); overload;
|
||||||
|
property StompClient: TStompClient read FStompClient write SetStompClient;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{
|
||||||
|
Important: Methods and properties of objects in visual components can only be
|
||||||
|
used in a method called using Synchronize, for example,
|
||||||
|
|
||||||
|
Synchronize(UpdateCaption);
|
||||||
|
|
||||||
|
and UpdateCaption could look like,
|
||||||
|
|
||||||
|
procedure TThreadReceiver.UpdateCaption;
|
||||||
|
begin
|
||||||
|
Form1.Caption := 'Updated in a thread';
|
||||||
|
end;
|
||||||
|
|
||||||
|
or
|
||||||
|
|
||||||
|
Synchronize(
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
Form1.Caption := 'Updated in thread via an anonymous method'
|
||||||
|
end
|
||||||
|
)
|
||||||
|
);
|
||||||
|
|
||||||
|
where an anonymous method is passed.
|
||||||
|
|
||||||
|
Similarly, the developer can call the Queue method with similar parameters as
|
||||||
|
above, instead passing another TThread class as the first parameter, putting
|
||||||
|
the calling thread in a queue with the other thread.
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
uses ReceiverForm;
|
||||||
|
|
||||||
|
{ TThreadReceiver }
|
||||||
|
|
||||||
|
constructor TThreadReceiver.Create(CreateSuspended: Boolean);
|
||||||
|
begin
|
||||||
|
FStompFrame := TStompFrame.Create;
|
||||||
|
inherited Create(CreateSuspended);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TThreadReceiver.Execute;
|
||||||
|
begin
|
||||||
|
NameThreadForDebugging('ThreadReceiver');
|
||||||
|
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
if FStompClient.Receive(FStompFrame,2000) then
|
||||||
|
begin
|
||||||
|
Sleep(100);
|
||||||
|
Synchronize(ReceiveAlarmMemo);
|
||||||
|
Synchronize(UpdateMessageIdEdit);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Synchronize(UpdateMessageMemo);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TThreadReceiver.ReceiveAlarmMemo;
|
||||||
|
begin
|
||||||
|
ReceiverMainForm.MessageMemo.Lines.Add(FStompFrame.Output);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TThreadReceiver.SetStompClient(const Value: TStompClient);
|
||||||
|
begin
|
||||||
|
FStompClient := Value;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TThreadReceiver.UpdateMessageIdEdit;
|
||||||
|
begin
|
||||||
|
ReceiverMainForm.MessageIdEdit.Text := FStompFrame.GetHeaders.Value('message-id');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TThreadReceiver.UpdateMessageMemo;
|
||||||
|
begin
|
||||||
|
ReceiverMainForm.MessageMemo.Lines.Add('Wait Messages....');
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
14
examples/QueueAck/SendMessage/SendMessage.dpr
Normal file
14
examples/QueueAck/SendMessage/SendMessage.dpr
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
program SendMessage;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Vcl.Forms,
|
||||||
|
SendMessageForm in 'SendMessageForm.pas' {SendMessageMainForm};
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TSendMessageMainForm, SendMessageMainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
148
examples/QueueAck/SendMessage/SendMessage.dproj
Normal file
148
examples/QueueAck/SendMessage/SendMessage.dproj
Normal file
@ -0,0 +1,148 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{D1F6D8B1-3F48-4A39-81BC-1D32E822A74A}</ProjectGuid>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<FrameworkType>VCL</FrameworkType>
|
||||||
|
<MainSource>SendMessage.dpr</MainSource>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Application</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||||
|
<Base_Win64>true</Base_Win64>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||||
|
<DCC_UsePackage>bindcompfmx;fmx;rtl;dbrtl;IndySystem;DbxClientDriver;bindcomp;inetdb;DBXInterBaseDriver;DataSnapCommon;DataSnapClient;DataSnapServer;DataSnapProviderClient;xmlrtl;DbxCommonDriver;IndyProtocols;DBXMySQLDriver;dbxcds;soaprtl;bindengine;DBXOracleDriver;CustomIPTransport;dsnap;DBXInformixDriver;IndyCore;fmxase;DBXFirebirdDriver;inet;fmxobj;inetdbxpress;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;IPIndyImpl;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
|
||||||
|
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||||
|
<DCC_UsePackage>DBXOdbcDriver;DBXSybaseASEDriver;vclimg;vclactnband;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;DBXDb2Driver;websnap;VclSmp;vcl;DBXMSSQLDriver;dsnapcon;vclx;webdsnap;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<DCC_UsePackage>RlxDesignPackageXE2Professional;CustomDockForm;vcldbx;frx16;TeeDB;Rave100VCL;vclib;Tee;inetdbbde;DBXOdbcDriver;DBXSybaseASEDriver;ibxpress;svnui;vclimg;frxDB16;intrawebdb_120_160;fmi;fs16;vclactnband;FMXTee;TeeUI;vcldb;bindcompvcl;vcldsnap;vclie;vcltouch;Intraweb_120_160;DBXDb2Driver;websnap;vclribbon;frxe16;VclSmp;fsDB16;vcl;DataSnapConnectors;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;dsnapcon;vclx;webdsnap;svn;OmniThreadLibraryRuntimeXE2;bdertl;adortl;$(DCC_UsePackage)</DCC_UsePackage>
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_Optimize>false</DCC_Optimize>
|
||||||
|
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||||
|
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||||
|
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="SendMessageForm.pas">
|
||||||
|
<Form>SendMessageMainForm</Form>
|
||||||
|
<FormType>dfm</FormType>
|
||||||
|
</DCCReference>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">SendMessage.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1040</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
<Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k160.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\dclofficexp160.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k160.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp160.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
|
||||||
|
</Excluded_Packages>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Deployment/>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
||||||
BIN
examples/QueueAck/SendMessage/SendMessage.res
Normal file
BIN
examples/QueueAck/SendMessage/SendMessage.res
Normal file
Binary file not shown.
86
examples/QueueAck/SendMessage/SendMessageForm.dfm
Normal file
86
examples/QueueAck/SendMessage/SendMessageForm.dfm
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
object SendMessageMainForm: TSendMessageMainForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Send Message'
|
||||||
|
ClientHeight = 333
|
||||||
|
ClientWidth = 426
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 152
|
||||||
|
Top = 285
|
||||||
|
Width = 62
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Queue Name'
|
||||||
|
end
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 5
|
||||||
|
Width = 182
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Type here text of message to be sent'
|
||||||
|
end
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 8
|
||||||
|
Top = 127
|
||||||
|
Width = 150
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Stomp Frame Sent and Receive'
|
||||||
|
end
|
||||||
|
object QueueMemo: TMemo
|
||||||
|
Left = 8
|
||||||
|
Top = 24
|
||||||
|
Width = 410
|
||||||
|
Height = 97
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object SendMessageButton: TButton
|
||||||
|
Left = 8
|
||||||
|
Top = 269
|
||||||
|
Width = 138
|
||||||
|
Height = 56
|
||||||
|
Caption = 'Send Message'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = SendMessageButtonClick
|
||||||
|
end
|
||||||
|
object QueueEdit: TEdit
|
||||||
|
Left = 152
|
||||||
|
Top = 304
|
||||||
|
Width = 266
|
||||||
|
Height = 21
|
||||||
|
TabOrder = 2
|
||||||
|
Text = '/queue/alarm'
|
||||||
|
end
|
||||||
|
object LogMemo: TMemo
|
||||||
|
Left = 8
|
||||||
|
Top = 146
|
||||||
|
Width = 410
|
||||||
|
Height = 117
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object AutomaticSendCheckBox: TCheckBox
|
||||||
|
Left = 220
|
||||||
|
Top = 269
|
||||||
|
Width = 181
|
||||||
|
Height = 17
|
||||||
|
Caption = 'Automatic send every 5 seconds '
|
||||||
|
TabOrder = 4
|
||||||
|
OnClick = AutomaticSendCheckBoxClick
|
||||||
|
end
|
||||||
|
object AutomaticSendTimer: TTimer
|
||||||
|
Enabled = False
|
||||||
|
Interval = 5000
|
||||||
|
OnTimer = AutomaticSendTimerTimer
|
||||||
|
Left = 320
|
||||||
|
Top = 24
|
||||||
|
end
|
||||||
|
end
|
||||||
91
examples/QueueAck/SendMessage/SendMessageForm.pas
Normal file
91
examples/QueueAck/SendMessage/SendMessageForm.pas
Normal file
@ -0,0 +1,91 @@
|
|||||||
|
unit SendMessageForm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||||
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, StompClient, StompTypes,
|
||||||
|
Vcl.ExtCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TSendMessageMainForm = class(TForm)
|
||||||
|
QueueMemo: TMemo;
|
||||||
|
SendMessageButton: TButton;
|
||||||
|
QueueEdit: TEdit;
|
||||||
|
Label1: TLabel;
|
||||||
|
Label2: TLabel;
|
||||||
|
Label3: TLabel;
|
||||||
|
LogMemo: TMemo;
|
||||||
|
AutomaticSendTimer: TTimer;
|
||||||
|
AutomaticSendCheckBox: TCheckBox;
|
||||||
|
procedure SendMessageButtonClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure AutomaticSendTimerTimer(Sender: TObject);
|
||||||
|
procedure AutomaticSendCheckBoxClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
StompClient: TStompClient;
|
||||||
|
procedure BeforeSendFrame(AFrame: IStompFrame);
|
||||||
|
procedure Send;
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
SendMessageMainForm: TSendMessageMainForm;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.AutomaticSendCheckBoxClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if QueueEdit.Text='' then raise Exception.Create('Specify queue name');
|
||||||
|
if QueueMemo.Lines.Text='' then raise Exception.Create('Specify text of message to be sent');
|
||||||
|
if AutomaticSendCheckBox.Checked then AutomaticSendTimer.Enabled := True
|
||||||
|
else AutomaticSendTimer.Enabled := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.BeforeSendFrame(AFrame: IStompFrame);
|
||||||
|
begin
|
||||||
|
LogMemo.Lines.Add(AFrame.Output);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
StompClient := TStompClient.Create;
|
||||||
|
StompClient.OnBeforeSendFrame := BeforeSendFrame;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
StompClient.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.AutomaticSendTimerTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if AutomaticSendCheckBox.Checked then
|
||||||
|
begin
|
||||||
|
AutomaticSendTimer.Enabled := False;
|
||||||
|
Send;
|
||||||
|
AutomaticSendTimer.Enabled := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.Send;
|
||||||
|
begin
|
||||||
|
StompClient.Connect;
|
||||||
|
try
|
||||||
|
StompClient.Send(QueueEdit.Text,QueueMemo.Lines.Text);
|
||||||
|
finally
|
||||||
|
StompClient.Disconnect;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSendMessageMainForm.SendMessageButtonClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if QueueEdit.Text='' then raise Exception.Create('Specify queue name');
|
||||||
|
if QueueMemo.Lines.Text='' then raise Exception.Create('Specify text of message to be sent');
|
||||||
|
Send;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user