es funktioniert leider nicht...
die progressbar läuft leider nicht..
ich hänge den Code mal hier an und auch das Beispiel
ich hatte es in der IDE und auch Ohne IDE probiert auf dem MAC , da läuft es leider nicht und hängt sich auch auf und lässt sich nicht schliessen.
Code: Alles auswählen
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
SysUtils, FileUtil, Forms, Dialogs,
StdCtrls, ComCtrls, EditBtn, ftpsend, synsock, Classes, blcksock;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
eHost: TEdit;
eFile: TEdit;
eUser: TEdit;
ePassword: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
lbStatus: TLabel;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
ftp:TFTPSend;
procedure OnHeartBeat(Sender:TObject);
procedure OnMonitor(Sender: TObject; Writing: Boolean;
const Buffer: TMemory; Len: Integer);
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.OnHeartBeat(Sender: TObject);
begin
application.ProcessMessages;
end;
procedure TForm1.OnMonitor(Sender: TObject; Writing: Boolean;
const Buffer: TMemory; Len: Integer);
begin
progressbar1.Position:=progressbar1.Position+Len;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
button1.enabled := false;
try
ftp := TFTPSend.Create;
try
//ProgressBar1.Max:=FileSize(eFile.filename);
//I like exceptions, but not sure Synapse does. :)
//ftp.Sock.RaiseExcept:=true;
//ftp.DSock.RaiseExcept:=true;
//now lets plug some callbacks in
ftp.DSock.OnMonitor:=@OnMonitor;
ftp.Sock.OnHeartbeat:=@OnHeartBeat;
ftp.DSock.OnHeartbeat:=@OnHeartBeat;
ftp.DSock.HeartbeatRate:=150; //lets make our GUI still feel responsive
ftp.Sock.HeartbeatRate:=150;
//now our props
ftp.TargetHost := eHost.text;
ftp.BinaryMode := true;
ftp.UserName := eUser.text;
ftp.Password := ePassword.text;
ftp.DirectFileName :=
eFile.Text;
eFile.text;
ftp.DirectFile := true;
if not ftp.Login then
raise Exception.Create('could not login');
progressbar1.Max:=ftp.FileSize(eFile.text);
if not ftp.RetrieveFile(eFile.text,false) then
raise Exception.Create('file not retrieved');
ftp.Logout;
finally
ftp.free;
end;
finally
button1.enabled := true;
end;
end;
end.
Verein
Links
