Jump to content

shineworld

Members
  • Content Count

    343
  • Joined

  • Last visited

  • Days Won

    4

Posts posted by shineworld


  1. 3 minutes ago, pyscripter said:

    You could run the asyncio in a thread as in python - Running asyncio loop and tkinter gui - Stack Overflow.

    Also please submit an issue to the delphivcl project to expose the Application.OnIdle event.   That would make the use of timer unnecessary.

    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.


  2. 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))

     


  3. 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


  4. 4 hours ago, pyscripter said:

    Let's not start language wars in this thread, which is about a significant development in Python 12 and how take advantage of it using P4D.   P4D is about combining the strengths of python and Delphi, not choosing one versus the other.

    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.


  5. 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.


  6. 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.


  7. 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


  8. 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 🙂


  9. 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:
    image.png.31a6102fcea2812d59664a1be756db9b.png

     

    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.


  10. 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.
    image.thumb.png.28f48cffdfe3b84a61005557ea932f5d.png
    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....
     


  11. Interesting and disheartening in the same way.


    Over the past 7 years, I have created an entire CNC ecosystem from logic boards to CNC control software running on Windows OS

    done entirely in Delphi (well it runs without any problem, and in some bought even better, in Linux environment under Wine,

    at least as far as memory management is concerned).

    For OPC UA server management I have already sketched out something following the OPC 40502 standard (OPC UA for Computerized Numerical Control (CNC) Systems),

    initially using Python opcua but then switched to a program external to Delphi made with QT.

    Not having native handling in Delphi makes things quite complex for me, and I have to do everything with an additional TCP layer between the two processes to exchange information, events, etc.

    I am precisely looking for a way to avoid all this and keep everything in one language and process.


  12. Hi all.

    I need to implement an OPC UA Server in a Delphi program.

    Actually, I've used an external QT C++ application to do OPC UA things but is complex to

    maintain changes in the server and share an interface between this external program and the main program written with Delphi

    and I would like to know if there is a valid native Delphi library to use, better if open-source, but this is not mandatory.

     

    Thank you for your suggestions.

     


  13. 13 minutes ago, mvanrijnen said:
    8 minutes ago, mvanrijnen said:

    Just a quick question is the 16Mb limit still valid for the tool?

    I'm not an expert with PDB but that is what I've done and now seems to work:
     

    - Installed the latest version of VTune Profiler (2023.1.0).
    - Changed the original amplxe_media140.dll with an old version from Jan Rysavy (previous posts).
    - Enabled map in Detailed mode.
    - Compiled a project of 1.359.947 code lines (including library sources) which generate a map file of 49.696.190 bytes.
    - Executed map2pdb.exe rosettacncpph1.64.map -bind -v

    D:\x\develop\qem\rosetta_cnc_1>map2pdb.exe rosettacncpph1.64.map -bind -v
    map2pdb - Copyright (c) 2021 Anders Melander
    Version 2.8.0
    
    Constructed a new PDB GUID: {F2D8CB4B-DA08-4BBD-A399-DBC449AF1364}
    Output filename not specified. Defaulting to rosettacncpph1.64.pdb
    Reading MAP file
    - Segments
    - Modules
    - Symbols
    Warning: [116390] Failed to resolve symbol to module: [0004:00000000000002C8] SysInit.TlsLast
    Warning: [116392] Failed to resolve symbol to module: [0003:00000000FE7F6000] SysInit.__ImageBase
    - Line numbers
    Collected 3.996 modules, 182.925 symbols, 525.223 lines, 985 source files
    Constructing PDB file
    - Collecting source file names
    - Module streams
    - Strings stream
    - PDB Info stream
    - TPI stream
    - Symbols stream
    - DBI stream
    - IPI stream
    - Finalizing PDB file
    - 9.068 blocks written in 3 intervals
    PE filename not specified. Defaulting to rosettacncpph1.64.exe
    Patching PE file
    - PE32+ image (64-bit)
    - Adding .debug section.
    - PDB file name has been stored in debug data.
    - PE file has been updated.
    Elapsed time: 00:00:00.895

    This has generated a PDB file of 37.142.528 bytes

    - Started profiling of EXE in VTune profiler which generates this log at the profiling stop:

    Data collection is completed successfully
    
    May 22 2023 18:06:59 The result file 'XXX\r001hs\r001hs.vtune' is successfully created and added to the project .
    
    Finalization completed with warnings
    
    May 22 2023 18:08:33 Result finalization has completed with warnings that may affect the representation of the analysis data. Please see details below.
    
    Cannot locate debugging information for file `C:\WINDOWS\System32\msvcrt.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\WinSxS\amd64_microsoft.windows.common-controls_6595b64144ccf1df_6.0.19041.1110_none_60b5254171f9507e\COMCTL32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\WinSxS\amd64_microsoft.windows.gdiplus_6595b64144ccf1df_1.1.19041.2251_none_91a40448cc8846c1\gdiplus.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\SYSTEM32\ntdll.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\GDI32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\SETUPAPI.DLL'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\KERNEL32.DLL'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\cfgmgr32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\gdi32full.dll'.
    Cannot locate debugging information for file `C:\Program Files\Bitdefender\Endpoint Security\bdhkm\dlls_266262988153465131\bdhkm64.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\user32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\combase.dll'.
    Cannot locate debugging information for file `C:\Program Files\Bitdefender\Endpoint Security\atcuf\dlls_266575548366517634\atcuf64.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\system32\mswsock.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\system32\uxtheme.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\ole32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\SYSTEM32\opengl32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\SYSTEM32\DEVOBJ.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\KERNELBASE.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\SYSTEM32\TextShaping.dll'.
    Cannot locate debugging information for file `C:\Windows\System32\msxml6.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\WS2_32.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\DriverStore\FileRepository\nv_dispi.inf_amd64_c1a085cc86772d3f\nvoglv64.dll'.
    Cannot locate debugging information for file `C:\WINDOWS\SYSTEM32\HID.DLL'.
    Cannot locate debugging information for file `C:\WINDOWS\System32\win32u.dll'.
    Cannot locate debugging information for file `C:\Program Files (x86)\Intel\oneAPI\vtune\latest\bin64\tpsstool.dll'.:

    And all symbols project symbols are visible (not for below list of DLL):
    image.thumb.png.379a0032676cb7178ad974109308ea1b.png






  14. 2 hours ago, Jan Rysavy said:

     

    I can confirm replacing C:\Program Files (x86)\Intel\oneAPI\vtune\2023.1.0\bin64\amplxe_msdia140.dll (version 14.34.31942.0) with version 14.28.29910.0 from VTune 2022.4.1 solves this problem!

    Can you attach the working DLL to try ?

     


  15. 9 minutes ago, Jan Rysavy said:

    I just want to add that I installed an older version of VTune 2022.4.1 and the function names are displayed correctly. The problem seems to be related to the new version VTune 2023.1.

    I've tried to find a way to download the older version (2022.4.1) but no way found on the intel VTune pages....


  16. Incredible tool, congrats.


    I've tried to use it with Sydney 10.4.1 and VTune 2023.1.0.
     

    Unfortunately, I was not able to get the function as name, I get only func addresses:
    image.thumb.png.829647b085ce0c09b7d8e2041edbc34f.png

     

    I've tried with:

    D:\x\develop\qem\rosetta_cnc_1>map2pdb.exe rosettacncpph1.64.map -bind
    map2pdb - Copyright (c) 2021 Anders Melander
    Version 2.8.0

    and also with:

    D:\x\develop\qem\rosetta_cnc_1>map2pdb.exe -bind rosettacncpph1.64.map
    map2pdb - Copyright (c) 2021 Anders Melander
    Version 2.8.0

    Map is set to Detailed on Sydney 10.4.1:
    image.thumb.png.c7ddcff82caf64eba091f142282eaeb7.png

     

    D:\x\develop\qem\rosetta_cnc_1>map2pdb.exe rosettacncpph1.64.map -bind -v
    map2pdb - Copyright (c) 2021 Anders Melander
    Version 2.8.0
    
    Constructed a new PDB GUID: {5D8591F1-8F38-4E7B-BAE4-1BB55536733F}
    Output filename not specified. Defaulting to rosettacncpph1.64.pdb
    Reading MAP file
    - Segments
    - Modules
    - Symbols
    Warning: [116390] Failed to resolve symbol to module: [0004:00000000000002C8] SysInit.TlsLast
    Warning: [116392] Failed to resolve symbol to module: [0003:00000000FE7F6000] SysInit.__ImageBase
    - Line numbers
    Collected 3.996 modules, 182.925 symbols, 525.223 lines, 985 source files
    Constructing PDB file
    - Collecting source file names
    - Module streams
    - Strings stream
    - PDB Info stream
    - TPI stream
    - Symbols stream
    - DBI stream
    - IPI stream
    - Finalizing PDB file
    - 9.068 blocks written in 3 intervals
    PE filename not specified. Defaulting to rosettacncpph1.64.exe
    Patching PE file
    - PE32+ image (64-bit)
    - Adding .debug section.
    - PDB file name has been stored in debug data.
    - PE file has been updated.
    Elapsed time: 00:00:00.874

     

    I hope you have a simple solution to my possible mistakes.

×