TServerSocket - TClientSocket Issue - Code from Delphi 7 from 2010

[mtjmohr 4]

Hello,

 

I am having an issue to rebuild Delphi 7 sources from 2010 I tried to start to use again and develop further. Two experienced Delphi coders at that time cooperatively coded a piece of software which was to be used as an HL7-Server based on listening to a socket (alternatively, I have a file-based version, too, but this one is not in use and - apart from that - does not create issues rebuilding.

 

Four days to re-enable the development environment from then, I have had the same rebuilding results of an access violation which points me to a problem within the TServerSocket and TClientSocket port access (3000): Windows 10 Pro latest - Embarcadero 10.3.3 Community Edition | Windows XP SP3 under VMware Workstation 16 - CodeGear RAD Studio Enterprise Delphi 2007 | Windows XP SP3 under VMware Workstation 16 - Borland Delphi 7 Enterprise.

 

The *,exe file depends on one single *.dll file. The original compiled version from 2010 works flawlessly under various Windows Server versions (from 2003, 2008, 2012, and 2016). Basically, a third party data integration server installed in a hospital extracts data from the underlying Clinical Information System, transforms them into HL7 spec. 2.2, 2.3 or 2.5 and then sends such a so-called ADT message to port 3000 to which on the Windows server where my HL7-Server listens to - once it has acknowledged the ADT message's validity, my HL7 server shoves the received data into a MySQL database table for further processing.

 

Either case, when compiling and building the *.exe and the *.dll anew under the mentioned 3 different Delphi flavours, trying to run the program in my own development environment and equally on the server where the 2010 build runs flawlessly, using the same configuration '.ini file, I receive an error message regarding an access violation at a specific error address at the very moment when access to the port 3000 is required.

 

Now, I could display the part of the original source here where I think the problem might originate from, but I would be willing to hand over the entire code if someone would like to help me - the code base is rather small and also well-documented, project files are included as well as the originally built '.exe and the '.dll file

 

Additionally, I must confess that I do not have a lot of experience with any of the Delphi development systems as my coding skills, historically, went into a different direction (LISP, PROLOG, scripting languages, etc.). This is also true for debugging Delphi even if I use EurekaLog (in its various versions [6 and 7]).

 

Therefore, before anyone might tackle the task to help me code-wise, I would like to ask something from your experience:

 

• I have been importing the Packages dclsocket<version_number>.bpl for each environment, respectively, but I do not know whether this has been necessary in the first place; is there an alternative Package with the same naming "TServerSocket" and "TClientSocket", i. e. could it be possible that I need to use a different Package?
• The original Borland Delphi 7 environment was loaded with tons of components as the development of the HL7 server was only part of creating "tumour documentation software" suite. Is it possible to retrospectively see which components, packages etc. had been installed in Delphi from one of the project or any other files which are generated during the compiling and building process?

 

And, if you would be so generous, would anyone like to have a look at the code, try it out, and see where the issue might be?

 

Thank you very much, I really appreciate your help and support.

[Angus Robertson 574]

The main issue updating from Delphi 7 to Delphi 2009 or later is unicode, strings are now two bytes per character, all all TPC/UDP communication is a stream of bytes.  

 

Changing all Striing definitions to AnsiString may work, although that will depend on how TServerSocket was implemented in unicode compilers, never used it myself since I've been using ICS for over 20 years instead.  For project maintenance, I'd just stick to Delphi 7 under Windows 10, it still works today, no benefit in changing compiler unless you plan a lot of new development with new components. 

 

Angus

 

[mtjmohr 4]

Thank you, Angus,

 

I have installed Delphi 7 under Windows 10 Pro, it works, yes, but the issues remain the same, of course. First reason to change to a more recent development system was the wish to develop a 64-bit application, too, and maybe to create a Windows service instead of a mere application.

 

Apart from " Changing all Striing definitions to AnsiString" - any other idea what I could do?

[Angus Robertson 574]

Your port access might be blocked by Windows Firewall, which can only be turned off completely on Windows 10 by disabling the service in the registry.  But that should not give an exception, just fail to work. 

 

My comment about AnsiStrings was for unicode compilers, not Delphi 7.  You can write Windows services  in Delphi 7, very few Delphi applications benefit from the extra memory supported by 64-bit. 

 

If it was my project, I'd simply replace those old TCP components with ICS, if you are using only UDP there is nothing complicated.  But the problem may be unrelated to UDP, hard to tell from your description.

 

Angus

[aehimself 396]

What methods is the DLL exporting - more importantly what type of parameters are being exchanged between the DLL and the EXE?

If you are using PChars, doublecheck the allocation: instead of GetMem(pc, Length(inString)) you have to use GetMem(pc, Length(inString) * SizeOf(Char)) because of the Unicode difference @Angus Robertson mentioned.

 

I can confirm that TClientSocket / TServerSocket works fine even in Delphi 10.3, with String or raw (binary) transfer as well - one of my applications were using those before I switched to ICS.

[Remy Lebeau 1397]

9 hours ago, Angus Robertson said:

Changing all Striing definitions to AnsiString may work, although that will depend on how TServerSocket was implemented in unicode compilers

The old Borland socket components do not support Unicode strings.  Some methods were updated to at least accept UnicodeString parameters, but they are not transmitted as Unicode, or even converted to 8bit properly.  So avoid the SendText()/ReceiveText() methods and just use the SendBuf()/ReceiveBuf() methods, doing any string<->byte conversions manually in your own code.

7 hours ago, Angus Robertson said:

If it was my project, I'd simply replace those old TCP components with ICS

Or Indy, which is already pre-installed in the IDE, handles Unicode strings, and even has an HL7 component that can operate as both client and server modes.

[mtjmohr 4]

As I have stated in my initial message, I am not really experienced with coding in Delphi. Therefore, I would prefer to continue with the existing code which - in the past of 2010 and even, as I found out regarding previous versions, before - could be compiled and run ... it runs on any Windows workstation since Windows XP and on any Windows server since version 2000 (I have personally set up the software on all of them throughout time ...).

 

I am using EurkekaLog and maxExcept to help me debugging the issue, and both of them, separately, "tell" me that the access violation error is at a specific address, each time the same, and it seems that this error is thrown every time the port 3000 is opened and closed again (since the error 0x00000044 [port open] and then 0x00000040 [port close] on RAD Studio 2007 on Windows XP SP3 and on RAD Studio 10.3.3 CE on Windows 10 Pro and, alternatively, the error 0x00000034 [port open] and then 0x00000030 [port close] on Windows XP SP3 are identified in relation to the port opening and closing processes at the start and the end of the program). For the development: Another error, not in the form of access violation, is thrown when there is no MSSQL or MySQL on the underlying OS driver defined and accessible - this is not an issue since I do not have either of them defined in my development systems and do know that this error is going away once I have done so.

 

I have on top other instruments to check the execution of the code using various disassemblers and debuggers but do not want to go into the decompiled assembler code for the motive of time.

 

Personally, I think it might have to do something with the port opening and closing issue which I do not experience for other software. My "security" background on the Windows 10 Pro laptop is the very latest version of Kaspersky Total Internet Security. When I do a simple port check whether I can open a server app on port 3000 and communicate with it by means of a bit of Python code, this connection is established.

 

Would it help to give you the source code to be able to check this?

 

I would be very grateful if someone could try to reproduce this issue. The ZIPped package comes with all original source code from 2009 up to 2011 and the necessary units (DCPcrypt, TMailer, RxLib, JEDI jcl and jcvl as well as a separate unit, developed by one of the two original coders, for your convenience of installing).

 

If the answer is yes, then I would give access to the code on my Google Drive (the sources are small and contain various versions of the original EXE and DLL files, but the JEDIx.zip is about 22 MB), all in all about 34 MB. either by posting the link here or sending it to you in a private email, as you please.

 

This "offer" is by no means a new scamming technique or an attempt to plant a malware. I simply would like to go on developing and renewing this system but right now I stumble over that error which I cannot resolve. The software per se is a "socket listener". Its use once again as stated in my initial message to avoid scrolling back:

 

"Basically, a third party data integration server installed in a hospital extracts data from the underlying Clinical Information System, transforms them into HL7 spec. 2.2, 2.3 or 2.5 and then sends such a so-called ADT message to port 3000 to which on the Windows server where my HL7-Server listens to - once it has acknowledged the ADT message's validity, my HL7 server shoves the received data into a MySQL database table for further processing.".

 

Further development here does not merely mean to enrich functionality on the Delphi code side (some of which is already given but commented out) but to enhance the accompanying functionality within my PHP code for the medical data documentation and analysis suite which I have developed since 2010 and is running in several European countries in various flavours. Since the data import from clinical information systems which is what my program does into a secondary system has always been critical regarding finances and data security aspects, clinics and societies documenting are slowly understanding the ease by which this data import can be handled, so there has been new interest in that which, hence, leads me to change and enhance the capabilities of my import software. Thus, I try to follow the course of time and attitudes of people in a personal attempt to make their more and more important documentation work easier.

Just to give you a reason why this entire thing now has become more important than during the last 10 years.

 

Sorry for such a long text but I wanted to give you a little explanation for my addressing you.

Edited January 3, 2021 by mtjmohr

[FPiette 383]

23 minutes ago, mtjmohr said:

the access violation error is at a specific address, each time the same, and it seems that this error is thrown every time the port 3000 is opened and closed again

Is it enough to open and close the port 3000 to get the AV? Of need the data transfer also occur?

24 minutes ago, mtjmohr said:

the error 0x00000044

This is an error code or the address of the access violation? Is the AV a read or a write?

 

Did you run the code under the debugger? If not, do it! The debugger will show you the stack trace which is frequently very interesting to help debugging.

 

If I take your code and rebuild the application (I have the latest Delphi: 10.4.1), do I need something to run it and reproduce the error? Will the error jusy bump to my face immediately?

 

[mtjmohr 4]

Hello, FPiette,

 

it is enough to open and close the port. I have a test-server here in python which does nothing else than listen on port 3000, so it is possible to open this port notwithstanding all Kasperskies etc.

 

0x... is the reading address of the access violation, but to better define it I will produce a screenshot and post it here (see the ensuing screenshots).

 

Yes, I ran the code under the respective product debuggers. I can show you the call stack from "madExcept" here (screenshot) and the lines of code it refers to in System.Win.ScktComp.

 

Running compiling and building the code requires some .pas files, they are all included (as mentioned in my preceding message). The source code is available per so or through *.dpr or *.dproj files. Then, we have been using EurekaLog v6.x to help us coding, now I have been using madExcept 5. My software wants to have an ODBC statement (this can be seen from the source code and the *.ini file from which data are read), but this is not necessary to have since this error goes away when the ODBC definition is set up properly. At the moment, I cannot think of anything more to watch for.

 

And if you were not to use either of these "helpers", then the error should pop up, you can continue the program by acknowledging the error, and then under "Port:", where "3000" should be displayed, there is merely a "-----" to be seen (default value or placeholder when something does not work correctly).

 

The sources contain EVERYTHING, i. e. also the code for producing the DLL file.

 

BTW: I have tried to compile this with RAD Studio 10..3.3 CE, the screenshots will show you what it shows and does not show. Another screenshot, the last one regarding its timestamp, is taken from a live system running on Windows Server 2016 (please follow the timestamps of the screenshots for a timely overview what succeed what). Sorry for the source code comments being in German and my "germanization" for version 4.0.1.0.

Edited January 3, 2021 by mtjmohr

[mtjmohr 4]

Sorry, I forgot one screenshot only available when RD Studio 10.3.3 is open. Here it is. The code shown starts at line 274 of System.Win.ScktComp.

[aehimself 396]

That line is a declaration, which is not executing under any circumstances. An AV can not occur there. The exception is thrown in SetPort:

procedure TAbstractSocket.SetPort(Value: Integer);
begin
  if FPort <> Value then
  begin
    if not (csLoading in ComponentState) and FActive then
      raise ESocketError.CreateRes(@sCantChangeWhileActive);
    FPort := Value;
  end;
end;

I start to wonder... is 0x40 low enough to be a nullpointer exception?

Can you post your FormCreate code?

 

[mtjmohr 4]

Yes, it has to do with SetPort (EurekaLog has given me this result).

 

Here is the code (I hope this is what you mean) from FormMain.pas:

 

unit FormMain;

interface

uses DB, ADODB, Windows, Controls, StdCtrls, ExtCtrls, DCPcrypt2, DCPblockciphers,
  DCPdes, DCPsha1, ScktComp, Classes, Forms, SysUtils, INIFiles, JvDebugHandler,
  //InnopactSystemUtils,
  Graphics, DateUtils, //mMailer,
  IdEMailAddress, AppEvnts, Messages, Dialogs,
  InnopactAppUtils, InnopactDBUtils, InnopactSystemUtils,
  HL7Types, //HL7Functions, HL7DLLIntegration,
  JvComponentBase;

type
  TfrmMain = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    //ServerSocket1: TServerSocket;
    //DCP_sha11: TDCP_sha1;
    //DCP_3des1: TDCP_3des;
    Timer1: TTimer;
    Label1: TLabel;
    LabelServiceStatus: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LabelInserted: TLabel;
    LabelRejected: TLabel;
    Label10: TLabel;
    LabelNotSaved: TLabel;
    LabelProcessedMessages: TLabel;
    Label9: TLabel;
    LabelPort: TLabel;
    Label12: TLabel;
    LabelStatus: TLabel;
    Label14: TLabel;
    LabelADTs: TLabel;
    Label17: TLabel;
    LabelBytesRecievedCaption: TLabel;
    Label19: TLabel;
    LabelBytes: TLabel;
    LabelBytesRecieved: TLabel;
    ButtonQuit: TButton;
    Label22: TLabel;
    LabelReconnect: TLabel;
    Label24: TLabel;
    Label27: TLabel;
    LabelExceptions: TLabel;
    Label26: TLabel;
    LabelA01: TLabel;
    Label31: TLabel;
    LabelA08: TLabel;
    Label33: TLabel;
    LabelP01: TLabel;
    Label32: TLabel;
    LabelDatabaseType: TLabel;
    Label35: TLabel;
    LabelODBCAlias: TLabel;
    LabelBytesSent: TLabel;
    Label2: TLabel;
    LabelR01: TLabel;
    JvDebugHandler1: TJvDebugHandler;
    procedure ButtonQuitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1Listen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    //ServerSocket1: TServerSocket;
    //DCP_sha11: TDCP_sha1;
    //DCP_3des1: TDCP_3des;

    TimeOutFlag: boolean;
    HL7Message: string;
    HeaderDetected, StatusOK: boolean;

    EncryptedDBUsername, EncryptedDBPassword: string;
    FNumBytes: integer;
    FCountExceptions: integer;
    FCountInserted: integer;
    FCountNotSaved: integer;
    FCountA01: integer;
    FCountA04: integer;
    FCountA08: integer;
    FCountP01: integer;
    FCountR01: integer;
    FCountRejected: integer;
    FCountProcessedMessages: integer;
    FNumBytesSent: integer;
    FNumBytesReceived: integer;

    function MakeSQLDate(DatumZeit: TDateTime): string;
    function GetIniFilename: string;
    function GetLogFilename: string;
    procedure SetLabelAnzahl(aLabel : TLabel; aCount : integer);
    procedure SetCountExceptions(const Value: integer);
    procedure SetNumBytes(const Value: integer);
    procedure SetCountA01(const Value: integer);
    //procedure SetCountA04(const Value: integer);
    procedure SetCountA08(const Value: integer);
    procedure SetCountP01(const Value: integer);
    procedure SetCountR01(const Value: integer);
    procedure SetCountInserted(const Value: integer);
    procedure SetCountNotSaved(const Value: integer);
    procedure SetCountProcessedMessages(const Value: integer);
    procedure SetCountRejected(const Value: integer);
    procedure SetNumBytesSent(const Value: integer);
    procedure SetNumBytesReceived(const Value: integer);

    property CountProcessedMessages : integer read FCountProcessedMessages write SetCountProcessedMessages;
    property CountInserted : integer read FCountInserted write SetCountInserted;
    property CountRejected : integer read FCountRejected write SetCountRejected;
    property CountNotSaved : integer read FCountNotSaved write SetCountNotSaved;
    property CountA01 : integer read FCountA01 write SetCountA01;
    //property CountA04 : integer read FCountA04 write SetCountA04;
    property CountA08 : integer read FCountA08 write SetCountA08;
    property CountP01 : integer read FCountP01 write SetCountP01;
    property CountR01 : integer read FCountR01 write SetCountR01;

    property IniFilename: string read GetIniFilename;
    property LogFilename: string read GetLogFilename;
    property CountExceptions : integer read FCountExceptions write SetCountExceptions;
    property NumBytes : integer read FNumBytes write SetNumBytes;
    property NumBytesReceived : integer read FNumBytesReceived write SetNumBytesReceived;
    property NumBytesSent : integer read FNumBytesSent write SetNumBytesSent;
  public
    { Public declarations }
    ServerSocket1: TServerSocket;
    DCP_sha11: TDCP_sha1;
    DCP_3des1: TDCP_3des;
  end;

const
  SoftwareProduct = '';
  ACK_Table = 'hl7_messages';
  NO_ACK_Table = 'hl7_messages_noack';

  StrK_DB = '195asdNJU782XSCDVF986431xsyxuhuztrfrde19735628465987HKOLMXXXYAQERTWSDFGHJNBVFGTREwsawqexykxzxzz42528173928546761949999kJgDcWxXnKLbvfDREplkoRTE45rfds782145682749DFF';
  MailPassword = '3ag$0zvl';
  MailUserId = 'error';
var
  frmMain: TfrmMain;

  ODBCName: string = 'adipositas';
  LogEmailAddress: string = '';
  LogEmailSMTPServer: string = '';
  HL7_Port: Cardinal = 3000;
  DatabaseType: string = 'MySQL';
  ADT_Events: string = 'A01,A08';
  TimeOutReconnect: integer = 4;
  HL7Version: string = 'ANDERE';

implementation

uses HL7DLLIntegration, HL7Functions;

{$R *.dfm}


function TfrmMain.MakeSQLDate(DatumZeit: TDateTime): string;
var dbt : TDBServerType;
begin
  dbt := GetDBServerTypeFromString(DatabaseType);
  Result := SQLDateString(DatumZeit, dbt);
end;

procedure TfrmMain.ButtonQuitClick(Sender: TObject);
begin
  ADOQuery1.Close;
  ADOConnection1.Close;
  Close;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  inf: TIniFile;
  DB_Username, DB_Password: string;
begin
  frmMain.Caption := frmMain.Caption + ' ' + GetApplicationVersion;

  CountProcessedMessages := 0;
  CountInserted := 0;
  CountRejected := 0;
  CountNotSaved := 0;
  CountA01 := 0;
  //CountA04 := 0;
  CountA08 := 0;
  CountP01 := 0;
  NumBytes := 0;
  NumBytesReceived := 0;
  NumBytesSent := 0;
  CountExceptions := 0;

  TimeOutFlag := False;

  if FileExists(INIFileName) then
  begin
    inf := TIniFile.Create(INIFileName);

    try
      ADT_Events := inf.ReadString('Common', 'ADTEvents', ADT_Events);
      DatabaseType := inf.ReadString('Common', 'DatabaseType', DatabaseType);
      EncryptedDBUsername := inf.ReadString('Common', 'DatabaseUsername', EncryptedDBUsername);
      EncryptedDBPassword := inf.ReadString('Common', 'DatabasePassword', EncryptedDBPassword);
      ODBCName := inf.ReadString('Common', 'ODBCName', ODBCName);
      LogEmailAddress := inf.ReadString('Common', 'LogEmailAddress', LogEmailAddress);
      LogEmailSMTPServer := inf.ReadString('Common', 'LogEmailSMTPServer', LogEmailSMTPServer);
      TimeOutReconnect := StrToIntDef(inf.ReadString('Common', 'TimeOutReconnect', IntToStr(TimeOutReconnect)), 4);
      HL7_Port := StrToIntDef(inf.ReadString('HL7-Collector Socket', 'Port', IntToStr(HL7_Port)), 3000);
    except

    end;

    inf.Free;
  end;

  ServerSocket1.Port := 3000;
  //ServerSocket1.Port := 80;
  ServerSocket1.Active := True;

  LabelPort.Caption := IntToStr(HL7_Port);
  LabelADTs.Caption := ADT_Events;

  HeaderDetected := False;

  JvDebugHandler1.LogFileName := GetLogFilename;  // 'OnkoManagerHL7Collector.log';
  JvDebugHandler1.ExceptionLogging := True;

  // ==========================================================================================

  if ADOConnection1.Connected then ADOConnection1.Close;

  if (EncryptedDBUsername <> '') or (EncryptedDBPassword <> '') then
  begin
    if EncryptedDBUsername <> '' then
    begin
      // ------------ Decryption ---------------------------
      DCP_3DES1.InitStr(StrK_DB, TDCP_Sha1);
      DB_Username := DCP_3DES1.DecryptString(EncryptedDBUsername);
      DCP_3DES1.Burn;
      // ---------- End Decryption -------------------------
    end;

    if EncryptedDBPassword <> '' then
    begin
      // ------------ Decryption ---------------------------
      DCP_3DES1.InitStr(StrK_DB, TDCP_Sha1);
      DB_Password := DCP_3DES1.DecryptString(EncryptedDBPassword);
      DCP_3DES1.Burn;
      // ---------- End Decryption -------------------------
    end;

    ADOConnection1.ConnectionString := 'Provider=MSDASQL.1;Password=' + DB_Password + ';Persist Security Info=True;User ID=' + DB_Username + ';Data Source=' + ODBCName;
  end
  else ADOConnection1.ConnectionString := 'Provider=MSDASQL.1;Persist Security Info=False;Data Source=' + ODBCName;

  ADOConnection1.Open;

  if TimeOutReconnect > 0 then
  begin
    Timer1.Enabled := False;
    Timer1.Interval := TimeOutReconnect * 3600000;
    Timer1.Enabled := True;

    LabelReconnect.Caption := 'every ' + IntToStr(TimeOutReconnect) + '  hours.';
  end
  else
  begin
    Timer1.Enabled := False;
    LabelReconnect.Caption := 'Off.';
  end;

  LabelODBCAlias.Caption := ODBCName;
  LabelServiceStatus.Caption := 'Started';
  LabelDatabaseType.Caption := DatabaseType;

  // ==========================================================================================

  HL7ParserSetup(PChar(IniFileName));

  ServerSocket1.Open;
end;

function TfrmMain.GetIniFilename: string;
begin
  Result := GetApplicationDirectory + SoftwareProduct + 'HL7Import.ini';
end;

function TfrmMain.GetLogFilename: string;
begin
  Result := GetApplicationDirectory + SoftwareProduct + 'HL7SocketCollector86.log';
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := (MessageBox(0, 'Möchten Sie das Programm wirklich beenden?', 'Frage', MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) = idYes);
  if CanClose and ServerSocket1.Active then
     ServerSocket1.Close;
end;

procedure TfrmMain.ServerSocket1Accept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LabelStatus.Caption := 'Connection accepted.';
end;

procedure TfrmMain.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LabelStatus.Caption := 'Client connected.';
end;

procedure TfrmMain.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LabelStatus.Caption := 'Client disconnected.';
end;

procedure TfrmMain.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  LabelStatus.Caption := 'Client error !';
end;


procedure TfrmMain.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
const
  StartMsgChar = #11;
  EndMsgChar = #28#13;
  EndSgmChar = #13;

var HL7Msg: THL7Msg;
  MSHPos, END_Pos: Integer;
  HL7_File_Flag, OS_ADT_Flag: boolean;
  Table, ACKMSH_Msg1_6, ACKMSH_Msg7, ACKMSH_Msg8_9, ACKMSH_Msg10, ACKMSH_Msg11, ACKMSH_Msg12, ACKMSA_Msg1_3, ACKMsg: string;
  dtInsert : TDateTime;

  function GoToSegment(pStr: string; Segment: string): integer;
  begin
    Result := Pos(Segment, pStr);
  end;

begin
  LabelStatus.Caption := 'Receiving a HL7 message ...';

  NumBytesReceived := NumBytesReceived + Socket.ReceiveLength;

  HL7Message := HL7Message + Socket.ReceiveText;

  MSHPos := Pos('MSH|', HL7Message);

  if MSHPos <> 0 then
  begin
    HeaderDetected := True; // Received at least a header of message
    LabelStatus.Caption := 'HL7 Header received.';
  end;

  END_Pos := pos(#28#13, HL7Message);

  if END_Pos = 0 then exit;

  if HeaderDetected and (End_Pos <> 0) then // Received a complete message with END-Symbol
  begin
    StatusOK := True;

    if MSHPos > 1 then HL7Message := Copy(HL7Message, MSHPos, END_Pos + 1); //Length(HL7Message));

    HL7_File_Flag := True;

    HL7ParserProcedure(PChar(HL7Message), PChar('DUMMY'));
    HL7Msg.SendApp  := HL7GetSendApp;
    HL7Msg.SendFac1 := HL7GetSendFac1;
    HL7Msg.SendFac2 := HL7GetSendFac2;
    HL7Msg.SendFac3 := HL7GetSendFac3;

    HL7Msg.ReceiApp := HL7GetReceiApp;
    HL7Msg.ReceiFac := HL7GetReceiFac;

    HL7Msg.EventID  := HL7GetEventID;
    HL7Msg.CtrlID   := HL7GetCtrlID;
    HL7Msg.ProcID   := HL7GetProcID;
    HL7Msg.VersID   := HL7GetVersID;

    if Pos(HL7Msg.EventID, ADT_Events) <> 0 then
         OS_ADT_Flag := True
    else OS_ADT_Flag := False;

    if HL7_File_Flag then
    begin
      //if OS_ADT_Flag then
      //begin
        if TimeOutFlag then
        begin
          ADOConnection1.Close;
          ADOConnection1.Open;
        end;

        HL7Msg.PID := HL7GetPID;
        HL7Msg.Nachname := HL7GetNachname;
        HL7Msg.Vorname := HL7GetVorname;
        HL7Msg.Gebdatum := HL7GetGebdatum;

        if HL7Msg.PID <> '' then
        begin
          //ADOQuery1.SQL.Text := 'INSERT INTO hl7_messages (PID, PatName, PatVorname, PatGebdatum, MessageText, ADT, CreateDateTime) VALUES (' + QuotedStr(HL7Msg.PID) + ',' + QuotedStr(HL7Msg.Nachname) + ',' + QuotedStr(HL7Msg.Vorname) + ',' + QuotedStr(HL7Msg.GebDatum) + ',' + QuotedStr(HL7Message) + ',' + QuotedStr(HL7Msg.ADT) + ',' + MySQL_Date(Now) + ')';

          //UPDATE mw 080825: TODO muss hier now genommen werden wegen dem löschen veralteter Nachrichten???
          if HL7GetEventTimestamp <> '' then
             dtInsert := HL7ParseTimeStampValue(HL7GetEventTimestamp)
          else
             dtInsert := now;

          if OS_ADT_Flag then Table := ACK_Table
          else Table := NO_ACK_Table;

          ADOQuery1.SQL.Text := 'INSERT INTO ' + Table + ' (PID, PatName, PatVorname, PatGebdatum, MessageText, ADT, CreateDateTime) VALUES (' +
                                HL7Msg.PID + ',' + QuotedStr(HL7Msg.Nachname) + ',' + QuotedStr(HL7Msg.Vorname) + ',' + QuotedStr(HL7Msg.GebDatum) + ',' + QuotedStr(HL7Message) + ',' + QuotedStr(HL7Msg.EventID) + ',' + MakeSQLDate(dtInsert) + ')';

          try
            ADOQuery1.ExecSQL;

            if HL7Msg.EventID = 'A01' then CountA01 := CountA01 + 1
            else
            //if HL7Msg.EventID = 'A04' then CountA04 := CountA04 + 1
            //else
            if HL7Msg.EventID = 'A08' then CountA08 := CountA08 + 1
            else
            if HL7Msg.EventID = 'P01' then CountP01 := CountP01 + 1
            else
            if HL7Msg.EventID = 'R01' then CountR01 := CountR01 + 1;

            if not OS_ADT_Flag then CountRejected := CountRejected + 1
            else CountInserted := CountInserted + 1;

          except
            StatusOK := False;
            CountNotSaved := CountNotSaved + 1;
          end;
        end
        else
        begin
          StatusOK := False;
          CountNotSaved := CountNotSaved + 1;
        end;

        //raise ERangeError.CreateFmt('%d is not within the valid range of %d..%d', [0,0,0]);  // For Test
        ADOQuery1.SQL.Text := '';
        HL7Message := '';
      //end
      //else
      //begin
      //  CountRejected := CountRejected + 1;
      //  StatusOK := False;
      //end;
    end
    else
    begin
      CountNotSaved := CountNotSaved + 1;
      StatusOK := False;
    end;
  end
  else
  begin
    CountNotSaved := CountNotSaved + 1;
    StatusOK := False;
  end;

  HL7Message := '';

  CountProcessedMessages := CountProcessedMessages + 1;

  HeaderDetected := False;

  LabelStatus.Caption := 'Sending ACK ...';

  ACKMSH_Msg1_6 := 'MSH|^~\&|' + HL7Msg.ReceiApp + '|' + HL7Msg.ReceiFac + '|' + HL7Msg.SendApp + '|' + HL7Msg.SendFac1 + HL7Msg.SendFac2 + HL7Msg.SendFac3 + '|';
  ACKMSH_Msg7 := '|' + HL7GenerateTimeStampValue(now);
  ACKMSH_Msg8_9 := '|ACK^' + HL7Msg.EventID;

  ACKMSH_Msg10 := '|' + '123456';
  ACKMSH_Msg11 := '|' + HL7Msg.ProcID;
  ACKMSH_Msg12 := '|' + HL7Msg.VersID;

  if StatusOK then ACKMSA_Msg1_3 := 'MSA|AA|' + HL7Msg.CtrlID + '|'
  else ACKMSA_Msg1_3 := 'MSA|AR|' + HL7Msg.CtrlID + '|';

  ACKMsg := StartMsgChar + ACKMSH_Msg1_6 + ACKMSH_Msg7 + ACKMSH_Msg8_9 + ACKMSH_Msg10 + ACKMSH_Msg11 + ACKMSH_Msg12 + EndSgmChar + ACKMSA_Msg1_3 + EndSgmChar + EndMsgChar;

  NumBytesSent := NumBytesSent + Socket.SendText(ACKMsg);
  LabelStatus.Caption := 'Listening ...';
end;

procedure TfrmMain.ServerSocket1Listen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LabelStatus.Caption := 'Listening ...';
end;

procedure TfrmMain.SetCountA01(const Value: integer);
begin
  FCountA01 := Value;
  SetLabelAnzahl(LabelA01, Value);
end;

//procedure TfrmMain.SetCountA04(const Value: integer);
//begin
//  FCountA04 := Value;
//  SetLabelAnzahl(LabelA04, Value);
//end;

procedure TfrmMain.SetCountA08(const Value: integer);
begin
  FCountA08 := Value;
  SetLabelAnzahl(LabelA08, Value);
end;

procedure TfrmMain.SetCountExceptions(const Value: integer);
begin
  FCountExceptions := Value;
  SetLabelAnzahl(LabelExceptions, Value);
end;

procedure TfrmMain.SetCountInserted(const Value: integer);
begin
  FCountInserted := Value;
  SetLabelAnzahl(LabelInserted, Value);
end;

procedure TfrmMain.SetCountNotSaved(const Value: integer);
begin
  FCountNotSaved := Value;
  SetLabelAnzahl(LabelNotSaved, Value);
end;

procedure TfrmMain.SetCountP01(const Value: integer);
begin
  FCountP01 := Value;
  SetLabelAnzahl(LabelP01, Value);
end;

procedure TfrmMain.SetCountR01(const Value: integer);
begin
  FCountR01 := Value;
  SetLabelAnzahl(LabelR01, Value);
end;

procedure TfrmMain.SetCountProcessedMessages(const Value: integer);
begin
  FCountProcessedMessages := Value;
  SetLabelAnzahl(LabelProcessedMessages, Value);
end;

procedure TfrmMain.SetCountRejected(const Value: integer);
begin
  FCountRejected := Value;
  SetLabelAnzahl(LabelRejected, Value);
end;

procedure TfrmMain.SetLabelAnzahl(aLabel: TLabel; aCount: integer);
begin
 if aCount = 0 then
   aLabel.Caption := '--'
 else
   aLabel.Caption := IntToStr(aCount);
 aLabel.Refresh;
end;

procedure TfrmMain.SetNumBytes(const Value: integer);
begin
  FNumBytes := Value;
  SetLabelAnzahl(LabelBytes, Value);
end;

procedure TfrmMain.SetNumBytesReceived(const Value: integer);
begin
  FNumBytesReceived := Value;
  SetLabelAnzahl(LabelBytesRecieved, Value);
  NumBytes := NumBytesSent + NumBytesReceived;
end;

procedure TfrmMain.SetNumBytesSent(const Value: integer);
begin
  FNumBytesSent := Value;
  SetLabelAnzahl(LabelBytesSent, Value);
  NumBytes := NumBytesSent + NumBytesReceived;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
  TimeOutFlag := True;
  try
    ADOConnection1.Close;
    ADOConnection1.Open;
  finally
    TimeOutFlag := False;
  end;
end;

end.

One addition:

 

The source describes "ServerSocket1.Port := 3000;". This is just a test. The original code is "ServerSocket1.Port := HL7_Port;".

[Guest]

@mtjmohr By just looking at the stack of the exception and on the AV message you provided i can spot the problem.

 

Here is a sample how to repeat it

 

The problem is clear and your Server is not created yet or worse it been created then freed then nil'ed, 

 

To explain more after nill'ing an AV exception will start to show values like 0x0..044 ( more or less but always will be a multiply of 4 in 32bit and 8 in 64bit) these are the index's of the fields and methods of an object, and they should be relative address to the pointer of the object, so when an object (it is a pointer, right ?) is nil (0000) then these address will start to look like what you see.

 

So track you server creation and destruction by debugger breakpoints or log it !

[aehimself 396]

Is the TServerSocket component placed on the form design time?

 

Because it is in the declaration 3 times, 2 times commented out, finally placed in the "public" section:

  TfrmMain = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    //ServerSocket1: TServerSocket; // one occurrence
  private
    { Private declarations }
    //ServerSocket1: TServerSocket; // one occurrence
 public
    { Public declarations }
    ServerSocket1: TServerSocket; // final occurrence
    DCP_sha11: TDCP_sha1;
    DCP_3des1: TDCP_3des;
  end;

I suspect it's not created automatically.

Delete the component from the form, doublecheck that the public declaration is removed (if no, remove it manually) and put an other component on the form.

 

[mtjmohr 4]

Hello, Kas Ob.,

 

I am here now, as you can see from the screenshot.

 

How can I proceed from here? Especially if you take a look at the source code from my preceding message?

[Guest]

You pasted code while i was writing my diagnose, and now i looked at the code and can see the problem

 

type
  TfrmMain = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    //ServerSocket1: TServerSocket; /// <-------------------------
    //DCP_sha11: TDCP_sha1;
    //DCP_3des1: TDCP_3des;
    Timer1: TTimer;
    Label1: TLabel;
..............
  public
    { Public declarations }
    ServerSocket1: TServerSocket;  /// <-------------------------
    DCP_sha11: TDCP_sha1;
    DCP_3des1: TDCP_3des;
  end;

These are the cause of the bug

the commented line prevented the ServerSocket1 from being created automatically, and by moving it to public you should be managing it manually, in this case you should create it before using it and later destroy it.

[mtjmohr 4]

Here is the design form.

[aehimself 396]

6 minutes ago, mtjmohr said:

Here is the design form.

Yep, socket is not on the form therefore not created automatically. Delete the public declaration and drop one on your form.

 

Edit: on newer Delphi editions TServerSocket and TClientSocket are not available on the palette by default. Do make them appear, go to Component -> Install Package, click on "Add..." and browse for $(BDS)\bin\dclsocketsXXX.bpl.

Depending on your Delphi version, the XXX changes. On 10.4.1, my full path is C:\Program Files (x86)\Embarcadero\Studio\21.0\bin\dclsockets270.bpl

 

After this, you can drop one on your form in Design time.

 

Edit-Edit: If you are wondering, I think this is what happened. As I mentioned, designtime components are not available by default on newer Delphi editions. You started the source in Delphi, it warned you about a component which can not be found and you clicked on Remove. Now, the program would not compile as all ServerSocket1 references are invalid. Then, you manually declared it. The issue is, if it's not on the DFM it's not being created automatically for you.

Edited January 3, 2021 by aehimself

[mtjmohr 4]

I have moved the

//ServerSocket1: TServerSocket;

from the very first placed into the "public" segment as, when saving the file or running it, it always gave me the warning that there is no - in my own words - reference to this and the two other components. A lengthy Google search for the error told me to put these declarations into a private, protected or public section.

 

However, the error code being the reason for the issue described has not changed independent of where I put these three lines.

[Guest]

3 minutes ago, mtjmohr said:

How can I proceed from here? Especially if you take a look at the source code from my preceding message?

Just create it !

 

Just now, aehimself said:

Delete the public declaration and drop one on your form.

Most likely he will not find as it deprecated long time ago.

 

To fix this,

1) leave it as public, means don't change the declaration, ( no comment or uncomment )

2) make sure to create it as first thing in FormCreate

procedure TfrmMain.FormCreate(Sender: TObject);
var
  inf: TIniFile;
  DB_Username, DB_Password: string;
begin
  ServerSocket1 := TServerSocket.Create(Self);  //  <--- add this line
  frmMain.Caption := frmMain.Caption + ' ' + GetApplicationVersion;

 3) Free it in FormDestroy event like the following, the event is not assigned, you need to assign it form to do that use the Object Inspector

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  ServerSocket1.Free;
end;

 

[aehimself 396]

Ehm...

3 minutes ago, Kas Ob. said:

ServerSocket1 := TServerSocket.Create(Self);  //  <--- add this line

 

ServerSocket1.Free;

In a good version, nothing will happen. In a bad version an AV upon closing the application. Either create it with (nil), or don't free it.

Edited January 3, 2021 by aehimself

[mtjmohr 4]

Okay, I had integrated the "dclsocket260.bpl" for RAD Studio 10.3.3 even before but never came to the idea of dropping the component icon onto the form.

 

Can you please tell me how to do that, i. e. where the palette is from which I can take them for dropping them?

[aehimself 396]

Just now, mtjmohr said:

Okay, I had integrated the "dclsocket260.bpl" for RAD Studio 10.3.3 even before but never came to the idea of dropping the component icon onto the form.

 

Can you please tell me how to do that, i. e. where the palette is from which I can take them for dropping them?

Make sure your form is visible in the IDE (you are not viewing the source). Press Ctrl-Alt-P, start typing "ServerSocket" and then press Enter.

[FPiette 383]

8 minutes ago, mtjmohr said:

from the very first placed into the "public" segment as, when saving the file or running it, it always gave me the warning that there is no - in my own words - reference to this and the two other components. A lengthy Google search for the error told me to put these declarations into a private, protected or public section.

 

However, the error code being the reason for the issue described has not changed independent of where I put these three lines.

You opened the form using a Delphi instance that has the socketserver component not installed. Delphi told you that and proposed to remove it or to cancel. You accepted to remove it and moved the declaration. You should have cancelled, closed the form, installed the component and the reopen the form.

 

Now to fix that, you have to remove the declaration from the source and then install the component in the IDE.  Go to Component -> Install Package, click on "Add..." and browse for $(BDS)\bin\dclsocketsXXX.bpl. Depending on your Delphi version, the XXX changes.

 

Once installed, you can now drop a ServerSocket on the form. Unfortunately, any value set in the object inspector are now default. You have lost the values. Having it on the form, it will be created automatically.

 

[mtjmohr 4]

I have commented this out in the the "public" section and uncommented it when it first was declared.

 

But I cannot drop the "TServerSocket" onto the form, I am getting an error: