delphi形式与多实例使用 [英] delphi Form with multi instance use

问题描述

我有一个FTP上传器项目，它使用运行时创建的表单开始上传到多个FTP服务器（使用Indy），我的问题如下（我真的需要你的帮助）。

$ b

在表单上，​​我放置了一个IdFTP组件+上传按钮+名为FTPSrvAdrs和SrcFile + TrgFolder的公共属性，如下所示：

<$ p $ > code> type
TFtpUploader = class（TForm）
IdFTP：TIdFTP;
StartUpload：TButton;
UploadProgress：TProgressBar;
程序StartUploadClick（发件人：TObject）;
procedure FormClose（Sender：TObject; var Action：TCloseAction）;
private
FFtpSrvAdrs：String;
FSrcFile：String;
FTargetFtpFld：String;
过程StartMyUpload（）;
过程SetFtpAdrs（const value：string）;
过程SetSrcFile（const value：string）;
过程SetTargetFtpFld（const value：string）;
{私有声明}
public
{公共声明}
属性FtpAdrs：字符串读取FFtpSrvAdrs写入SetFtpAdrs;
属性SourceFile：字符串读取FSrcFile写入SetSrcFile;
属性TargetFtpFld：读取的字符串FTargetFtpFld写入SetTargetFtpFld;
end;

var
FtpUploader：TFtpUploader;

实现

过程TFtpUploader.StartUploadClick（发件人：TObject）;
begin
StartMyUpload（）;
end;

过程TFtpUploader.SetFtpAdrs（const value：string）;
begin
FFtpSrvAdrs：= value;
end;

过程TFtpUploader.SetSrcFile（const value：string）;
begin
FSrcFile：= value;
end;

过程TFtpUploader.SetTargetFtpFld（const value：string）;
begin
FTargetFtpFld：= value;
end;

程序TFtpUploader.StartMyUpload;
var
FtpUpStream：TFileStream;
begin
ftpUpStream：= TFileStream.create（FSrcFile，fmopenread）
使用IdFTP尝试
开始
Host：= FFtpSrvAdrs;
用户名：='MyUserName';
密码：='MyPassword';
end;
IdFTP.Connect（true，1200）
IdFTP.Passive：= true;
IdFTP.ChangeDir（FTargetFtpFld）
IdFTP.Put（ftpUpStream，FSrcFile，false）;
终于
ftpUpStream.Free;
end;
end;


procedure TFtpUploader.FormClose（Sender：TObject; var Action：TCloseAction）;
begin
操作：= caFree;
end;

这个表单将在RunTime上创建（4次= 4个按钮将像这样分开启动它：

在主表单中我有这个程序：

 程序MainForm.UploadTo（FTPSrv，SrcFile，FtpTargetFld：String）; 
 var 
 FUploadFrm：TFtpUploader; 
 begin 
 FUploadFrm：= TFtpUploader.Create（nil）; 
 if （FUploadFrm）then 
 begin 
 FUploadFrm.FtpAdrs：= FTPSrv; 
 FUploadFrm.SourceFile：= SrcFile; 
 FUploadFrm.TargetFtpFld：= FtpTargetFld; 
 FUploadFrm.Show ; 
 end; 
 end; 
 
程序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; 
 
 //与其他2个按钮相同
  

FtpUploader表单被创建/打开（4个实例），问题是当我点击StartUpload按钮时，所有这4个实例都没有启动FTP上传过程，但我必须等待每个上传过程完成（完成），另一个将自动启动，这意味着并非所有的上传过程都是在同一时间开始的。

谢谢。

解决方案

用于某些非阻塞后台库（基于事件或基于完成端口）的Indy库，或者使程序成为多线程（使用它自己的一堆问题，如用户单击按钮20次或关闭表单在运行中甚至关闭程序）。

基于 http://otl.17slon.com/book/doku.php?id=book:highlevel:async 它可以看起来像这样：

  TFtpUploader = class（TForm）
 private 
 CanCloseNow：boolean; 
 
 ... 
 
 procedure TFtpUploader.FormClose（Sender：TObject; var Action：TCloseAction）; 
开始
如果Self.CanCloseNow 
则操作：= caFree 
 else操作：= caIgnore; 
 end; 
 
程序TFtpUploader.MyUploadComplete; 
 begin 
 Self.CanCloseNow：= True; 
 Self.Close; 
 end; 
 
程序TFtpUploader.StartMyUpload; 
 begin 
 Self.CanCloseNow：= false; 
 Self.Enabled：= False; 
 Self.Visible：= True; 
 Application.ProcessMessages; 
 
 Parallel.Async（
过程
 var 
 FtpUpStream：TFileStream; 
 begin 
 ftpUpStream：= TFileStream.create（FSrcFile，fmopenread） 
使用IdFTP尝试
开始
 Host：= FFtpSrvAdrs; 
用户名：='MyUserName'; 
密码：='MyPassword'; 
 Connect true，1200）
被动：= true; 
 ChangeDir（FTargetFtpFld）
 
 //直到上传
 // //才不会给德尔福一个机会处理按钮
 //按下其他窗体
 Put（ftpUpStream，FSrcFile，false）; 
 end; 
 finally 
 ftpUpStream.Free; 
结束; 
结束
，
 Parallel.TaskConfig.OnTerminated（
过程（const task：IOmniTaskControl）
 begin 
 MyUploadComplete; 
 end; 
）; 
 end; 
  

或者你可以使用简单的AsyncCalls库 http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous -function-calls /

i've an FTP uploader project that uses a form created on run time to start uploading to multiple FTP Servers ( using Indy ) , my issue is as follows ( and i really need your help ) .

On a Form i put an IdFTP Component + an Upload button + public properties named FTPSrvAdrs and SrcFile + TrgFolder like this way :

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 on RunTime ( 4 times = 4 buttons will launch it separately like this way :

in the main form i've 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 form is Created / Opened ( 4 instances ) ,The ISSUE IS when i click on StartUpload button the FTP upload process is not started on all these 4 instances , but i've to wait each upload process is done ( finished ) and the other will auto-start , that means not all upload processes are started in same time .

Thank you .

解决方案

It seems you have to either change Indy library for some non-blocking in-background library (event based or completion port based), or to make your program multi-threading (with it's own bunch of problems like user clicking a button 20 times or closing the form while the process is going, or even closing the program on the run).

Based on http://otl.17slon.com/book/doku.php?id=book:highlevel:async it can look anything 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 simplier AsyncCalls library http://andy.jgknet.de/blog/bugfix-units/asynccalls-29-asynchronous-function-calls/

这篇关于delphi形式与多实例使用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！