Synapse GUI
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
cybersmyth · 2011-01-22 03:23

I'm using Synapse for ftp in an app I'm working on. I was wondering if
anyone had an example of gui interactions? I progress bar would be
ideal.

Thanks,
-Joe

----------------------------------------------------------------------
theo · 2011-01-22 10:51

Please read the Synapse docs:
http://synapse.ararat.cz/doku.php/public:howto:ftp_progressbar

----------------------------------------------------------------------
cybersmyth · 2011-01-22 19:44

Thanks, but I can't figure out how that example works.  It has three
parameters in the declaration, but when it's called, there are no
parameters.

procedure TftpForm.SockPutCallBack(Sender: TObject;
  Reason: THookSocketReason; const Value: string);

....

ftp.DSock.OnStatus := SockPutCallBack; // Update progressbar

-Joe

----------------------------------------------------------------------
theo · 2011-01-22 20:33

It's an event handler, it is not a call, you tell it which function to
call in case sth. happens.

For FPC mode do this (see @)

ftp.DSock.OnStatus := @SockPutCallBack;

----------------------------------------------------------------------
cybersmyth · 2011-01-23 17:20

GREAT!  Awesome. I think I get it now. Thanks for the help.

-Joe

----------------------------------------------------------------------
Lazaruszki · 2011-03-07 22:50

Hi cybersmyth.

Can you send me a working ftp+gui read/write example?  If it's not
secret  I try some code and look google and doc, but Lazarus always
send errors.

My last idea was: Give up lazarus ...     pls help!

----------------------------------------------------------------------
jixian.yang · 2011-03-08 07:16

procedure TForm1.Button1Click(Sender: TObject);
begin
  MailSender;
end;

procedure TForm1.OnStatus(Sender: TObject; Reason: THookSocketReason;
  const Value: string);
begin
    if (Reason = HR_WriteCount) and (StrToIntDef(Value, 0) > 10) then
    begin
      FPos := FPos + StrToIntDef(Value, 0);
      Application.ProcessMessages;
      Caption:=IntToStr(FPos);
    end;
end;

procedure TForm1.MailSender;
var
  StrList : TStringList;
  hdAttach : string;
  Mime : TMimeMess;
  SMTP : TSmtpSend;
begin

  StrList := TStringList.Create;
  Mime := TMimeMess.Create;
  SMTP := TSmtpSend.Create;
  try
    SMTP.FullSSL := True;       // Explicit
    //SMTP.AutoTLS := TRUE;     // implicit
    SMTP.TargetPort := edtPort.Text;   //SSL:465
    SMTP.UserName := edtUserID.Text;
    SMTP.Password := edtPassword.Text;
    SMTP.TargetHost := edtServer.Text;

    SMTP.Sock.OnStatus := @OnStatus;

    //SMTP LOGIN
    if not SMTP.Login then exit;

    StrList.Add(memBody.Lines.Text); 
    Mime.Header.CharsetCode := UTF_8;
    Mime.Header.From := edtFrom.Text;
    Mime.Header.ReplyTo := edtReply.Text;
    Mime.Header.ToList.Add(edtTo.Text);
    Mime.Header.CCList.Add(edtCC.Text);
    Mime.Header.Subject := edtSubject.Text;
    Mime.AddPartMultipart('', Nil);
    Mime.AddPartText(StrList, Mime.MessagePart);

    hdAttach := edtAttach.Text;
    if hdAttach <> '' then
      Mime.AddPartBinaryFromFile(hdAttach, Mime.MessagePart);

    Mime.EncodeMessage;

    if not SMTP.MailFrom(edtFrom.Text, Length(Mime.Lines.Text)) then
exit;
    if not SMTP.MailTo(edtTo.Text) then exit;
    if not SMTP.MailTo(edtBCC.Text) then exit;   
    if not SMTP.MailData(Mime.Lines) then exit;

    //SMTP.Logout;
  finally
    SMTP.Logout;
    StrList.Free;
    Mime.Free;
    SMTP.Free;
  end;

end;

----------------------------------------------------------------------
Lazaruszki · 2011-03-18 22:49

Hi Guys!

Thx fol all! The code is ready:).
It's error free:)
Ftp login : OK
It can read file name and file size from ftp server.

BUT, download file does not start.

...I skip any command or don't use any function?

The code samle :


  ftp := TFTPSend.Create;
  try
    ftp.DSock.OnStatus := @SockGetCallBack; // Update progressbar
    ftp.Username := EditUser.text;
    ftp.Password := EditPassw.text;
    ftp.TargetHost := EditFtpServer.text;
    ftp.TargetPort := EditPort.text;

    //

    if ftp.Login then
      MemoLog.Lines.Add('Login:           success')
    else
    begin
      MemoLog.Lines.Add('Login:           incorrect');
      exit;
    end;

    ftp.DirectFileName := EditLocalFile.Text;
    ftp.DirectFile := true;
    TotalBytes := ftp.FileSize(EditRemoteFile.Text);

    MemoLog.Lines.Add('Load file:  ' + EditRemoteFile.Text);
    MemoLog.Lines.Add('TotalBytes: ' + IntToStr(TotalBytes));


    if ftp.RetrieveFile(EditRemoteFile.Text, false) = true then
      MemoLog.Lines.Add('Transfer completed')
    else
      MemoLog.lines.add('Transfer failed');

    ftp.Logout;
    MemoLog.Lines.Add('Connection closed');

----------------------------------------------------------------------
Peter_Vadasz · 2011-03-19 07:46

The following code works fine for me.
Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls,
  ComCtrls, ftpsend, blcksock;

type

  { TForm1 }

  TForm1 = class(TForm)
    BtnDownload: TButton;
    EditUser: TEdit;
    EditPassw: TEdit;
    EditFTPServer: TEdit;
    EditPort: TEdit;
    EditLocalFile: TEdit;
    EditRemoteFile: TEdit;
    LblRemoteFile: TLabel;
    LblUser: TLabel;
    LblLocalFile: TLabel;
    LblPassw: TLabel;
    LblFTPServer: TLabel;
    LblPort: TLabel;
    MemoLog: TMemo;
    ProgressBar: TProgressBar;
    procedure BtnDownloadClick(Sender: TObject);
    procedure SockCallBack(Sender: TObject; Reason: THookSocketReason;
const Value: string);
  private
    { private declarations }
    TotalBytes : longint;
    CurrentBytes : longint;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.BtnDownloadClick(Sender: TObject);
var ftp : TFTPSend;
begin
  Progressbar.Position:=0;
  MemoLog.Clear;
  ftp := TFTPSend.Create;
  try
    ftp.DSock.OnStatus := @SockCallBack;
    ftp.Username := EditUser.text;
    ftp.Password := EditPassw.text;
    ftp.TargetHost := EditFtpServer.text;
    ftp.TargetPort := EditPort.text;
    Application.ProcessMessages;
    if ftp.Login then
      MemoLog.Lines.Add('Login:           success')
    else
    begin
      MemoLog.Lines.Add('Login:           incorrect');
      exit;
    end;
    BtnDownload.Enabled:=False;
    ftp.DirectFileName := EditLocalFile.Text;
    ftp.DirectFile := true;
    TotalBytes := ftp.FileSize(EditRemoteFile.Text);

    MemoLog.Lines.Add('Load file:  ' + EditRemoteFile.Text);
    MemoLog.Lines.Add('TotalBytes: ' + IntToStr(TotalBytes));


    if ftp.RetrieveFile(EditRemoteFile.Text, false) = true then
      MemoLog.Lines.Add('Transfer completed')
    else
      MemoLog.lines.add('Transfer failed');
    Application.ProcessMessages;
    ftp.Logout;
    MemoLog.Lines.Add('Connection closed');
  finally
    ftp.free;
  end;
  BtnDownload.Enabled:=True;
end;

procedure TForm1.SockCallBack(Sender: TObject; Reason:
THookSocketReason;
  const Value: string);
begin
  Application.ProcessMessages;
  case Reason of
    HR_ReadCount:
      begin
        inc(CurrentBytes, StrToIntDef(Value, 0));
        ProgressBar.Position := Round(1000 * (CurrentBytes /
TotalBytes));
      end;
    HR_Connect: CurrentBytes := 0;
  end;
end;

end.
You can download it here:
http://dl.dropbox.com/u/2766266/ftp_example.tar.gz