shineworld

A native VCL, and not Windows-based, TComboBox cotrol. In one application I have hundreds and hundreds of TComboBoxes with values None and then from 1 to 256. I have used many strategies to enter values in these combos but the time required is enormous. The fastest system was to leave them empty, at FormCreate create the fields by hand by searching all TComboBox components ...... and on some PCs it takes almost 3 or more seconds.... // creates components hash and binds component events to code and adds inputs/outputs items C := ComponentCount - 1; for I := 0 to C do begin Component := Components[I]; FComponentsHashManager.Add(Component); if Component is TComboBox then begin with TComboBox(Component) do begin if Pos('InputNum', Name) <> 0 then begin SendMessage(Handle, WM_SETREDRAW, Ord(False), 0); SendMessage(Handle, CB_INITSTORAGE, I_O.MAX_DIGITAL_INPUTS + 1, COMBOBOX_MAX_TEXT_LENGTH * (I_O.MAX_DIGITAL_INPUTS + 1)); for J := 0 to I_O.MAX_DIGITAL_INPUTS do Items.Insert(J, InputsList.Strings[J]); SendMessage(Handle, WM_SETREDRAW, Ord(True), 0); Continue; end; if Pos('OutNum', Name) <> 0 then begin SendMessage(Handle, WM_SETREDRAW, Ord(False), 0); SendMessage(Handle, CB_INITSTORAGE, I_O.MAX_DIGITAL_OUTPUTS + 1, COMBOBOX_MAX_TEXT_LENGTH * (I_O.MAX_DIGITAL_OUTPUTS + 1)); for J := 0 to I_O.MAX_DIGITAL_OUTPUTS do Items.Insert(J, OutputsList.Strings[J]); SendMessage(Handle, WM_SETREDRAW, Ord(True), 0); Continue; end; end; end; ...

Interesting solution.

I've used a TComboBox set as List because arguments start from None, 1, 2 .. 256 and use can fastly move to any using key: However, I guess I to move them to the Edit field and check the entered data as suggested. In the past I've used old SweedControls combobox made by zero with Delphi code but moving to 64bit the old and not supported library does not work fine.

Me to. Updated to 1st of most (I hope) patches 🙂

For the Remote Support, you can choose a lot of tools (AnyDesk, Teamviewer, Supremo, etc.). In recent times a new actor has entered the scene: RustDesk. RustDesk is an open-source project made with Rust. RustDesk covers either client or server. So you can use default open servers or if you have an external server you can place your RusDesk server in your net service. https://github.com/rustdesk/rustdesk I'm used to placing some of them in my software (some customized with annual payment, and rust desk as an open system): End-users can so choose what remote support service prefer to use (and what does not have connection issues at that time).

Hi all. I'm trying to use Skia TSkPaintBox on Athens VCL application. I've enabled Skia in the project. I can use TSkLabel. I can place a TSkPaintBox. And run... But if I try to create the TSkPaintBox Draw event I get this error: [dcc64 Error] Unit1.pas(13): E2003 Undeclared identifier: 'TRectF' [dcc64 Error] Unit1.pas(27): E2005 'TRectF' is not a type identifier [dcc64 Fatal Error] Project1.dpr(5): F2063 Could not compile used unit 'Unit1.pas' Thank you in advance for your answers. Best regards Silverio

I don't know if support Unicode (I guess) but I've used it in past years and was very simple to use: https://www.remobjects.com/ps.aspx

After finishing and testing the configuration to have TLS 1.2 on TIdFTPServer I was asked to add OpenSSL and TLS 1.2 also on the API server (based on TIdTCPServer TCP/IP communication). Unfortunately when I set Active to True, and IdSSLOpenSSL.InitContext is called, in the CiperList settings step it always returns error = 1 and I don't understand what I am doing wrong: if StatusInfoOn then begin SSL_CTX_set_info_callback(fContext, InfoCallback); end; //if_SSL_CTX_set_tmp_rsa_callback(hSSLContext, @RSACallback); if fCipherList <> '' then begin {Do not Localize} error := SSL_CTX_set_cipher_list(fContext, {$IFDEF USE_MARSHALLED_PTRS} M.AsAnsi(fCipherList).ToPointer {$ELSE} PAnsiChar( {$IFDEF STRING_IS_ANSI} fCipherList {$ELSE} AnsiString(fCipherList) // explicit cast to Ansi {$ENDIF} ) {$ENDIF} ); end else begin // RLebeau: don't override OpenSSL's default. As OpenSSL evolves, the // SSL_DEFAULT_CIPHER_LIST constant defined in the C/C++ SDK may change, // while Indy's define of it might take some time to catch up. We don't // want users using an older default with newer DLLs... (* error := SSL_CTX_set_cipher_list(fContext, {$IFDEF USE_MARSHALLED_PTRS} M.AsAnsi(SSL_DEFAULT_CIPHER_LIST).ToPointer {$ELSE} SSL_DEFAULT_CIPHER_LIST {$ENDIF} ); *) error := 1; end; Server code: https://pastebin.com/z82zhGyQ I am using the latest Indy sources from the git repository. I thank you in advance for any suggestions Best Regards Silverio

Appreciated exemplify. I need to start using Gist too.

OK! Some forums do not permit, by forum rules, to attach external code links. Next will use Pastebin.

I've missed to set PassTrough 🙂 error = 1 stay for OK, another my misunderstanding. https://pastebin.com/f9sEw2eY

In Industry is very hard to think to use C# or Java which are so simple to decompilate and back to source code.

Hi all. For someone could be a silly question but important for me. Today I've purchased Athens, and usually I work with Sydney. I have a lot of very big projects made with Sydney and moving them to Athens will be a long path ( a lot of 3rd parties libraries to install). Can I install Athens on the same PC where Sydney works ? If YES, are there some types of attention to be kept? At the moment I've also Code Gear RAD Studio 2007 for very old projects not ported to Sydney which live without problems with Sydney.

My 2 cents. I have been battling, or rather, living with the constant crashing of the Delphi Sydney 10.4.1 IDE for months and months. All I had to do was open the IDE and close it to get the protected memory access error rtl270.bpl I tried uninstalling all plugins (GExpert, Parnassus, etc). No luck. Following your directions I removed the installed libraries one by one and, as Murphy teaches, when I removed the penultimate one the problem disappeared. Basically I was using an old, but not much, library called Graphics32 which in the IDE shutdown phase was sending everything into a tailspin. Updated to the latest version now everything works perfectly.

Hi all, it is possible to use the asyncio with a DelphiVCL ui-based program? I've implemented an asyncua Client to get data from an OPC UA Server. Here is a simple program that prints some values collected from an OPC UA server. """CNC OPC UA Client.""" #------------------------------------------------------------------------------- # Name: cnc_opcua_client # # Purpose: CNC OPC UA Client # # Note Checked with Python 3.11.3 # # Coding Style https://www.python.org/dev/peps/pep-0008/ #------------------------------------------------------------------------------- import time import asyncio import logging from asyncua import Client # == opc ua client settings == OPC_UA_SERVER_URL = "opc.tcp://localhost:4840/" OPC_UA_SERVER_URI = "https://www.someone.com/opc-ua/server" OPC_UA_ASYNC_SLEEP_TIME = 0.01 # == deveopment settings == DEBUG_LEVEL = logging.CRITICAL # avoid any log not critical DEBUG_ENABLED = False # creates a logger logger = logging.getLogger(__name__) async def main(): """Main entry point.""" # creats opc ua client in with-exception-handled block async with Client(url=OPC_UA_SERVER_URL) as client: # gets namespace index idx = await client.get_namespace_index(OPC_UA_SERVER_URI) # gets program position node program_position_node = client.get_node("ns=2;s=CNC.ProgramPosition") # server updating loop while True: # does nothing, just process relax await asyncio.sleep(OPC_UA_ASYNC_SLEEP_TIME) # reads and prints program positions value = await program_position_node.read_value() print('X:{:10.3f}, Y:{:10.3f}, Z:{:10.3f}'. format(value[0], value[1], value[2])) # checks if this module is running as the main program if __name__ == "__main__": logging.basicConfig(level=DEBUG_LEVEL) asyncio.run(main(), debug=DEBUG_ENABLED) Getting: *** Remote Interpreter Reinitialized *** X: 51.206, Y: 0.000, Z: 0.000 X: 51.206, Y: 0.000, Z: 0.000 X: 51.206, Y: 0.000, Z: 0.000 X: 51.206, Y: 0.000, Z: 0.000 At this point I would like to create a fashioned UI using DelphiVCL, but I'm unable to understand where to place the asyncio.run(main(), debug=DEBUG_ENABLED) because to get DelphiVCL UI the main loop is already done by Application.Run() call: # initializes GUI Application Application.Initialize() Application.Title = "OPC UA Client Demo" # creates main application form app = DesktopView(Application) app.Show() FreeConsole() # enters in vcl main loop Application.Run() # frees main application form app.Destroy() Thanks in advance for any suggestion. Best Regards Silverio

In the first experiment, I tried to attach a method to the Application.OnIdle but, visible onto dir(Application) Python notice that is not published. What is the right python4delphi repo from https://github.com/Embarcadero/python4delphi and https://github.com/pyscripter/python4delphi ? Sincerely I don't know what to prefer and there are enought of differences between them.

A silly solution was to place DelphiVCL in a thread, but I don't know if it is the better way... Code presents a lot of global values, is just a test in waiting for a better idea from Python/DelphiVCL gurus 🙂 import time import asyncio import logging import threading from asyncua import Client from delphivcl import * # == opc ua client settings == OPC_UA_SERVER_URL = "opc.tcp://localhost:4840/" OPC_UA_SERVER_URI = "https://someone.com/opc-ua/server" OPC_UA_ASYNC_SLEEP_TIME = 0.01 # == deveopment settings == DEBUG_LEVEL = logging.CRITICAL # avoid any log not critical DEBUG_ENABLED = False # creates a logger logger = logging.getLogger(__name__) app = None opcua_main_exit = False program_position = [] async def opcua_main(form): global opcua_main_exit global program_position async with Client(url=OPC_UA_SERVER_URL) as client: # gets namespace index idx = await client.get_namespace_index(OPC_UA_SERVER_URI) # gets program position node program_position_node = client.get_node("ns=2;s=CNC.ProgramPosition") while not opcua_main_exit: await asyncio.sleep(OPC_UA_ASYNC_SLEEP_TIME) # reads program positions value = await program_position_node.read_value() program_position = list(value) class DesktopView(Form): def __init__(self, owner): self.SetProps(Caption = "Welcome") # creates labels for program position axes values self.label_x = Label(self) self.label_x.SetProps(Parent=self, Top=40, Left=20) self.label_x.Caption = 'Z : {:15.3f}'.format(0.0) self.label_y = Label(self) self.label_y.SetProps(Parent=self, Top=60, Left=20) self.label_y.Caption = 'Y : {:15.3f}'.format(0.0) self.label_z = Label(self) self.label_z.SetProps(Parent=self, Top=80, Left=20) self.label_z.Caption = 'X : {:15.3f}'.format(0.0) # create and set update timer self.tmrUpdate = Timer(self) self.tmrUpdate.Enabled = False self.tmrUpdate.Interval = 1 self.tmrUpdate.OnTimer = self.__on_timer_update self.tmrUpdate.Enabled = True def __on_timer_update(self, sender): global program_position if len(program_position) == 6: self.label_x.Caption = str(program_position[0]) self.label_y.Caption = str(program_position[1]) self.label_z.Caption = str(program_position[2]) def app_main(): # initializes GUI Application Application.Initialize() Application.Title = "OPC UA Client Demo" # creates main application form app = DesktopView(Application) app.Show() FreeConsole() # enters in vcl main loop Application.Run() global opcua_main_exit opcua_main_exit = True # frees main application form app.Destroy() if __name__ == "__main__": app_thread = threading.Thread(target=app_main) app_thread.start() logging.basicConfig(level=DEBUG_LEVEL) asyncio.run(opcua_main(app))

This was my case, in which the main UI and image analysis, with OpenCV, was managed with Python + DelphiVCL, and faster IP Camera commands and frames receiving were managed by a Delphi P4D, in this case, D4P, module using native Threads of Delphi. The attempt to manage frame acquisition via socket with python threads failed miserably. The combo was winning !!! I the future of Python I will be happy to have more power on threads and cores.

I am slightly confused about which repository of python4delphi is most correct to use to integrate Python into my Delphi applications. To date, I know of two repositories on which constant work is visible: - https://github.com/pyscripter/python4delphi - https://github.com/Embarcadero/python4delphi Comparing them it seems that they are managed by different people, but both make fixes and new features with quite a lot of activity, so they are both "alive." Does anyone know how this is organized and which one is preferable to use? Thanks in advance for the answers.

Hi all, sorry in advance for very newbie in TLS/SSL things. I'm trying to create a secure FTP Server (with TLS/SSL) using the latest Indy sources from the GitHub repository. I've created required certificates with OpenSSL and used openssl-1.0.2u-x64_86-win64 DLL's always from a GitHub repository (info from Embarcadero Delphi manual). This is an extract of dummy code to test an early connection using Filezilla FTP Client: unit osFTPServer; interface uses IdContext, IdFTPList, IdFTPServer, IdFTPListOutput, IdSSLOpenSSL; type TFTPServer = class private FFTPServer: TIdFTPServer; FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL; private procedure ServerConnect(AContext: TIdContext); procedure ServerDisconnect(AContext: TIdContext); procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd : String; const ASwitches : String); public constructor Create; destructor Destroy; override; end; implementation uses IdSSLOpenSSLHeaders, osSysUtils; { TFTPServer } constructor TFTPServer.Create; begin inherited; // inits default members values FFTPServer := nil; FIOHandlerSSLOpenSLL := nil; // starts IdOpenSSLSetLibPath('D:\x\develop\qem\rosetta_cnc_1\openssl.64'); FFTPServer := TIdFTPServer.Create; FFTPServer.DefaultPort := 21; FFTPServer.OnConnect := ServerConnect; FFTPServer.OnDisconnect := ServerDisconnect; FFTPServer.OnUserLogin := ServerUserLogin; FFTPServer.OnListDirectory := ServerListDirectory; FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil); FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer; FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvTLSv1_2; FIOHandlerSSLOpenSLL.SSLOptions.CertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-key.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := ''; FFTPServer.IOHandler := FIOHandlerSSLOpenSLL; FFTPServer.Active := True; end; destructor TFTPServer.Destroy; begin //### does jobs to deactivate server before to free it!!! // frees objects SafeFreeAndNil(FFTPServer); SafeFreeAndNil(FIOHandlerSSLOpenSLL); inherited; end; procedure TFTPServer.ServerConnect(AContext: TIdContext); begin //### end; procedure TFTPServer.ServerDisconnect(AContext: TIdContext); begin //### end; procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: String); begin //### end; procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); begin //### VAuthenticated := True; end; end. When I try to connect with FileZilla it say: Status: Connecting to 192.168.0.27:21... Status: Connection established, waiting for welcome message... Status: Insecure server, it does not support FTP over TLS. Status: Logged in Status: Retrieving directory listing... Status: Directory listing of "/" successful What am I doing wrong? Thanks in advance for any suggestions.

I've tried to move from sslvSSLv23 to sslvTLSv1_2 as in the test code below but FileZilla says: 2023-09-30 10:39:20 11520 1 Status: Connecting to 127.0.0.1:21... 2023-09-30 10:39:20 11520 1 Status: Connection established, waiting for welcome message... and > openssl s_client -starttls ftp -connect 192.168.0.27:21 says: P:\>openssl s_client -starttls ftp -connect 192.168.0.27:21 CONNECTED(00000178) ... infinite wait without do nothing.. {** * TAKE CARE * ========= * This unit is purely for study purposes in which to learn the basics about building and testing an FTP server with * various levels of security. Server activation is in class constructor, and server properties manually placed before * its activation. On final class will be implemented a Start & Stop method to control it, with a property to get the * current state. The server settings will be placed in properties to be set before to activate the server. * **} unit osFTPServer; interface uses System.Classes, IdCTypes, IdContext, IdComponent, IdFTPList, IdFTPServer, IdFTPListOutput, IdSSLOpenSSL, IdSSLOpenSSLHeaders; type TFTPServerSecurityPolicy = ( fssp_None, fssp_sslvSSLv23, fssp_sslvTLSv1_2 ); TFTPServer = class private FCertificatesPath: string; FFTPServer: TIdFTPServer; FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL; FOpenSSLDLLPath: string; FPassword: string; FRootPath: string; FSecurityPolicy: TFTPServerSecurityPolicy; FUsername: string; private procedure ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); procedure ServerConnect(AContext: TIdContext); procedure ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName); procedure ServerDisconnect(AContext: TIdContext); procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd: string; const ASwitches: string); procedure ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); procedure ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); procedure ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream); procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); procedure SSLGetPassword(var Password: string); procedure SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean); procedure SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); procedure SSLStatusInfo(const AMsg: string); procedure SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string); private function FixPath(const APath: string): string; public constructor Create; destructor Destroy; override; end; implementation uses System.IOUtils, System.SysUtils, IdSSL, IdExplicitTLSClientServerBase; function FixTailPathDelimiter(const S: string): string; begin Result := IncludeTrailingPathDelimiter(ExcludeTrailingPathDelimiter(S)); end; procedure SafeFreeAndNil(var Obj); var Temp: TObject; begin try Temp := TObject(Obj); if Temp <> nil then begin Pointer(Obj) := nil; Temp.Free; end; except end; end; { TFTPServer } constructor TFTPServer.Create; begin inherited; // inits default members values FCertificatesPath := ''; FFTPServer := nil; FIOHandlerSSLOpenSLL := nil; FOpenSSLDLLPath := ''; FPassword := ''; FRootPath := ''; FSecurityPolicy := fssp_None; FUsername := ''; // TEMPORARY: manually set FTP settings (WILL BE PLACED ON PROPERTIES) FCertificatesPath := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\'; FOpenSSLDLLPath := 'D:\x\develop\qem\rosetta_cnc_1\openssl.64'; FPassword := '12345'; FRootPath := 'D:\x\develop\qem\rosetta_cnc_1\certificates\'; //FSecurityPolicy := fssp_sslvSSLv23; FSecurityPolicy := fssp_sslvTLSv1_2; FUsername := 'user'; // TEMPORARY: creates, sets and start FTP server IdOpenSSLSetLibPath(FOpenSSLDLLPath); FFTPServer := TIdFTPServer.Create; FFTPServer.DefaultPort := 21; FFTPServer.OnChangeDirectory := ServerChangeDirectory; FFTPServer.OnConnect := ServerConnect; FFTPServer.OnDeleteFile := ServerDeleteFile; FFTPServer.OnDisconnect := ServerDisconnect; FFTPServer.OnListDirectory := ServerListDirectory; FFTPServer.OnMakeDirectory := ServerMakeDirectory; FFTPServer.OnRemoveDirectory := ServerRemoveDirectory; FFTPServer.OnStoreFile := ServerStoreFile; FFTPServer.OnUserLogin := ServerUserLogin; case FSecurityPolicy of fssp_None: ; fssp_sslvSSLv23: begin FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil); FIOHandlerSSLOpenSLL.OnStatus := SSLStatus; FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo; FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx; FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword; FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx; FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer; FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvSSLv23; FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'server-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'server-key.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'root-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := ''; FFTPServer.IOHandler := FIOHandlerSSLOpenSLL; FFTPServer.UseTLS := utUseRequireTLS; end; fssp_sslvTLSv1_2: begin {.DEFINE USES_DHPARAM} // NOTE: to use this create a dhparam.pem file with openssl in this way openssl dhparam -out dhparam.pem 4096 FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil); FIOHandlerSSLOpenSLL.OnStatus := SSLStatus; FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo; FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx; FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword; FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx; FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer; FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvTLSv1_2; {$IFDEF USES_DHPARAM} FIOHandlerSSLOpenSLL.SSLOptions.CipherList := ( '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' + ':ECDHE-RSA-AES128-GCM-SHA256' + ':ECDHE-RSA-AES256-GCM-SHA384' + ':ECDHE-RSA-CHACHA20-POLY1305' + ':DHE-RSA-AES128-GCM-SHA256' + ':DHE-RSA-AES256-GCM-SHA384' + '' ); FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := FCertificatesPath + 'dhparam.pem'; {$ELSE} FIOHandlerSSLOpenSLL.SSLOptions.CipherList := ( '!EXPORT:!LOW:!aNULL:!eNULL:!RC4:!ADK:!3DES:!DES:!MD5:!PSK:!SRP:!CAMELLIA' + ':ECDHE-RSA-AES128-GCM-SHA256' + ':ECDHE-RSA-AES256-GCM-SHA384' + ':ECDHE-RSA-CHACHA20-POLY1305' ); FIOHandlerSSLOpenSLL.SSLOptions.DHParamsFile := ''; {$ENDIF} FIOHandlerSSLOpenSLL.SSLOptions.CertFile := FCertificatesPath + 'server-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := FCertificatesPath + 'server-key.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := FCertificatesPath + 'root-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := ''; FFTPServer.IOHandler := FIOHandlerSSLOpenSLL; FFTPServer.UseTLS := utUseRequireTLS; end; end; // sets passive boundary ports range to permit more than one file operation (eg: client multiple copy file to server) FFTPServer.PASVBoundPortMin := 60000; FFTPServer.PASVBoundPortMax := 65535; FFTPServer.Active := True; end; destructor TFTPServer.Destroy; begin //### does jobs to deactivate server before to free it!!! // frees objects SafeFreeAndNil(FFTPServer); SafeFreeAndNil(FIOHandlerSSLOpenSLL); inherited; end; function TFTPServer.FixPath(const APath: string): string; begin Result := StringReplace(APath, '/', '\', [rfReplaceAll]); Result := StringReplace(Result, '\\', '\', [rfReplaceAll]); end; procedure TFTPServer.ServerChangeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); begin //### end; procedure TFTPServer.ServerConnect(AContext: TIdContext); begin case FSecurityPolicy of fssp_None: ; fssp_sslvSSLv23: ; fssp_sslvTLSv1_2: begin // PassThroung must be set to False for it to handle SSL/TLS functionality if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False; end; end; end; procedure TFTPServer.ServerDeleteFile(ASender: TIdFTPServerContext; const APathName: TIdFTPFileName); begin DeleteFile(FixPath(FRootPath + ASender.CurrentDir + '\' + APathname)); end; procedure TFTPServer.ServerDisconnect(AContext: TIdContext); begin //### end; procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: string); var Status: Integer; SearchRec: TSearchRec; Item: TIdFTPListOutputItem; begin try ADirectoryListing.DirFormat := doWin32; ADirectoryListing.Switches := ASwitches; {$WARN SYMBOL_PLATFORM OFF} Status := FindFirst(FixPath(FRootPath + FixTailPathDelimiter(APath) + '*.*'), faAnyFile - faHidden - faSysFile, SearchRec); {$WARN SYMBOL_PLATFORM ON} try while Status = 0 do begin Item := ADirectoryListing.Add; if SearchRec.Attr and faDirectory = 0 then Item.ItemType := ditFile else Item.ItemType := ditDirectory; Item.FileName := SearchRec.Name; Item.Size := SearchRec.Size; Item.ModifiedDate := SearchRec.TimeStamp; Status := FindNext(SearchRec); end; finally FindClose(SearchRec); end; except end; end; procedure TFTPServer.ServerMakeDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); begin try ForceDirectories(FixPath(FRootPath + VDirectory)); except end; end; procedure TFTPServer.ServerRemoveDirectory(ASender: TIdFTPServerContext; var VDirectory: TIdFTPFileName); begin try TDirectory.Delete(FixPath(FRootPath + VDirectory), True); except end; end; procedure TFTPServer.ServerStoreFile(ASender: TIdFTPServerContext; const AFileName: TIdFTPFileName; AAppend: Boolean; var VStream: TStream); var Path: string; begin // extracts path and forces creation if does not exits Path := ExtractFilePath(FixPath(FRootPath + AFilename)); if not DirectoryExists(Path) then ForceDirectories(Path); // opens a file stream for cration or append if not AAppend then VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmCreate) else VStream := TFileStream.Create(FixPath(FRootPath + AFilename), fmOpenWrite) end; procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); begin // checks user and password validity case FSecurityPolicy of fssp_None: begin VAuthenticated := True; end; fssp_sslvSSLv23: begin VAuthenticated := ( (FUsername = Trim(AUserName)) and (FPassword = Trim(APassword)) ); end; fssp_sslvTLSv1_2: begin VAuthenticated := ( (FUsername = Trim(AUserName)) and (FPassword = Trim(APassword)) ); end; end; end; procedure TFTPServer.SSLGetPassword(var Password: string); begin //### Password := FPassword; end; procedure TFTPServer.SSLGetPasswordEx(ASender: TObject; var VPassword: string; const AIsWrite: Boolean); begin //### end; procedure TFTPServer.SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); begin //### end; procedure TFTPServer.SSLStatusInfo(const AMsg: string); begin //### end; procedure TFTPServer.SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: string); begin //### end; end. Have you any suggestions? Thanks in advance for any suggestions.

Being really ignorant of security I put a few breakpoints in the sources and followed step by step changing the options from way to way. Something seems to be working now... unit osFTPServer; interface uses IdCTypes, IdContext, IdComponent, IdFTPList, IdFTPServer, IdFTPListOutput, IdSSLOpenSSL, IdSSLOpenSSLHeaders; type TFTPServer = class private FFTPServer: TIdFTPServer; FIOHandlerSSLOpenSLL: TIdServerIOHandlerSSLOpenSSL; private procedure ServerConnect(AContext: TIdContext); procedure ServerDisconnect(AContext: TIdContext); procedure ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); procedure ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd : String; const ASwitches : String); procedure SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); procedure SSLStatusInfo(const AMsg: String); procedure SSLStatusInfoEx(ASender : TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg : String); procedure SSLGetPassword(var Password: String); procedure SSLGetPasswordEx(ASender : TObject; var VPassword: String; const AIsWrite : Boolean); public constructor Create; destructor Destroy; override; end; implementation uses //IdSSL, IdExplicitTLSClientServerBase, osSysUtils; { TFTPServer } constructor TFTPServer.Create; begin inherited; // inits default members values FFTPServer := nil; FIOHandlerSSLOpenSLL := nil; // creates, sets and start FTP server IdOpenSSLSetLibPath('D:\x\develop\qem\rosetta_cnc_1\openssl.64'); FFTPServer := TIdFTPServer.Create; FFTPServer.DefaultPort := 21; FFTPServer.OnConnect := ServerConnect; FFTPServer.OnDisconnect := ServerDisconnect; FFTPServer.OnUserLogin := ServerUserLogin; FFTPServer.OnListDirectory := ServerListDirectory; FIOHandlerSSLOpenSLL := TIdServerIOHandlerSSLOpenSSL.Create(nil); FIOHandlerSSLOpenSLL.OnStatus := SSLStatus; FIOHandlerSSLOpenSLL.OnStatusInfo := SSLStatusInfo; FIOHandlerSSLOpenSLL.OnStatusInfoEx := SSLStatusInfoEx; FIOHandlerSSLOpenSLL.OnGetPassword := SSLGetPassword; FIOHandlerSSLOpenSLL.OnGetPasswordEx := SSLGetPasswordEx; FIOHandlerSSLOpenSLL.SSLOptions.Mode := sslmServer; FIOHandlerSSLOpenSLL.SSLOptions.Method := sslvSSLv23; // sslvTLSv1_2; FIOHandlerSSLOpenSLL.SSLOptions.CertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.KeyFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\server-key.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := 'D:\x\develop\qem\rosetta_cnc_1\certificates\ftpserver\root-cert.pem'; FIOHandlerSSLOpenSLL.SSLOptions.RootCertFile := ''; FFTPServer.IOHandler := FIOHandlerSSLOpenSLL; FFTPServer.UseTLS := utUseRequireTLS; FFTPServer.Active := True; end; destructor TFTPServer.Destroy; begin //### does jobs to deactivate server before to free it!!! // frees objects SafeFreeAndNil(FFTPServer); SafeFreeAndNil(FIOHandlerSSLOpenSLL); inherited; end; procedure TFTPServer.ServerConnect(AContext: TIdContext); begin //### { If AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := False; //This function must be set to false for it to handle SSL/TLS functionality. } end; procedure TFTPServer.ServerDisconnect(AContext: TIdContext); begin //### end; procedure TFTPServer.ServerListDirectory(ASender: TIdFTPServerContext; const APath: TIdFTPFileName; ADirectoryListing: TIdFTPListOutput; const ACmd, ASwitches: String); begin //### end; procedure TFTPServer.ServerUserLogin(ASender: TIdFTPServerContext; const AUsername, APassword: string; var VAuthenticated: Boolean); begin //### VAuthenticated := True; end; procedure TFTPServer.SSLGetPassword(var Password: String); begin //### end; procedure TFTPServer.SSLGetPasswordEx(ASender: TObject; var VPassword: String; const AIsWrite: Boolean); begin //### end; procedure TFTPServer.SSLStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); begin //### end; procedure TFTPServer.SSLStatusInfo(const AMsg: String); begin //### end; procedure TFTPServer.SSLStatusInfoEx(ASender: TObject; const AsslSocket: PSSL; const AWhere, Aret: TIdC_INT; const AType, AMsg: String); begin //### end; end. Filezilla reply: Status: Connecting to 192.168.0.27:21... Status: Connection established, waiting for welcome message... Status: Initializing TLS... Status: TLS connection established. Status: Logged in Status: Retrieving directory listing... Status: Directory listing of "/" successful Log is very close to what happens with Python code: Status: Connecting to 127.0.0.1:21... Status: Connection established, waiting for welcome message... Status: Initializing TLS... Status: TLS connection established. Status: Logged in Status: Retrieving directory listing... Status: Directory listing of "/" successful

Certificates are OK because I've tried to do the same thing with Python using them: # require pip install pyOpenSSL # require pip install pyftpdlib from pyftpdlib.authorizers import DummyAuthorizer from pyftpdlib.handlers import FTPHandler, TLS_FTPHandler from pyftpdlib.servers import FTPServer def create_server(): # Crea un'autorizzazione e aggiungi un utente authorizer = DummyAuthorizer() authorizer.add_user("user", "12345", "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates", perm="elradfmw") # Inizializza l'handler del server FTP e assegna l'autorizzatore handler = TLS_FTPHandler handler.authorizer = authorizer # Specifica i percorsi per i certificati SSL handler.certfile = "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates\\ftpserver\\server-cert.pem" # Sostituisci con il percorso corretto del certificato handler.keyfile = "D:\\x\\develop\\qem\\rosetta_cnc_1\\certificates\\ftpserver\\server-key.pem" # Sostituisci con il percorso corretto della chiave privata # Abilita TLS sull'handler handler.tls_control_required = True handler.tls_data_required = True # Configura altre opzioni dell'handler handler.passive_ports = range(60000, 65535) # Crea il server FTP e lo avvia server = FTPServer(("127.0.0.1", 21), handler) server.serve_forever() if __name__ == "__main__": create_server() and Filezilla open now a TLS/SSL connection... Happy for a solution with Delphi 🙂

There is a way to ZOOM in/out ? Very interesting product to analyse overall of a project!

Strange you have memory problems in compilation after 300000 lines of code. I have been compiling projects of almost 20,000,000 lines of code for years on a PC with 16GB of RAM without such problems. Unfortunately, our software products are almost always free and related to the sale of cheap hardware so for the time being we have stopped at Sydney UP1 and so I don't know if the error problems with out of memory depend on the version.... What I don't like about the system is that anyway as soon as a new version comes out there are no more patches for the most important stability bugs in the IDE and language server system....