uftp_louis_101.pas

来自「this application for FTP protocol File T」· PAS 代码 · 共 229 行

unit UFtp_Louis_101;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdIntercept, IdLogBase, IdLogDebug, IdAntiFreezeBase, ShellApi,
  IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFTP, ComCtrls, ShellCtrls, FileCtrl, StdCtrls, Buttons, ExtCtrls, Menus,
  ImgList, ActnList, ActnMan, ToolWin, ActnCtrls, ActnMenus;

type
  TFFtp = class(TForm)
    GroupBox4: TGroupBox;
    ListeDistante: TListBox;
    DeconnectBtn: TBitBtn;
    ConnectBtn: TBitBtn;
    GroupBox1: TGroupBox;
    Edit4: TEdit;
    IdFTP1: TIdFTP;
    IdAntiFreeze1: TIdAntiFreeze;
    SaveDialog1: TSaveDialog;
    IdLogDebug1: TIdLogDebug;
    OpenDialog1: TOpenDialog;
    PopupMenu1: TPopupMenu;
    Edition1: TMenuItem;
    Coller1: TMenuItem;
    Copier1: TMenuItem;
    Couper1: TMenuItem;
    PopupMenu2: TPopupMenu;
    Fichier1: TMenuItem;
    Quitter1: TMenuItem;
    N1: TMenuItem;
    Telecharger: TMenuItem;
    GroupBox2: TGroupBox;
    Bevel4: TBevel;
    GroupBox3: TGroupBox;
    Fchier1: TMenuItem;
    Envoyer1: TMenuItem;
    Supprimer2: TMenuItem;
    ListeOrdi: TFileListBox;
    ActionManager1: TActionManager;
    EnvoyerAct: TAction;
    ImageList1: TImageList;
    TelechargerAct: TAction;
    QuitterAct: TAction;
    SupprimerOrdiAct: TAction;
    SupprimerSiteAct: TAction;
    Quitter3: TMenuItem;
    RepertoireParentAct: TAction;
    Image1: TImage;
    ActionMainMenuBar1: TActionMainMenuBar;
    BitBtn3: TBitBtn;
    BitBtn2: TBitBtn;
    OuvrirRepertoireSelectAct: TAction;
    Animate: TAnimate;
    InfoBtn: TBitBtn;
    StatusBar1: TStatusBar;
    DirectoryListBox1: TDirectoryListBox;
    procedure IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
      const asStatusText: String);
    procedure IdFTP1Disconnected(Sender: TObject);
    procedure DeconnectBtnClick(Sender: TObject);
    procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure IdLogDebug1LogItem(ASender: TComponent; var AText: String);
    procedure ListeDistanteDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListeDistanteDragDrop(Sender, Source: TObject; X,
      Y: Integer);
    procedure ListeOrdi1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListeOrdi1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure EnvoyerActExecute(Sender: TObject);
    procedure QuitterActExecute(Sender: TObject);
    procedure TelechargerActExecute(Sender: TObject);
    procedure SupprimerSiteActExecute(Sender: TObject);
    procedure RepertoireParentActExecute(Sender: TObject);
    procedure ListeDistanteDblClick(Sender: TObject);
    procedure OuvrirRepertoireSelectActExecute(Sender: TObject);
    procedure InfoBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ConnectBtnClick(Sender: TObject);
  private
    { D閏larations priv閑s }
    Procedure ChangeDir (Const Entry: String);
    Procedure Download(Const Entry: String);
    Procedure ResolveLink(Const Entry: String);
    Procedure Supprime(Const Entry: String);
    Procedure Telecharge(Const Entry: String);
  public
    { D閏larations publiques }
    AbortTransfer: Boolean;
    TransferringData: Boolean;
    procedure EnableControls(Enable: Boolean);
  end;

  TFTPServerType = (ftpUnix, ftpWindows);

var
  FFtp: TFFtp;
  FTPServerType: TFTPServerType;
  FileSize: Integer;
  FileName: String;
  STime: Extended;
  TransferringData: Boolean;

implementation

uses UConnex_101, UTelecharge_101, UEtatConnex_101;

{$R *.dfm}

procedure TFFTP.EnableControls(Enable: Boolean);
Begin
  ConnectBtn.Enabled := Enable;
  DeconnectBtn.Enabled := Enable and idftp1.Connected;
  ListeDistante.Enabled := Enable and IdFtp1.Connected;
End;

procedure TFFtp.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
  const asStatusText: String);
begin
  FEtatConnex.ListeEtat.Items.Add(asStatusText);
end;

procedure TFFtp.IdFTP1Disconnected(Sender: TObject);
begin
  Edit4.Text := '';
  ListeDistante.Clear;
  EnableControls(True);
end;

procedure TFFtp.DeconnectBtnClick(Sender: TObject);
var
  S: String;
begin
  FFtp.PopupMenu2.AutoPopup := False;
  EnableControls(True);
  ConnectBtn.Enabled := True;
  FConnex.ConnexBtn.Enabled := True;
  If IdFtp1.Connected Then IdFtp1.Disconnect;
  S := FConnex.EditServeur.Text;
  FFtp.StatusBar1.Panels[0].Text :='D閏onnecter de : ' + S ;
end;

Function IsFatDir(const FatEntry: String): Boolean;
var
  S: String;
Begin
  S := Trim (FatEntry);
  S := Trim (Copy(S, Pos(' ', S) +1, Length(S)));
  S := Trim (Copy(S, Pos(' ', S) +1, Length(S)));
  S := Trim (Copy(S, 1, Pos(' ', S) - 1));
  Result := Uppercase(S) = '<DIR>';
End;

Function IsDir(Const Entry: String): Boolean;
Begin
  If FTPServerType = ftpWindows Then Result := IsFatDir(Entry)
  Else Result := (Length(Trim(Entry)) > 0) and (LowerCase(Trim(Entry))[1] = 'd');
end;

Function IsFile (Const Entry: String): Boolean;
Begin
  If FTPServerType = ftpWindows Then Result := Not IsFatDir(Entry)
  Else Result := (Length(Trim(Entry)) >0) And (Trim(Entry)[1] = '-');
End;

Function AccessAllowed(Const Entry: String): Boolean;
Begin
  If FTPServerType = ftpWindows then Result := True
  Else Result := (Length(Trim(Entry)) > 7) and (LowerCase(Trim(Entry))[8]='r');
End;

Function GetFatEntryName (Const FatEntry: String): String;
Begin
  Result := Trim(FatEntry);
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
End;

Function GetExt2EntryName (Const Ext2Entry: String): String;
Begin
  Result := Trim(Ext2Entry);
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) +1, Length(Result)));
End;

Function GetEntryName( Const Entry: String): String;
Begin
  If FTPServerType = ftpWindows Then Result := GetFatEntryName (Entry)
  Else Result := GetExt2EntryName(Entry);
End;

Procedure TFFTP.ChangeDir(Const Entry: String);
Var
  Name: String;
Begin
  If IsDir(Entry) then
  Begin
    If AccessAllowed(Entry) then
    Begin
      Try
        EnableControls(False);
        Name := GetEntryName(Entry);
        Edit4.Text := Edit4.Text + Name + '/';
        IdFtp1.ChangeDir(Edit4.Text);
        Try
          IdFtp1.List(ListeDistante.Items);           
        Except;
      End;
        Finally
        EnableControls(True);
      End;
    End
  Else
    Begin
      FEtatConnex.ListeEtat.Items.Add('Acces NON Autoris