ftppas.pas

基于delphi的FPT文件传输系统,希望对大家有用

unit ftppas;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, FileCtrl, Psock, NMFtp, Menus;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    rad1: TRadioButton;
    Label4: TLabel;
    rad2: TRadioButton;
    rad3: TRadioButton;
    Button1: TButton;
    GroupBox2: TGroupBox;
    sb: TStatusBar;
    lbs: TListBox;
    filedl: TFileListBox;
    filedr: TDriveComboBox;
    filede: TDirectoryListBox;
    pb: TProgressBar;
    Label5: TLabel;
    Edit4: TEdit;
    pm: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure nfpAuthenticationFailed(var Handled: Boolean);
    procedure nfpConnect(Sender: TObject);
    procedure nfpDisconnect(Sender: TObject);
    procedure nfpError(Sender: TComponent; Errno: Word; Errmsg: String);
    procedure Button1Click(Sender: TObject);
    procedure nfpHostResolved(Sender: TComponent);
    procedure nfpInvalidHost(var Handled: Boolean);
    procedure nfpListItem(Listing: String);
    procedure filedlMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lbsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lbsDblClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure getlocaldir;
    procedure filedrChange(Sender: TObject);
    procedure filedeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    Procedure upload(fname:string);
    procedure nfpTransactionStop(Sender: TObject);
    procedure nfpPacketSent(Sender: TObject);
    procedure nfpFailure(var Handled: Boolean; Trans_Type: TCmdType);
    procedure nfpSuccess(Trans_Type: TCmdType);
    procedure N3Click(Sender: TObject);//上传文件;
    Procedure refreshdir;
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure nfpPacketRecvd(Sender: TObject);//刷新服务器端目录;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  localdir:string;

implementation

{$R *.DFM}

procedure TForm1.nfpAuthenticationFailed(var Handled: Boolean);
begin
 application.MessageBox('用户名或密码不正确','系统提示',mb_iconstop+mb_ok);
 sb.Panels[0].Text:='无法连接到'+edit1.text+'服务器';
end;

procedure TForm1.nfpConnect(Sender: TObject);
begin
 sb.Panels[0].Text:='成功连接到'+edit1.text+'服务器';
 edit1.Enabled:=false;
 edit2.Enabled:=false;
 edit3.Enabled:=false;
 edit4.Enabled:=false;
 sb.Panels[1].Text:='正在列举服务器文件列表...';
 refreshdir;
end;

procedure TForm1.nfpDisconnect(Sender: TObject);
begin
  sb.Panels[0].Text:='已经与'+edit1.text+'服务器断开连接';
  edit1.Enabled:=true;
  edit2.Enabled:=true;
  edit3.Enabled:=true;
  edit4.Enabled:=true;
  n1.Enabled:=false;
  n2.Enabled:=false;
  n3.Enabled:=false;
  n4.Enabled:=false;
  n5.Enabled:=false;
  n6.Enabled:=false;
end;

procedure TForm1.nfpError(Sender: TComponent; Errno: Word; Errmsg: String);
begin
 sb.Panels[0].Text:='与服务器通信发生错误';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if edit1.text='' then
    application.MessageBox('当前没有指定任何主机信息','警告',mb_iconstop+mb_ok)
   else
    begin
      if nfp.Connected then
       begin
        nfp.Disconnect;
        button1.Caption:='连接';
       end
       else
        begin
          with nfp do
           begin
             host:=edit1.text;
             userid:=edit2.text;
             password:=edit3.text;
             if trim(edit4.text)<>'' then
               port:=strtoint(edit4.text)
              else
               port:=21;
             try
               connect;
               sb.Panels[0].Text:='成功连接到服务器';
               button1.Caption:='断开';
             except
               n1.Enabled:=false;
               n2.Enabled:=false;
               n3.Enabled:=false;
               n4.Enabled:=false;
               n5.Enabled:=false;
               n6.Enabled:=false;
               sb.Panels[0].Text:='连接服务器失败';
             end;
           end;
        end;
    end;
end;


procedure TForm1.nfpHostResolved(Sender: TComponent);
begin
 sb.Panels[0].Text:='服务器断开连接';
end;

procedure TForm1.nfpInvalidHost(var Handled: Boolean);
begin
 sb.Panels[0].Text:='无效的主机';
end;

procedure TForm1.nfpListItem(Listing: String);
var
 slist:string;
begin
  slist:=trim(strrscan(pchar(listing),' '));
  if strpos(pchar(listing),pchar('<DIR>'))<>nil then
    lbs.Items.Add(slist+'/')
   else
    lbs.Items.Add(slist);
end;

procedure TForm1.filedlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if nfp.Connected then
 begin
  n1.Enabled:=true;
  n2.Enabled:=false;
  n3.Enabled:=false;
  n4.Enabled:=false;
  n5.Enabled:=false;
  n6.Enabled:=false;
 end;
end;

procedure TForm1.lbsMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if nfp.Connected then
   begin
    n1.Enabled:=false;
    n2.Enabled:=true;
    n3.Enabled:=true;
    n4.Enabled:=true;
    n5.Enabled:=true;
    n6.Enabled:=true;
   end;
end;

procedure TForm1.lbsDblClick(Sender: TObject);
var
 i:integer;
 spath:string;
begin
 spath:='';
 for i:=0 to lbs.Items.Count-1 do
  begin
    if lbs.Selected[i] then
     begin
       if (strrscan(pchar(lbs.Items.Strings[i]),'/')<>nil)or(lbs.Items.Strings[i]='..') then
         begin
           if (strrscan(pchar(lbs.Items.Strings[i]),'/')<>nil) then
             begin
               spath:=lbs.Items.Strings[i];
               delete(spath,length(spath),length(spath));
             end
            else
             spath:='..';
             break;
         end
        else
         break; //选择了文件则直接退出循环
     end
  end;
  if spath<>'' then
   begin
    nfp.ChangeDir(trim(spath));
    refreshdir;
   end;
end;

Procedure Tform1.refreshdir;
begin
  lbs.Clear;
  lbs.Items.Add('..');
  try
    nfp.List;
    sb.Panels[0].Text:='成功列举服务器端文件目录';
  except
    sb.Panels[1].Text:='列举服务器端文件目录失败';
  end;
end;


procedure TForm1.N1Click(Sender: TObject);
var
  i,cou,j:integer;
  sfilename:string;
begin
  cou:=filedl.SelCount; //被选中的文件数目
  if cou<1 then
    exit;//如果没有选中的文件则退出操作;
  if localdir='' then
    getlocaldir;//获取当前目录
  for i:=0 to filedl.Items.Count-1 do
   begin
     if filedl.Selected[i] then
       begin
         sfilename:=filedl.Items[i];
         j:=j+1;
         upload(sfilename);//调用上传过程
         if j=cou then
           break;
       end;
   end;
end;

Procedure Tform1.upload(fname:string);
var
  houstr:string;
  len:integer;
begin
  houstr:=fname;
  delete(houstr,1,length(houstr)-3);
  if (houstr='txt')or(houstr='TXT')or(houstr='Txt') then //设置传送文件类型
    begin
     rad1.checked:=true;
     nfp.mode(MODE_ASCII);
    end
   else
    begin
     rad3.checked:=true;
     nfp.mode(MODE_BYTE);
    end;
  try
    nfp.Upload(localdir+fname,fname);
    sb.Panels[1].Text:='正在上传文件...';
  except
    sb.Panels[1].text:='上传文件'+fname+'失败';
  end;
  //刷新ftp服务器端
  refreshdir;
end;

procedure Tform1.getlocaldir;
begin
  if (strrscan(pchar(filede.directory),'\')+1<>strend(pchar(filede.Directory))) then