Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-16 08:15:53 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fixes

Browse Source
This commit is contained in:
danieleteti 2016-07-26 17:41:05 +02:00
parent 4a715f66ee
commit f07463ea5a
2 changed files with 23 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
StompClient.pas
View File

@ -87,7 +87,6 @@ type
procedure SendFrame(AFrame: IStompFrame); procedure SendFrame(AFrame: IStompFrame);
function FormatErrorFrame(const AErrorFrame: IStompFrame): string; function FormatErrorFrame(const AErrorFrame: IStompFrame): string;
public public
function GetServerProtocolVersion: string;
function SetPassword(const Value: string): IStompClient; function SetPassword(const Value: string): IStompClient;
function SetUserName(const Value: string): IStompClient; function SetUserName(const Value: string): IStompClient;
function Receive(out StompFrame: IStompFrame; ATimeout: Integer): boolean; overload; function Receive(out StompFrame: IStompFrame; ATimeout: Integer): boolean; overload;
@ -95,8 +94,7 @@ type
function Receive(ATimeout: Integer): IStompFrame; overload; function Receive(ATimeout: Integer): IStompFrame; overload;
procedure Receipt(const ReceiptID: string); procedure Receipt(const ReceiptID: string);
procedure Connect(Host: string = '127.0.0.1'; Port: Integer = DEFAULT_STOMP_PORT; procedure Connect(Host: string = '127.0.0.1'; Port: Integer = DEFAULT_STOMP_PORT;
ClientID: string = ''; AcceptVersion: TStompAcceptProtocol = STOMP_Version_1_0; ClientID: string = ''; AcceptVersion: TStompAcceptProtocol = STOMP_Version_1_0);
VirtualHost: string = '');
procedure Disconnect; procedure Disconnect;
procedure Subscribe(QueueOrTopicName: string; Ack: TAckMode = amAuto; procedure Subscribe(QueueOrTopicName: string; Ack: TAckMode = amAuto;
Headers: IStompHeaders = nil); Headers: IStompHeaders = nil);
@ -119,7 +117,6 @@ type
function GetProtocolVersion: string; function GetProtocolVersion: string;
function GetServer: string; function GetServer: string;
function GetSession: string; function GetSession: string;
function SetCredentials(const UserName: string; const Password: string): IStompClient;
property ReceiptTimeout: Integer read FReceiptTimeout write SetReceiptTimeout; property ReceiptTimeout: Integer read FReceiptTimeout write SetReceiptTimeout;
property Transactions: TStringList read FTransactions; property Transactions: TStringList read FTransactions;
// * Manage Events // * Manage Events
@ -230,9 +227,8 @@ begin
[TransactionIdentifier]); [TransactionIdentifier]);
end; end;
procedure TStompClient.Connect(Host: string = '127.0.0.1'; Port: Integer = DEFAULT_STOMP_PORT; procedure TStompClient.Connect(Host: string; Port: Integer; ClientID: string;
ClientID: string = ''; AcceptVersion: TStompAcceptProtocol = STOMP_Version_1_0; AcceptVersion: TStompAcceptProtocol);
VirtualHost: string = '');
var var
Frame: IStompFrame; Frame: IStompFrame;
begin begin
@ -255,12 +251,8 @@ begin
FClientAcceptProtocolVersion := AcceptVersion; FClientAcceptProtocolVersion := AcceptVersion;
if STOMP_Version_1_1 in [FClientAcceptProtocolVersion] then if STOMP_Version_1_1 in [FClientAcceptProtocolVersion] then
begin begin
// Frame.GetHeaders.Add('heart-beat', '0,1000'); // stomp 1.1 Frame.GetHeaders.Add('heart-beat', '0,1000'); // stomp 1.1
Frame.GetHeaders.Add('accept-version', '1.0,1.1'); // stomp 1.1 Frame.GetHeaders.Add('accept-version', '1.1'); // stomp 1.1
if VirtualHost <> '' then
begin
Frame.GetHeaders.Add('host', VirtualHost);
end;
end; end;
Frame.GetHeaders.Add('login', FUserName).Add('passcode', FPassword); Frame.GetHeaders.Add('login', FUserName).Add('passcode', FPassword);
@ -308,7 +300,7 @@ begin
FUserName := 'guest'; FUserName := 'guest';
FPassword := 'guest'; FPassword := 'guest';
FHeaders := TStompHeaders.Create; FHeaders := TStompHeaders.Create;
FTimeout := 2000; FTimeout := 200;
FReceiptTimeout := FTimeout; FReceiptTimeout := FTimeout;
end; end;
@ -371,11 +363,6 @@ begin
Result := FServer; Result := FServer;
end; end;
function TStompClient.GetServerProtocolVersion: string;
begin
Result := FServerProtocolVersion;
end;
function TStompClient.GetSession: string; function TStompClient.GetSession: string;
begin begin
Result := FSession; Result := FSession;
@ -545,13 +532,11 @@ function TStompClient.Receive(ATimeout: Integer): IStompFrame;
try try
// read command line // read command line
repeat // repeat
//se abilito heart-beat trova sempre #10 e quindi non va mai in timeout s := FTCP.Socket.ReadLn(LF, ATimeout, -1, FTCP.Socket.DefStringEncoding);
s := FTCP.Socket.ReadLn(#10, ATimeout, -1, FTCP.Socket.DefStringEncoding); // until s <> '';
if s = '' then
if FTCP.Socket.ReadLnTimedout then Exit(nil);
Break;
until s <> '';
lSBuilder.Append(s + LF); lSBuilder.Append(s + LF);
// read headers // read headers
@ -602,13 +587,13 @@ function TStompClient.Receive(ATimeout: Integer): IStompFrame;
lSBuilder.Append(s); lSBuilder.Append(s);
end; end;
// frame must still be terminated by a null // frame must still be terminated by a null
FTCP.Socket.ReadLn(#0); FTCP.Socket.ReadLn(#0 + LF);
end end
else else
begin begin
// no length specified, body terminated by frame terminating null // no length specified, body terminated by frame terminating null
s := FTCP.Socket.ReadLn(#0, Encoding); s := FTCP.Socket.ReadLn(#0 + LF, Encoding);
lSBuilder.Append(s); lSBuilder.Append(s);
end; end;
@ -713,12 +698,6 @@ begin
end; end;
function TStompClient.SetCredentials(const UserName,
Password: string): IStompClient;
begin
Result := SetUserName(UserName).SetPassword(Password);
end;
function TStompClient.SetPassword(const Value: string): IStompClient; function TStompClient.SetPassword(const Value: string): IStompClient;
begin begin
FPassword := Value; FPassword := Value;

14
StompTypes.pas
View File

@ -61,14 +61,15 @@ type
procedure SetCommand(const Value: string); procedure SetCommand(const Value: string);
function GetBody: string; function GetBody: string;
procedure SetBody(const Value: string); procedure SetBody(const Value: string);
property Body: string read GetBody write SetBody;
function GetHeaders: IStompHeaders; function GetHeaders: IStompHeaders;
function MessageID: string; function MessageID: string;
function ContentLength: Integer; function ContentLength: Integer;
function ReplyTo: string;
end; end;
IStompClient = interface IStompClient = interface
['{EDE6EF1D-59EE-4FCC-9CD7-B183E606D949}'] ['{EDE6EF1D-59EE-4FCC-9CD7-B183E606D949}']
function GetServerProtocolVersion: string;
function Receive(out StompFrame: IStompFrame; ATimeout: Integer) function Receive(out StompFrame: IStompFrame; ATimeout: Integer)
: Boolean; overload; : Boolean; overload;
function Receive: IStompFrame; overload; function Receive: IStompFrame; overload;
@ -76,8 +77,7 @@ type
procedure Receipt(const ReceiptID: string); procedure Receipt(const ReceiptID: string);
procedure Connect(Host: string = '127.0.0.1'; Port: Integer = 61613; procedure Connect(Host: string = '127.0.0.1'; Port: Integer = 61613;
ClientID: string = ''; ClientID: string = '';
AcceptVersion: TStompAcceptProtocol = STOMP_Version_1_0; AcceptVersion: TStompAcceptProtocol = STOMP_Version_1_0);
VirtualHost: string = '');
procedure Disconnect; procedure Disconnect;
procedure Subscribe(QueueOrTopicName: string; Ack: TAckMode = amAuto; procedure Subscribe(QueueOrTopicName: string; Ack: TAckMode = amAuto;
Headers: IStompHeaders = nil); Headers: IStompHeaders = nil);
@ -97,7 +97,6 @@ type
/// //////////// /// ////////////
function SetPassword(const Value: string): IStompClient; function SetPassword(const Value: string): IStompClient;
function SetUserName(const Value: string): IStompClient; function SetUserName(const Value: string): IStompClient;
function SetCredentials(const UserName: string; const Password: string): IStompClient;
function SetReceiveTimeout(const AMilliSeconds: Cardinal): IStompClient; function SetReceiveTimeout(const AMilliSeconds: Cardinal): IStompClient;
function Connected: Boolean; function Connected: Boolean;
function GetProtocolVersion: string; function GetProtocolVersion: string;
@ -127,6 +126,7 @@ type
const const
MESSAGE_ID: string = 'message-id'; MESSAGE_ID: string = 'message-id';
TRANSACTION: string = 'transaction'; TRANSACTION: string = 'transaction';
REPLY_TO: string = 'reply-to';
/// / /// /
function Add(Key, Value: string): IStompHeaders; overload; function Add(Key, Value: string): IStompHeaders; overload;
function Add(HeaderItem: TKeyValue): IStompHeaders; overload; function Add(HeaderItem: TKeyValue): IStompHeaders; overload;
@ -165,6 +165,7 @@ type
function Output: string; function Output: string;
function MessageID: string; function MessageID: string;
function ContentLength: Integer; function ContentLength: Integer;
function ReplyTo: string;
property Headers: IStompHeaders read GetHeaders write SetHeaders; property Headers: IStompHeaders read GetHeaders write SetHeaders;
end; end;
@ -342,6 +343,11 @@ begin
COMMAND_END; COMMAND_END;
end; end;
function TStompFrame.ReplyTo: string;
begin
Result := self.GetHeaders.Value(TStompHeaders.REPLY_TO);
end;
function TStompFrame.ContentLength: Integer; function TStompFrame.ContentLength: Integer;
begin begin
Result := FContentLength; Result := FContentLength;