1
0
Files
applications
bindings
components
Comba_Animation
aboutcomponent
acs
beepfp
axl
beepfp
doc
example
BEEP_Client.ico
BEEP_Client.lpi
BEEP_Client.lpr
BEEP_Client.lrs
BEEP_Client.rc
BEEP_Listen.ico
BEEP_Listen.lpi
BEEP_Listen.lpr
BEEP_Listen.lrs
BEEP_Listen.rc
clientmain.lfm
clientmain.lrs
clientmain.pas
listenermain.lfm
listenermain.lrs
listenermain.pas
test
vortex
COPYING.GPL.txt
COPYING.LGPL.txt
COPYING.modifiedLGPL.txt
COPYING.txt
README.txt
makedoc
callite
captcha
chelper
chemtext
cmdline
cmdlinecfg
colorpalette
cryptini
csvdocument
epiktimer
everettrandom
examplecomponent
exctrls
extrasyn
fpexif
fpsound
fpspreadsheet
fractions
freetypepascal
geckoport
gradcontrols
grid_semaphor
industrialstuff
iosdesigner
iphonelazext
jujiboutils
jvcllaz
kcontrols
lazautoupdate
lazbarcodes
lazmapviewer
lclextensions
longtimer
manualdock
mbColorLib
mplayer
multithreadprocs
nvidia-widgets
onguard
orpheus
playsoundpackage
poweredby
powerpdf
rgbgraphics
richmemo
richview
rtfview
rx
scrolltext
smnetgradient
spktoolbar
splashabout
svn
systools
tdi
thtmlport
tparadoxdataset
tvplanit
xdev_toolkit
zlibar
zmsql
examples
image_sources
lclbindings
wst
lazarus-ccr/components/beepfp/example/clientmain.pas

357 lines
9.7 KiB
ObjectPascal
Raw Normal View History

(*******************************************************************************
* ClientMain.pas: Client test application for BeepFp
* Copyright (C) 2009, Wimpie Nortje <wimpienortje@gmail.com>
*
* This file is part of BeepFp.
*
* BeepFp is free software: you can redistribute it and/or modify it under the
* terms of the GNU Lesser General Public License as published by the Free
* Software Foundation, either version 3 of the License, or (at your option)
* any later version.
*
* BeepFp is distributed in the hope that it will be useful, but WITHOUT ANY
* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
* more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with BeepFp. If not, see <http://www.gnu.org/licenses/>.
*
* BeepFp is further covered by a special exception as described in the file
* COPYING.modifiedLGPL.txt which should have been included in the
* distribution. If not, see
* <http://svn.freepascal.org/svn/lazarus/trunk/COPYING.modifiedLGPL.txt>
*******************************************************************************
* This is an example of using TBeepClient class
******************************************************************************)
unit clientmain;
{$mode objfpc}{$H+}
interface
uses
Classes, Spin, StdCtrls, SysUtils, FileUtil, LResources, Forms, Controls,
Graphics, Dialogs,
BeepClient, BeepProfile, BeepConnection, BeepChannel, BeepFrame,
BeepChannelPool;
type
{ TForm1 }
TForm1 = class(TForm)
ButtonClose: TButton;
ButtonOpen: TButton;
ButtonAddPool: TButton;
ButtonSend: TButton;
ButtonDisconnect: TButton;
Button1Connect: TButton;
ButtonSendPool: TButton;
CheckBoxPool: TCheckBox;
CheckBoxCon: TCheckBox;
EditChannel: TEdit;
EditPool: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
SpinEditCh: TSpinEdit;
procedure Button1ConnectClick(Sender: TObject);
procedure ButtonAddPoolClick(Sender: TObject);
procedure ButtonCloseClick(Sender: TObject);
procedure ButtonDisconnectClick(Sender: TObject);
procedure ButtonOpenClick(Sender: TObject);
procedure ButtonSendClick(Sender: TObject);
procedure ButtonSendPoolClick(Sender: TObject);
procedure Chan1Closed(ChanNum: integer);
procedure Chan1Created(ChanNum: integer);
procedure Chan1Failed(ChanNum: integer);
procedure ChanDropped(aBeepChannel: TObject);
procedure ClientConnected(Sender: TBeepConnection);
procedure ClientConnectionFailed(Sender: TBeepConnection; Reason: string);
procedure ClientDisconnected(Sender: TBeepConnection);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PoolCreated(Sender: TObject);
procedure ProfPlainCloseChannel(aConnection: TBeepConnection;
ChanNum: integer; var Accept: boolean);
procedure ProfPlainFrameReceive(aConnection: TBeepConnection;
aChannel: TBeepChannel; aFrame: TBeepFrame);
procedure ProfPlainStartChannel(aConnection: TBeepConnection;
ChanNum: integer; var Accept: boolean);
procedure ProfPoolFrameReceive(aConnection: TBeepConnection;
aChannel: TBeepChannel; aFrame: TBeepFrame);
private
Client: TBeepClient;
public
{ public declarations }
end;
const
PLAIN_PROFILE = 'http://fact.aspl.es/profiles/plain_profile';
POOL_PROFILE = 'http://lazarus/beep/Plain_Profile';
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.Button1ConnectClick(Sender: TObject);
begin
Client.Connect;
end;
procedure TForm1.ButtonAddPoolClick(Sender: TObject);
var
Pool: TBeepChannelPool;
Index: integer = 0;
begin
CheckBoxPool.Checked := false;
//Add a pool
Pool := Client.AddChannelPool(POOL_PROFILE, 3, Index);
//Add event handlers
Pool.OnPoolCreated := @PoolCreated;
//Initialise
Pool.Initialise;
end;
procedure TForm1.ButtonCloseClick(Sender: TObject);
begin
Client.CloseChannel(1);
end;
procedure TForm1.ButtonDisconnectClick(Sender: TObject);
begin
Client.Disconnect;
end;
procedure TForm1.ButtonOpenClick(Sender: TObject);
var
Chan: integer;
NewChan: TBeepChannelInitiator;
begin
Chan := SpinEditCh.Value;
//Add channel
NewChan := Client.AddChannel(Client.Connection, PLAIN_PROFILE, Chan);
//Add optional event handlers
NewChan.OnCreated := @Chan1Created;
NewChan.OnFailed := @Chan1Failed;
NewChan.OnCloseNotify := @Chan1Closed;
NewChan.OnDropped := @ChanDropped;
Client.OpenChannel(Chan);
end;
procedure TForm1.ButtonSendClick(Sender: TObject);
var
ID: integer = 0;
begin
Client.SendMSG(SpinEditCh.Value, PByte(PChar(EditChannel.Text)), length(EditChannel.Text), ID);
end;
procedure TForm1.ButtonSendPoolClick(Sender: TObject);
var
Channel: TBeepChannel;
ID: integer = 0;
begin
//Get next available channel from pool
Channel := Client.GetPoolChannel(0, false);
//Send the message
Channel.SendMSG(EditPool.Text, ID);
end;
procedure TForm1.Chan1Closed(ChanNum: integer);
begin
writeln('Closed channel ' + IntToStr(ChanNum));
end;
procedure TForm1.Chan1Created(ChanNum: integer);
begin
writeln('Opened channel ' + IntToStr(ChanNum));
end;
procedure TForm1.Chan1Failed(ChanNum: integer);
begin
writeln('Failed to open channel ' + IntToStr(ChanNum));
end;
procedure TForm1.ChanDropped(aBeepChannel: TObject);
begin
//
end;
procedure TForm1.ClientConnected(Sender: TBeepConnection);
begin
CheckBoxCon.Checked := true;
writeln('Connected to '+Sender.Host+':'+Sender.Port);
end;
procedure TForm1.ClientConnectionFailed(Sender: TBeepConnection;
Reason: string);
begin
CheckBoxCon.Checked := false;
writeln('Connection failed to '+Sender.Host+':'+Sender.Port);
end;
procedure TForm1.ClientDisconnected(Sender: TBeepConnection);
begin
CheckBoxCon.Checked := false;
writeln('Disconnected from '+Sender.Host+':'+Sender.Port);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
NewProf: TBeepProfile;
begin
{ Steps to prepare a client:
* Create client
* Set host, port
* Set (optional) OnConnected, OnDisconnected, OnConnectionFailed
* Add a profile
* Set for profile (required): OnFrameReceived
* Set for profile (optional): OnStartChannel, OnCloseChannel
* Connect
With open connection:
* Add channel(s)
* Set (optional) OnCreated, OnFailed, OnClosed
* Open channel(s)
* Send MSG, RPY, ANS, ERR
* Add channel pool(s)
* Set (optional) OnPoolCreated
* Initialise pool(s)
* Get a channel
* Send Msg
* Release channel
}
//Create a client
Client := TBeepClient.Create;
//Set host, port
Client.Host := 'localhost';
Client.Port := '44000';
//Add optional event handlers
Client.OnConnected := @ClientConnected;
Client.OnDisconnected := @ClientDisconnected;
Client.OnConnectionFailed := @ClientConnectionFailed;
//Add a profile
NewProf := Client.AddProfile(PLAIN_PROFILE);
//Add required event handler
NewProf.OnFrameReceived := @ProfPlainFrameReceive;
//Add optional event handlers
NewProf.OnStartChannelRequest := @ProfPlainStartChannel;
NewProf.OnCloseChannelRequest := @ProfPlainCloseChannel;
//Add a profile
NewProf := Client.AddProfile(POOL_PROFILE);
//Add required event handler
NewProf.OnFrameReceived := @ProfPoolFrameReceive;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Client.Free;
end;
procedure TForm1.PoolCreated(Sender: TObject);
begin
CheckBoxPool.Checked := true;
writeln('A new channel pool is ready for use');
end;
procedure TForm1.ProfPlainCloseChannel(aConnection: TBeepConnection;
ChanNum: integer; var Accept: boolean);
begin
{ Implement profile requirements to check whether the request to close the
channel should be allowed }
//MemoLog.Lines.Add
writeln
(format('Closing channel %s on connection %s:%s',
[IntToStr(ChanNum),
aConnection.Host,
aConnection.Port]));
{ To close channel, set Accept := true, := false to deny
Default behaviour when this function is not implemented, is to allow all
closure requests }
Accept := true;
end;
procedure TForm1.ProfPlainFrameReceive(aConnection: TBeepConnection;
aChannel: TBeepChannel; aFrame: TBeepFrame);
begin
{ Implement the profile here.
This function must respond to message frames using
- SendRPy
- SendANS
- SendERR
}
//MemoLog.Lines.Add
writeln
(format('A frame received on channel: %d', [aChannel.Number] ) );
//MemoLog.Lines.Add
writeln
(format('Data received: "%s"', [aFrame.PayloadAsString] ) );
end;
procedure TForm1.ProfPlainStartChannel(aConnection: TBeepConnection;
ChanNum: integer; var Accept: boolean);
begin
{ Implement profile requirements to check whether the request for a new
channel should be allowed }
//MemoLog.Lines.Add
writeln
(format('Starting channel %s on connection %s:%s',
[IntToStr(ChanNum),
aConnection.Host,
aConnection.Port]));
{ To allow channel, set Accept := true, := false to deny
Default behaviour when this function is not implemented, is to allow all
channels }
Accept := true;
end;
procedure TForm1.ProfPoolFrameReceive(aConnection: TBeepConnection;
aChannel: TBeepChannel; aFrame: TBeepFrame);
begin
{Profile used for the pool channels}
//MemoLog.Lines.Add
writeln
(format('A frame received on pool channel: %d', [aChannel.Number] ) );
//MemoLog.Lines.Add
writeln
(format('Data received: "%s"', [aFrame.PayloadAsString] ) );
{Release the channel back to the pool}
Client.ReleasePoolChannel(0, aChannel);
end;
initialization
{$I clientmain.lrs}
end.