> Does anyone have a demo project using the IdHL7 Componet supplied in
> Indy 9 that they would be willing to share? Please send any sample code
> to ✉jshahan.com.
Hi Jimmie
I wrote that unit, but I don't have any easy to extract
use of it - all deeply embedded in other products.
these are the dunit tests:
unit IdHL7Tests;
interface
uses
TestFramework,
IdHL7;
type
TIdHL7Tests = class(TTestCase)
Private
FDelay: Integer;
procedure MessageReply(Sender: TObject; Msg: String; var VHandled:
Boolean; var Reply: String);
Protected
procedure Setup; Override;
Published
procedure TestNoConnectionServer;
procedure TestNoConnectionClient;
procedure TestConnection;
procedure TestConnectionLimit;
procedure TestSyncForwards;
procedure TestSyncBackwards;
procedure TestSyncForwards1000;
procedure TestSyncBackwards1000;
procedure TestSingleThread;
procedure TestSingleThreadTimeout;
end;
implementation
uses
{$IFNDEF VER140}
Windows,
{$ENDIF}
SysUtils;
const
TEST_PORT = 20032; // err, we hope that this is unused
{ TIdHL7Tests }
procedure TIdHL7Tests.Setup;
begin
FDelay := 0;
end;
procedure TIdHL7Tests.MessageReply(Sender: TObject; Msg: String; var
VHandled: Boolean; var Reply: String);
begin
VHandled := True;
if FDelay <> 0 then
begin
sleep(FDelay);
end;
reply := Msg + 'Return';
end;
procedure TIdHL7Tests.TestNoConnectionServer;
var
LHl7: TIdHL7;
begin
LHL7 := TIdHL7.Create(NIL);
try
LHL7.Address := '';
LHL7.Port := TEST_PORT; // hopefully this is not listening
LHL7.CommunicationMode := cmSynchronous;
LHL7.IsListener := False;
Check(LHl7.Status = isStopped, 'Status not stopped when stopped');
LHL7.start;
Check(LHl7.Status = isNotConnected, 'Status not connecting when
should be connecting');
sleep(2000);
Check(LHl7.Status = isNotConnected, 'Status not connecting when
should be connecting');
sleep(2000);
Check(LHl7.Status = isNotConnected, 'Status not connecting when
should be connecting');
sleep(2000);
Check(LHl7.Status = isNotConnected, 'Status not connecting when
should be connecting');
finally
FreeAndNil(LHL7);
end;
end;
procedure TIdHL7Tests.TestNoConnectionClient;
var
LHl7: TIdHL7;
begin
LHL7 := TIdHL7.Create(NIL);
try
LHL7.Address := '127.0.0.1';
LHL7.Port := TEST_PORT; // hopefully this is not listening
LHL7.CommunicationMode := cmSynchronous;
LHL7.IsListener := False;
Check(LHl7.Status = isStopped, 'Status not stopped when stopped');
LHL7.start;
Check(LHl7.Status in [isNotConnected, isConnecting,
isWaitReconnect], 'Status not connecting when should be connecting');
sleep(2000);
Check(LHl7.Status in [isNotConnected, isConnecting,
isWaitReconnect], 'Status not connecting when should be connecting');
sleep(2000);
Check(LHl7.Status in [isNotConnected, isConnecting,
isWaitReconnect], 'Status not connecting when should be connecting');
sleep(2000);
Check(LHl7.Status in [isNotConnected, isConnecting,
isWaitReconnect], 'Status not connecting when should be connecting');
finally
FreeAndNil(LHL7);
end;
end;
procedure TIdHL7Tests.TestConnection;
var
LIn: TIdHL7;
LOut: TIdHL7;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.IsListener := False;
LOut.Address := 'localhost';
LOut.Port := TEST_PORT;
LOut.Start;
LIn.WaitForConnection(2000);
Check(LIn.Connected and LOut.Connected);
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestConnectionLimit;
var
LIn: TIdHL7;
LOut, LOut2: TIdHL7;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.ConnectionLimit := 1;
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.Address := 'localhost';
LOut.Port := TEST_PORT;
LOut.IsListener := False;
LOut.Start;
LIn.WaitForConnection(2000);
LOut2 := TIdHL7.Create(NIL);
try
LOut2.CommunicationMode := cmSynchronous;
LOut2.Address := 'localhost';
LOut2.Port := TEST_PORT;
LOut2.IsListener := False;
LOut2.Start;
sleep(500);
Check(LIn.Connected and LOut.Connected and not LOut2.connected);
LOut2.PreStop;
LOut2.Stop;
finally
FreeAndNil(LOut2);
end;
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSyncForwards;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Port := TEST_PORT;
LIn.OnReceiveMessage := MessageReply;
LIn.IsListener := True;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.IsListener := False;
LOut.Address := 'localhost';
LOut.Port := TEST_PORT;
LOut.Start;
LIn.WaitForConnection(2000);
check(LOut.SynchronousSend('test', LMsg) = srOK);
check(LMsg = 'testReturn');
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSyncBackwards;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Address := 'localhost';
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.IsListener := False;
LOut.Port := TEST_PORT;
LOut.Start;
LIn.WaitForConnection(2000);
check(LIn.Connected, 'in not connected');
check(LOut.Connected, 'Out not connected');
LOut.CheckSynchronousSendResult(LOut.SynchronousSend('test',
LMsg), LMsg);
check(LMsg = 'testReturn', 'Msg returned was wrong ("' + LMsg +
'")');
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSyncForwards1000;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
i: Integer;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Port := TEST_PORT;
LIn.OnReceiveMessage := MessageReply;
LIn.IsListener := True;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.IsListener := False;
LOut.Address := 'localhost';
LOut.Port := TEST_PORT;
LOut.Start;
LIn.WaitForConnection(2000);
for i := 0 to 1000 do
begin
check(LOut.SynchronousSend('test' + IntToStr(i), LMsg) = srOK);
check(LMsg = 'test' + IntToStr(i) + 'Return');
end;
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSyncBackwards1000;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
i: Integer;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Address := 'localhost';
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSynchronous;
LOut.IsListener := False;
LOut.Port := TEST_PORT;
LOut.Start;
LIn.WaitForConnection(2000);
for i := 0 to 1000 do
begin
check(LOut.SynchronousSend('test' + IntToStr(i), LMsg) = srOK,
'Message failed to be sent');
check(LMsg = 'test' + IntToStr(i) + 'Return', 'Message was
wrong (expected "test' + IntToStr(i) + 'Return", got "' + LMsg + '")');
end;
LOut.PreStop;
LOut.Stop;
finally
FreeAndNil(LOut);
end;
LIn.PreStop;
LIn.Stop;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSingleThread;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
LResult: TSendResponse;
begin
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSingleThread;
LOut.Address := 'localhost';
LOut.IsListener := False;
LOut.Port := TEST_PORT;
LOut.Start;
LOut.WaitForConnection(2000);
LOut.SendMessage('testsinglethread');
repeat
sleep(20);
LResult := LOut.GetReply(LMsg);
until LResult <> srNone;
check(LResult = srOK, 'Status is wrong');
check(LMsg = 'testsinglethreadReturn', 'Did not recieve message
from responder');
check(LOut.GetReply(LMsg) = srError, 'Status is wrong');
finally
FreeAndNil(LOut);
end;
finally
FreeAndNil(LIn);
end;
end;
procedure TIdHL7Tests.TestSingleThreadTimeout;
var
LIn: TIdHL7;
LOut: TIdHL7;
LMsg: String;
LResult: TSendResponse;
begin
FDelay := 2000;
LIn := TIdHL7.Create(NIL);
try
LIn.CommunicationMode := cmSynchronous;
LIn.Port := TEST_PORT;
LIn.IsListener := True;
LIn.OnReceiveMessage := MessageReply;
LIn.Start;
LOut := TIdHL7.Create(NIL);
try
LOut.CommunicationMode := cmSingleThread;
LOut.Address := 'localhost';
LOut.IsListener := False;
LOut.Port := TEST_PORT;
LOut.TimeOut := 50;
LOut.Start;
LOut.WaitForConnection(2000);
LOut.SendMessage('testsinglethread');
repeat
sleep(20);
LResult := LOut.GetReply(LMsg);
until LResult <> srNone;
check(LResult = srTimeout, 'Status is wrong');
check(LMsg = '', 'received message in error');
finally
FreeAndNil(LOut);
end;
finally
FreeAndNil(LIn);
end;
end;
end.