{*******************************************************}
{                                                       }
{  Responsive Software     http://www.responsive.co.nz  }
{                                                       }
{  Copyright (c) 2003-2006 Responsive Software Limited  }
{                                                       }
{*******************************************************}

unit FTP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base, Grids, StdCtrls, Buttons, Psock,
  NMFtp;

type
  TFTPForm = class(TBaseForm)
    NMFTP: TNMFTP;
    procedure NMFTPSuccess(Trans_Type: TCmdType);
    procedure NMFTPPacketSent(Sender: TObject);
  private
    { Private declarations }
    FFileName : string;
    Success : boolean;
    FShowProgress : boolean;
  public
    { Public declarations }
    function SendFile
      (FileName : string;
       HostName : string;
       UserId : string;
       Password : string;
       Passive : boolean;
       ShowProgress : boolean) : boolean;
       
    // this procedure must be called in the main form's
    // OnCloseQuery event handler otherwise it prevents
    // the application from automatically shutting down
    // when Windows is shut down due to a bug in TNMFTP
    procedure DestroyNMFTP;
  end;

var
  FTPForm: TFTPForm;

implementation

uses Globals, Progress, Main, ServerMain;

{$R *.dfm}

function TFTPForm.SendFile
  (FileName : string;
   HostName : string;
   UserId : string;
   Password : string;
   Passive : boolean;
   ShowProgress : boolean) : boolean;
var
  PortPos : integer;
  PortStr : string;
begin
  PortPos := Pos(':',HostName);
  if PortPos <> 0 then
  begin
    PortStr := Copy(HostName,PortPos+1,Length(HostName));
    Delete(HostName,PortPos,Length(HostName));
  end else
    PortStr := '';
  FFileName := FileName;
  FShowProgress := ShowProgress;
  NMFTP.Passive := Passive;
  NMFTP.Host := HostName;
  try
    if PortStr <> '' then
      NMFTP.Port := StrToInt(PortStr);
  except
    // ignore if unable to convert PortStr to integer
  end;
  NMFTP.UserId := UserId;
  NMFTP.Password := Password;
  try
    NMFTP.Connect;
  except
    on E:Exception do
    begin
      ShowMessage('Could not connect to FTP site ' + HostName);
      Result := false;
      Exit;
    end;
  end;
  try
    Success := false;
    NMFTP.Mode(MODE_IMAGE);
    if Success then
    begin
      Success := false;
      // display progress bar if required
      if FShowProgress then
      begin
        if ServerMode then
          ServerMainForm.Enabled := false
        else
          MainForm.Enabled := false;
        ProgressForm.SetCaption('Sending file via FTP.  Please wait ...');
        ProgressForm.Show;
      end;
      try
        NMFTP.Upload(FFileName,ExtractFileName(FFileName));
      finally
        if FShowProgress then
        begin
          ProgressForm.Hide;
          if ServerMode then
            ServerMainForm.Enabled := true
          else
            MainForm.Enabled := true;
        end;
      end;
    end;
    NMFTP.Disconnect;
  except
    on E:Exception do
    begin
      ShowMessage(E.Message);
      Result := false;
      Exit;
    end;
  end;
  Result := Success;
end;

procedure TFTPForm.NMFTPSuccess(Trans_Type: TCmdType);
begin
  Success := true;
end;

procedure TFTPForm.NMFTPPacketSent(Sender: TObject);
begin
  if FShowProgress then
    ProgressForm.SetPosition(NMFTP.BytesSent * 100 div NMFTP.BytesTotal);
end;

procedure TFTPForm.DestroyNMFTP;
begin
  try
    NMFTP.Free;
    NMFTP := nil;
  except
  end;
end;

end.