Skip to content

Delphi XE2/Lazarus 1.6.2, fpc-3.0.0 backwards compatibility fix #17

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Delphi XE2/Lazarus 1.6.2, fpc-3.0.0 backwards compatibility fix #17

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c7450f2
Delphi XE2 backwards compatibility fix:
delphilite Feb 2, 2017
ebcf211
Lazarus 1.6.2, fpc-3.0.0 backwards compatibility fix:
delphilite Feb 2, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
79 changes: 45 additions & 34 deletions StompClient.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,18 +29,16 @@ interface
StompTypes,
SysUtils,
DateUtils,

SyncObjs,
{$IFNDEF USESYNAPSE}
IdTCPClient,
IdException,
IdExceptionCore,
IdHeaderList,
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, // SSL
System.SyncObjs,
{$ELSE}
synsock,
blcksock,

{$ENDIF}
Classes;

Expand All @@ -51,6 +49,16 @@ interface

THeartBeatThread = class;

{$IFDEF USESYNAPSE}
IIdString = AnsiString;
{$ELSE}
{$IF CompilerVersion < 24}
IIdString = AnsiString;
{$ELSE}
IIdString = string;
{$IFEND}
{$ENDIF}

TStompClient = class(TInterfacedObject, IStompClient)
private

Expand Down Expand Up @@ -91,7 +99,7 @@ TStompClient = class(TInterfacedObject, IStompClient)
FConnectionTimeout: UInt32;
FOutgoingHeartBeats: Int64;
FIncomingHeartBeats: Int64;
FLock: TObject;
FLock: TCriticalSection;
FHeartBeatThread: THeartBeatThread;
FServerIncomingHeartBeats: Int64;
FServerOutgoingHeartBeats: Int64;
Expand Down Expand Up @@ -122,7 +130,7 @@ TStompClient = class(TInterfacedObject, IStompClient)
function ServerSupportsHeartBeat: boolean;
procedure OnHeartBeatErrorHandler(Sender: TObject);
procedure DoHeartBeatErrorHandler;
procedure OpenSSLGetPassword(var Password: String);
procedure OpenSSLGetPassword(var Password: IIdString);
public
Function SetUseSSL(const boUseSSL: boolean;
const KeyFile : string =''; const CertFile : string = '';
Expand Down Expand Up @@ -197,36 +205,33 @@ TStompClient = class(TInterfacedObject, IStompClient)
THeartBeatThread = class(TThread)
private
FStompClient: TStompClient;
FLock: TObject;
FLock: TCriticalSection;
FOutgoingHeatBeatTimeout: Int64;
FOnHeartBeatError: TNotifyEvent;
protected
procedure Execute; override;
procedure DoHeartBeatError;
public
constructor Create(StompClient: TStompClient; Lock: TObject;
constructor Create(StompClient: TStompClient; Lock: TCriticalSection;
OutgoingHeatBeatTimeout: Int64); virtual;
property OnHeartBeatError: TNotifyEvent read FOnHeartBeatError write FOnHeartBeatError;
end;

implementation

{$IFDEF FPC}


const
CHAR0 = #0;

{$ELSE}


uses
// Windows, // Remove windows unit for compiling on ios
{$IFDEF USESYNAPSE}
synautil;
{$ELSE}
IdGlobal,
IdGlobalProtocols,
Character, Winapi.Windows;
IdGlobalProtocols;
{$ENDIF}

{$IFDEF USESYNAPSE}
const
CHAR0 = #0;
{$ENDIF}

{ TStompClient }

procedure TStompClient.AbortTransaction(const TransactionIdentifier: string);
Expand Down Expand Up @@ -356,7 +361,11 @@ procedure TStompClient.Connect(Host: string; Port: Integer; ClientID: string;
FIOHandlerSocketOpenSSL.OnGetPassword := OpenSSLGetPassword;
FIOHandlerSocketOpenSSL.Port := 0 ;
FIOHandlerSocketOpenSSL.DefaultPort := 0 ;
{$IF CompilerVersion < 24}
FIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1; //sslvTLSv1_2; //sslvSSLv3; //sslvSSLv23;
{$ELSE}
FIOHandlerSocketOpenSSL.SSLOptions.Method := sslvTLSv1_2; //sslvSSLv3; //sslvSSLv23;
{$IFEND}
FIOHandlerSocketOpenSSL.SSLOptions.KeyFile := FsslKeyFile;
FIOHandlerSocketOpenSSL.SSLOptions.CertFile := FsslCertFile;
FIOHandlerSocketOpenSSL.SSLOptions.Mode := sslmUnassigned; //sslmClient;
Expand Down Expand Up @@ -454,7 +463,7 @@ class function TStompClient.CreateAndConnect(Host: string; Port: Integer;
constructor TStompClient.Create;
begin
inherited;
FLock := TObject.Create;
FLock := TCriticalSection.Create;
FInTransaction := False;
FSession := '';
FUserName := 'guest';
Expand Down Expand Up @@ -638,9 +647,9 @@ procedure TStompClient.OnHeartBeatErrorHandler(Sender: TObject);
DoHeartBeatErrorHandler;
end;

procedure TStompClient.OpenSSLGetPassword(var Password: String);
procedure TStompClient.OpenSSLGetPassword(var Password: IIdString);
begin
Password := FsslKeyPass;
Password := IIdString(FsslKeyPass);
end;

procedure TStompClient.ParseHeartBeat(Headers: IStompHeaders);
Expand Down Expand Up @@ -752,14 +761,14 @@ function TStompClient.Receive(ATimeout: Integer): IStompFrame;
FreeEncoding: boolean;
{$ELSE}
Encoding: IIdTextEncoding;
{$ENDIF}
{$IFEND}
begin
Result := nil;
lSBuilder := TStringBuilder.Create(1024 * 4);
try
FTCP.Socket.ReadTimeout := ATimeout;
FTCP.Socket.DefStringEncoding :=
{$IF CompilerVersion < 24}TIdTextEncoding.UTF8{$ELSE}IndyTextEncoding_UTF8{$ENDIF};
{$IF CompilerVersion < 24}TIdTextEncoding.UTF8{$ELSE}IndyTextEncoding_UTF8{$IFEND};

try
lTimestampFirstReadLn := Now;
Expand Down Expand Up @@ -816,19 +825,21 @@ function TStompClient.Receive(ATimeout: Integer): IStompFrame;
Encoding := CharsetToEncoding(Charset);
{$IF CompilerVersion < 24}
FreeEncoding := True;
{$ENDIF}
{$IFEND}
end
else
begin
Encoding := IndyTextEncoding_8Bit();
{$IF CompilerVersion < 24}
Encoding := Indy8BitEncoding();
FreeEncoding := False;
{$ENDIF}
{$ELSE}
Encoding := IndyTextEncoding_8Bit();
{$IFEND}
end;

{$IF CompilerVersion < 24}
try
{$ENDIF}
{$IFEND}
if Headers.IndexOfName('content-length') <> -1 then
begin
// length specified, read exactly that many bytes
Expand All @@ -855,7 +866,7 @@ function TStompClient.Receive(ATimeout: Integer): IStompFrame;
if FreeEncoding then
Encoding.Free;
end;
{$ENDIF}
{$IFEND}
finally
Headers.Free;
end;
Expand Down Expand Up @@ -925,7 +936,7 @@ procedure TStompClient.Send(QueueOrTopicName: string; TextMessage: string;

procedure TStompClient.SendFrame(AFrame: IStompFrame);
begin
TMonitor.Enter(FLock);
FLock.Enter;
Try
if Connected then // Test if error on Socket
begin
Expand All @@ -952,13 +963,13 @@ procedure TStompClient.SendFrame(AFrame: IStompFrame);
{$ENDIF}
end;
Finally
TMonitor.Exit(FLock);
FLock.Leave;
End;
end;

procedure TStompClient.SendHeartBeat;
begin
TMonitor.Enter(FLock);
FLock.Enter;
Try
if Connected then
begin
Expand All @@ -977,7 +988,7 @@ procedure TStompClient.SendHeartBeat;
{$ENDIF}
end;
Finally
TMonitor.Exit(FLock);
FLock.Leave;
End;
end;

Expand Down Expand Up @@ -1073,7 +1084,7 @@ procedure TStompClient.Unsubscribe(Queue: string; const subscriptionId: string =

{ THeartBeatThread }

constructor THeartBeatThread.Create(StompClient: TStompClient; Lock: TObject;
constructor THeartBeatThread.Create(StompClient: TStompClient; Lock: TCriticalSection;
OutgoingHeatBeatTimeout: Int64);
begin
inherited Create(True);
Expand Down
36 changes: 20 additions & 16 deletions StompTypes.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -247,6 +247,11 @@ TReceiverThread = class(TThread)
private
FStompClient: IStompClient;
FStompClientListener: IStompClientListener;
FReceiveFrame: IStompFrame;
FTerminateListener: Boolean;
private
procedure DoListenerMessage;
procedure DoListenerStopped;
protected
procedure Execute; override;
public
Expand Down Expand Up @@ -660,28 +665,27 @@ constructor TReceiverThread.Create(StompClient: IStompClient;
FStompClientListener := StompClientListener;
end;

procedure TReceiverThread.DoListenerMessage;
begin
FStompClientListener.OnMessage(FReceiveFrame, FTerminateListener);
end;

procedure TReceiverThread.DoListenerStopped;
begin
FStompClientListener.OnListenerStopped(FStompClient);
end;

procedure TReceiverThread.Execute;
var
LFrame: IStompFrame;
LTerminateListener: Boolean;
begin
LTerminateListener := False;
while (not Terminated) and (not LTerminateListener) do
FTerminateListener := False;
while (not Terminated) and (not FTerminateListener) do
begin
if FStompClient.Receive(LFrame, 1000) then
if FStompClient.Receive(FReceiveFrame, 1000) then
begin
TThread.Synchronize(nil,
procedure
begin
FStompClientListener.OnMessage(LFrame, LTerminateListener);
end);
TThread.Synchronize(nil, DoListenerMessage);
end;
end;
TThread.Synchronize(nil,
procedure
begin
FStompClientListener.OnListenerStopped(FStompClient);
end);
TThread.Synchronize(nil, DoListenerStopped);
end;

end.