Forum > Networking and Web Programming

Synapse GUI

<< < (2/2)

Lazaruszki:
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:
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:
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. 8-)

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:
The following code works fine for me.

--- Code: ---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.

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

Navigation

[0] Message Index

[*] Previous page