记账软件版1楼: 请问：在Upload中，FTP.connect之后打开文件对话窗就无法跳出，[blue]如果把打开文件放前边，就能[/blue]，请问为什么？？？下


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdFTP, ComCtrls;

type
TDemo1Thread = class(TThread)
private
Uspeed : Integer;
FTP: TIdFTP;
protected
procedure Execute; override;
public
procedure Upload;
end;



type
TForm1 = class(TForm)
Button1: TButton;
FTP: TIdFTP;
OpenDialog: TOpenDialog;
IdAntiFreeze1: TIdAntiFreeze;
ListBox: TListBox;
ProgressBar: TProgressBar;
StatusBar: TStatusBar;
procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
t : TDemo1Thread;
implementation

{$R *.dfm}


procedure TDemo1Thread.Execute;
begin
Synchronize(Upload);
end;



[red]procedure TDemo1Thread.Upload;
begin
Form1.Caption := ＇＇请选择要上传的文件＇＇;

if FTP.Connected then
begin
Form1.StatusBar.SimpleText := ＇＇已经成功连接到服务器...＇＇;
if Form1.OpenDialog.Execute then
begin
FTP.Put(Form1.OpenDialog.FileName, ExtractFileName(Form1.OpenDialog.FileName));
end;
end
else
begin
Form1.StatusBar.SimpleText := ＇＇正在连接到服务器...＇＇;
FTP.Host := ＇＇localhost＇＇; [green]//已经有FTP SERVER 启动[/green]
FTP.Username := ＇＇upload＇＇;
FTP.Password := ＇＇upload＇＇;
try
FTP.Connect;
except
showMessage(＇＇连接到服务器出错。＇＇);
end;
Form1.StatusBar.SimpleText := ＇＇成功连接，请选择文件上传。＇＇;
if Form1.OpenDialog.Execute then
begin
FTP.Put(Form1.OpenDialog.FileName, ExtractFileName(Form1.OpenDialog.FileName));
end;
end;
end;[/red]

procedure TForm1.Button1Click(Sender: TObject);
begin
t := TDemo1Thread.Create( false );
end;

[brown]procedure TForm1.FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
ProgressBar.Max := AWorkCountMax;
ProgressBar.Position := 0;
ProgressBar.Visible := true;
end;




procedure TForm1.FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
ProgressBar.Position := AWorkCount;
ListBox.Items.AddObject(＇＇正在传送数据＇＇, Pointer(clBlack));

ListBox.ItemIndex := ListBox.Items.Count-1;
end;

procedure TForm1.FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar.Position := ProgressBar.Max;
end;[/brown]
end.

2楼: 已经解决：


[code]
unit MainDo;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdExplicitTLSClientServerBase, IdFTP, StdCtrls, ComCtrls;
type
TupThread = class(TThread)
private
{ Private declarations }
procedure Upload;
protected
procedure Execute; override;
end;


type
TForm1 = class(TForm)
FTP: TIdFTP;
OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
ProgressBar1: TProgressBar;
StatusBar1: TStatusBar;
procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
FTP.Host := ＇＇61.155.39.11＇＇;
FTP.Username := ＇＇upload＇＇;
FTP.Password := ＇＇upload＇＇;
FTP.Connect;
if FTP.Connected then
begin
StatusBar1.SimpleText := ＇＇成功连接到服务器，请选择一个视频开始上传...＇＇;
Button1.Enabled := false;
Button2.Enabled := true;
end
else
begin
StatusBar1.SimpleText := ＇＇连接到服务器失败，请稍后重试...＇＇;
Button1.Enabled := true;
Button2.Enabled := false;

end;
end;


procedure TupThread.Execute;
begin
{ Place thread code here }
Upload;
//Synchronize();
end;

procedure TupThread.Upload;
begin
if Form1.FTP.Connected then
begin
if Form1.OpenDialog1.Execute then
begin
Form1.FTP.Put(Form1.OpenDialog1.FileName, ExtractFileName(Form1.OpenDialog1.FileName));
end
else
begin
showmessage(＇＇出现未知错误，请重新启动程序。＇＇);
end;
end
else
begin
showmessage(＇＇尚未连接到服务器，请先连接。＇＇);
Form1.Button1.Enabled := true;
Form1.Button2.Enabled := false;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
T : TThread;
begin
T := TupThread.Create(false);
end;

procedure TForm1.FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
ProgressBar1.Position := AWorkCount;

end;

procedure TForm1.FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
ProgressBar1.Max := AWorkCountMax;
ProgressBar1.Position := 0;
ProgressBar1.Visible := true;

end;

procedure TForm1.FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := ProgressBar1.Max;
end;

end.

[/code]


IdFTP运行在子线程下，不影响主FORM的执行操作。 如企业管理软件

3楼: 帮顶！

╭=========================================╮

80G海量源代码,控件，书籍全免费狂下不停！

http://www.source520.com

╰=========================================╯

4楼: 发分吧！呵呵。

5楼: mark

6楼: 多人接受答案了。