Multi-instance delphi form

I have an FTP downloader project that uses a form created at runtime to start uploading to multiple FTP servers (using Indy), my problem is this (and I really need your help).

On the form, I add the IdFTP component + download button + public properties named FTPSrvAdrs and SrcFile + TrgFolder as follows:

type TFtpUploader = class(TForm) IdFTP: TIdFTP; StartUpload:TButton; UploadProgress:TProgressBar; procedure StartUploadClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private FFtpSrvAdrs:String; FSrcFile:String; FTargetFtpFld:String; Procedure StartMyUpload(); procedure SetFtpAdrs(const value:string); procedure SetSrcFile(const value:string); procedure SetTargetFtpFld(const value:string); { Private declarations } public { Public declarations } property FtpAdrs:string read FFtpSrvAdrs write SetFtpAdrs; property SourceFile:string read FSrcFile write SetSrcFile; property TargetFtpFld:string read FTargetFtpFld write SetTargetFtpFld; end; var FtpUploader: TFtpUploader; implementation procedure TFtpUploader.StartUploadClick(Sender: TObject); begin StartMyUpload(); end; procedure TFtpUploader.SetFtpAdrs(const value: string); begin FFtpSrvAdrs:=value; end; procedure TFtpUploader.SetSrcFile(const value: string); begin FSrcFile:=value; end; procedure TFtpUploader.SetTargetFtpFld(const value: string); begin FTargetFtpFld:=value; end; procedure TFtpUploader.StartMyUpload; var FtpUpStream: TFileStream; begin ftpUpStream:= TFileStream.create(FSrcFile, fmopenread) try with IdFTP do begin Host:= FFtpSrvAdrs; Username:='MyUserName'; Password:='MyPassword'; end; IdFTP.Connect(true, 1200) IdFTP.Passive:= true; IdFTP.ChangeDir(FTargetFtpFld) IdFTP.Put(ftpUpStream,FSrcFile, false); finally ftpUpStream.Free; end; end; procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction); begin Action:=caFree; end; 

This form will be created in RunTime (4 times = 4 buttons will be launched separately, like this way:

in the main form, I have this procedure:

  Procedure MainForm.UploadTo(FTPSrv,SrcFile,FtpTargetFld:String); var FUploadFrm:TFtpUploader; begin FUploadFrm:=TFtpUploader.Create(nil); if assigned(FUploadFrm) then begin FUploadFrm.FtpAdrs:=FTPSrv; FUploadFrm.SourceFile:=SrcFile; FUploadFrm.TargetFtpFld:=FtpTargetFld; FUploadFrm.Show; end; end; procedure MainForm.Button1Click(Sender: TObject); begin UploadTo('MyFtpSrv_1','MySrcFile_1','MyFtpTargetFld_1'); end; procedure MainForm.Button2Click(Sender: TObject); begin UploadTo('MyFtpSrv_2','MySrcFile_2','MyFtpTargetFld_2'); end; // same with other 2 buttons 

The FtpUploader formats are created / opened (4 instances), ISSUE IS, when I click the StartUpload button, the FTP upload process does not start in all four of these instances, but I must wait for each upload process to be completed (completed) and the other to start automatically , that is, not all boot processes start at the same time.

Thanks.

+1
source share
1 answer

It seems you need to either change the Indy library for some non-blocking library in the background (event-based or termination-based), or make your program multithreaded (with its own bunch of problems, such as pressing the user button 20 times or closing the form during process or even closing the program at startup).

Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it might look something like this:

  TFtpUploader = class(TForm) private CanCloseNow: boolean; ... procedure TFtpUploader.FormClose(Sender: TObject; var Action: TCloseAction); begin if Self.CanCloseNow then Action := caFree else Action := caIgnore; end; procedure TFtpUploader.MyUploadComplete; begin Self.CanCloseNow := True; Self.Close; end; procedure TFtpUploader.StartMyUpload; begin Self.CanCloseNow := false; Self.Enabled := False; Self.Visible := True; Application.ProcessMessages; Parallel.Async( procedure var FtpUpStream: TFileStream; begin ftpUpStream:= TFileStream.create(FSrcFile, fmopenread) try with IdFTP do begin Host:= FFtpSrvAdrs; Username:='MyUserName'; Password:='MyPassword'; Connect(true, 1200) Passive:= true; ChangeDir(FTargetFtpFld) // this does not return until uploaded // thus would not give Delphi a chance to process buttons // pressed on other forms. Put(ftpUpStream,FSrcFile, false); end; finally ftpUpStream.Free; end; end , Parallel.TaskConfig.OnTerminated( procedure (const task: IOmniTaskControl) begin MyUploadComplete; end; ); end; 

Or you can use the simpler AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/

+1
source

Source: https://habr.com/ru/post/1383753/


All Articles