多实例使用的delphi表单答案

【问题标题】：delphi Form with multi instance use多实例使用的delphi表单
【发布时间】：2013-04-03 13:09:26
【问题描述】：

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

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

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;

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

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

    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

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

谢谢。

【问题讨论】：

您没有显示任何TFtpUploader 代码，我们怎么能猜到呢？ 你也创建了这些实例，但是你在哪里释放它们？例如，您至少可以做 TFTpUploader.Create(Application)
例如，没有点击 StartButton 的事件处理程序 - 所以它不应该对任何东西做出反应。
你好，他们像这样在关闭事件中被释放：code procedure FtpUploader.FormClose(Sender: TObject; var Action: TCloseAction);开始行动：=caFree；结尾; code
你好。您发布的来源中没有FtpUploader.FormClose。当你隐瞒信息时——你降低了每个人帮助你的能力。 catb.org/esr/faqs/smart-questions.html
看这里，Indy FTP Failing to upload miserably。基本上，您需要将上传移至线程并使用 indy 的 TIdSync 和 TIdNotify 更新 GUI。

标签： delphi ftp indy

【解决方案1】：

您似乎必须将 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);
  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;

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

【讨论】：