unit1.~pas

vc-mfc编程实例 很简单的东西,以后回多传自己的东西

{ SimpFTP  by Eric W. Engler.  This is Freeware.  
  A Simple FTP Client for Delphi that uses TFtpCli VCL from
  Francois Piette. }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Ftpcli, StdCtrls, ExtCtrls, IniFiles, FileCtrl, CopyUnit;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    HostNameEdit: TEdit;
    Hostname: TLabel;
    PortEdit: TEdit;
    Label2: TLabel;
    Panel2: TPanel;
    Label1: TLabel;
    SiteCB: TComboBox;
    NewSiteBut: TButton;
    Memo1: TMemo;
    Label3: TLabel;
    InitialDirEdit: TEdit;
    UserNameEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    PasswordEdit: TEdit;
    ConnectBut: TButton;
    ExitBut: TButton;
    FtpClient1: TFtpClient;
    SaveProfileCB: TCheckBox;
    InitialLocalDirEdit: TEdit;
    Label6: TLabel;
    ForceLowerCB: TCheckBox;
    AutoDirCB: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure ExitButClick(Sender: TObject);
    procedure ConnectButClick(Sender: TObject);
    procedure FtpClient1Display(Sender: TObject; var Msg: String);
    procedure FtpClient1RequestDone(Sender: TObject; RqType: TFtpRequest;
      Error: Word);
    procedure FtpClient1SessionClosed(Sender: TObject; Error: Word);
    procedure FtpClient1SessionConnected(Sender: TObject; Error: Word);
    function LookupRequest(RqType: TFtpRequest): String;
    procedure NewSiteButClick(Sender: TObject);
    procedure UpdateProfile;
    procedure ReadProfile(ProfileName: String);
    procedure SiteCBChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    function StrEncrypt(const S: String): String;
    function StrDecrypt(const S: String): String;
    Function Base64Encode(Value : String) : String;
    Function Base64Decode(Value : String) : String;
    procedure UploadAll;
    procedure UploadNext;
    procedure DownloadAll;
    procedure DownloadNext;
    procedure RemoteDelete;
    procedure LocalDelete;
    procedure View;
    procedure ViewTheFile;
  private
    { Private declarations }
    MaskedPassword: String;
    IniFileName: String;
  public
    { Public declarations }
     FileNames: TStrings;
     FilesLeft: Integer;
     ViewMode: Boolean;
  end;

var
  Form1: TForm1;
  LoggedIn: Boolean;
  ViewfileName: String;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
   IniFile: TIniFile;
   P: String;
   i: Integer;
begin
   PortEdit.Text:='21';
   SaveProfileCB.Checked:=True;
   ForceLowerCB.Checked:=True;
   AutoDirCB.Checked:=True;
   LoggedIn:=False;
   ViewMode:=False;

   IniFileName := LowerCase(ExtractFileName(Application.ExeName));
   IniFileName := Copy(IniFileName, 1, Length(IniFileName) - 3) + 'ini';
   IniFile := TIniFile.Create(IniFileName);
   p := IniFile.ReadString('Profiles', 'Name0','');
   i:=1;
   while p > '' do
   begin
      SiteCB.Items.Add(p);
      p := IniFile.ReadString('Profiles', 'Name' + IntToStr(i), '');
      inc(i);
   end;
   SiteCB.ItemIndex:=IniFile.ReadInteger('LastUsed','Profile',0);
   ReadProfile(SiteCB.Text);
   IniFile.Free;
   FileNames:=TStringList.Create;
end;

procedure TForm1.ExitButClick(Sender: TObject);
begin
   FtpClient1.Quit;
   Close;
end;

procedure TForm1.ConnectButClick(Sender: TObject);
var
   i: Integer;
begin
   CopyForm.RemoteDirList.Items.Clear;
   CopyForm.StringGrid1.RowCount:=1;

   if not DirectoryExists(InitialLocalDirEdit.Text) then
      ShowMessage('Error - can not select ' + InitialLocalDirEdit.Text)
   else
      chdir(InitialLocalDirEdit.Text);
   if SaveProfileCB.Checked then
      UpdateProfile;
   if FtpClient1.Connected then
      FtpClient1.Quit;
   Memo1.Lines.Clear;
   CopyForm.Memo1.Lines.Clear;
   Memo1.Lines.Add('Connecting to ' + HostnameEdit.Text + ' ...');
   CopyForm.Memo1.Lines.Add('Connecting to ' + HostnameEdit.Text + ' ...');
   Screen.Cursor:=crHourGlass;
   Application.ProcessMessages;
   MaskedPassword:='';
   for i := 1 to Length(PasswordEdit.Text) do
      MaskedPassword := MaskedPassword + '?';
   with FtpClient1 do
   begin
      Binary:=True;
      HostDirName:=InitialDirEdit.Text;
      HostName:=HostNameedit.Text;
      UserName:=UserNameEdit.Text;
      PassWord:=PasswordEdit.Text;
      Connect;
   end;
end;

procedure TForm1.FtpClient1Display(Sender: TObject; var Msg: String);
begin
   if Pos('PASS ', Msg) > 0 then
   begin
      // don't show the password on the screen
      Memo1.Lines.Add('> PASS ' + MaskedPassword);
      Copyform.Memo1.Lines.Add('> PASS ' + MaskedPassword);
   end
   else
   begin
      Memo1.Lines.Add(Msg);
      Copyform.Memo1.Lines.Add(Msg);
   end;
end;

procedure TForm1.FtpClient1RequestDone(Sender: TObject;
  RqType: TFtpRequest; Error: Word);
var
   req: String;
begin
   req:=LookupRequest(RqType);
   Memo1.Lines.Add('Done (request=' + req
         + '  error code=' + IntToStr(Error) + ')');
   CopyForm.Memo1.Lines.Add('Done (request=' + req
         + '  error code=' + IntToStr(Error) + ')');

   if Error > 0 then
      ShowMessage('Error ' + FtpClient1.ErrorMessage);

   if (RqType = ftpConnectAsync) and (Error = 0) then
   begin
      LoggedIn:=True;
      CopyForm.Caption:='Transfer Files to/from:  ' + HostnameEdit.Text;
      if InitialDirEdit.Text > '' then
         FtpClient1.Cwd   // Select initial dir on remote
      else
         FtpClient1.Pwd;  // show dir on remote
   end;

   if (RqType = ftpCwdAsync) or (RqType = ftpCDupAsync)
    or (RqType = ftpRmdAsync) or (RqType = ftpMkdAsync) then
      FtpClient1.Pwd;  // Show user the current directory

   if RqType = ftpPwdAsync then
   begin
      Screen.Cursor:=crDefault;
      CopyForm.Position:=poDesigned;
      CopyForm.Left:=Left;
      CopyForm.Top:=Top;
      CopyForm.RemoteDirEdit.Text:=FtpClient1.DirResult;
      if AutoDirCB.Checked then
      begin
         FtpClient1.HostFileName:='';  // request list of all files
         FtpClient1.LocalFileName:= WinTempDir + 'ftpdir.txt';
         if FtpClient1.Binary then
         begin
            FtpClient1.Binary:=False;
            Ftpclient1.TypeSet;
         end;
         FTPClient1.Dir;
      end
      else
         CopyForm.Show;
   end;

   if RqType = ftpDirAsync then
   begin
      CopyForm.ParseDir;
      CopyForm.Position:=poDesigned;
      CopyForm.Left:=Left;
      CopyForm.Top:=Top;
      CopyForm.Show;
   end;

   if RqType = ftpPutAsync then
   begin
      if FilesLeft = 0 then
      begin
         if AutoDirCB.Checked then
         begin
            FtpClient1.HostFileName:='';  // request list of all files
            FtpClient1.LocalFileName:= WinTempDir + 'ftpdir.txt';
            if FtpClient1.Binary then
            begin
               FtpClient1.Binary:=False;
               FtpClient1.TypeSet;
            end;
            FTPClient1.Dir;
         end
         else
            CopyForm.Show;
      end
      else
         UploadNext;
   end;

   if RqType = ftpGetAsync then
   begin
      if ViewMode then
      begin
         ViewTheFile;
         ViewMode:=False;
         Exit;
      end;
      if FilesLeft = 0 then
      begin
         CopyForm.FileListBox1.Update;
         CopyForm.Show;
      end
      else
         DownloadNext;
   end;

   if RqType = ftpDeleAsync then
   begin
      if FilesLeft = 0 then
      begin
         if AutoDirCB.Checked then
         begin
            FtpClient1.HostFileName:='';  // request list of all files
            FtpClient1.LocalFileName:= WinTempDir + 'ftpdir.txt';
            if FtpClient1.Binary then
            begin
               FtpClient1.Binary:=False;
               FtpClient1.TypeSet;
            end;
            FTPClient1.Dir;
         end
         else
            CopyForm.Show;
      end
      else
         RemoteDelete;
   end;
end;

procedure TForm1.FtpClient1SessionClosed(Sender: TObject; Error: Word);
begin
   LoggedIn:=False;
   Memo1.Lines.Add('Disconnected');
   CopyForm.Memo1.Lines.Add('Disconnected');
end;

procedure TForm1.FtpClient1SessionConnected(Sender: TObject; Error: Word);
begin
   // NOTE: This does NOT mean that you are logged in!
   Memo1.Lines.Add('Connected');
   CopyForm.Memo1.Lines.Add('Connected');
end;

procedure TForm1.NewSiteButClick(Sender: TObject);
var
   NewSite: String;
begin
   NewSite := InputBox('New FTP Site','Enter Site Profile Name','');
   if Length(NewSite) = 0 then
      exit;
   if SiteCB.Items.IndexOf(UpperCase(NewSite)) > -1 then
   begin
      ShowMessage(NewSite + ' already exists');
      SiteCB.ItemIndex:=SiteCB.Items.IndexOf(UpperCase(NewSite));
      ReadProfile(SiteCB.Text);
      exit;
   end;
   SiteCB.Items.Add(UpperCase(NewSite));
   SiteCB.ItemIndex:=SiteCB.Items.Count-1; { point to item we just added }
   HostNameEdit.Text:='';
   InitialLocalDirEdit.Text:='C:\';
   InitialDirEdit.Text:='';
   UserNameEdit.Text:='';
   PasswordEdit.Text:='';
   PortEdit.Text:='21';
   ForceLowerCB.Checked:=True;
   AutoDirCB.Checked:=True;
   if SaveProfileCB.Checked then
      UpdateProfile;
end;

procedure TForm1.UpdateProfile;
var
   IniFile: TIniFile;
   ProfileName: String;
   i: Integer;
   NewSite: String;
begin
   if SiteCB.Text = '' then
   begin
      NewSite:= InputBox('New FTP Site','Enter Site Profile Name','');
      if Length(NewSite) = 0 then
         NewSite:='UNTITLED';
      NewSite:=UpperCase(NewSite);
      // does this new site already exist?
      if SiteCB.Items.IndexOf(NewSite) = -1 then
         SiteCB.Items.Add(NewSite);
      SiteCB.ItemIndex:=SiteCB.Items.IndexOf(NewSite);
   end;
   ProfileName:=SiteCB.Text;
   // Does this profile already exist?
   i:=SiteCB.Items.IndexOf(UpperCase(ProfileName));
   if i = -1 then
      // it doesn't exist yet
      i:=SiteCB.Items.Count;

   IniFile := TIniFile.Create(IniFileName);
   IniFile.WriteString('Profiles', 'Name'+IntToStr(i), ProfileName);
   IniFile.WriteString(ProfileName, 'HostName', HostNameEdit.Text);
   IniFile.WriteString(ProfileName, 'InitialLocalDir', InitialLocalDirEdit.Text);
   IniFile.WriteString(ProfileName, 'InitialDir', InitialDirEdit.Text);
   IniFile.WriteString(ProfileName, 'UserName', UserNameEdit.Text);
   IniFile.WriteString(ProfileName, 'Password',
                       Base64Encode(strEncrypt(PasswordEdit.Text)));
   IniFile.WriteInteger(ProfileName, 'Port', StrToInt(PortEdit.Text));
   IniFile.WriteBool(ProfileName, 'ForceLower', ForceLowerCB.Checked);
   IniFile.WriteBool(ProfileName, 'AutoDir', AutoDirCB.Checked);
   IniFile.WriteInteger('LastUsed', 'Profile', i);
   IniFile.Free;
end;

procedure TForm1.ReadProfile(ProfileName: String);
var
   IniFile: TIniFile;
begin